From 585f2a802584c99caafe7497fc7f43f7f2a6d608 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sun, 2 Apr 2023 13:29:56 +0300
Subject: [PATCH] rtt peer selection

---
 .fixme/log                     |  4 ++-
 hbs2-peer/app/BlockDownload.hs |  5 ++--
 hbs2-peer/app/PeerMain.hs      | 49 +++++++++++++++++++++++++---------
 3 files changed, 42 insertions(+), 16 deletions(-)

diff --git a/.fixme/log b/.fixme/log
index ff423723..b56fab98 100644
--- a/.fixme/log
+++ b/.fixme/log
@@ -1,2 +1,4 @@
 
-(fixme-set "workflow" "test" "FkbL6CVp5Q")
\ No newline at end of file
+(fixme-set "workflow" "test" "FkbL6CVp5Q")
+(fixme-set "workflow" "test" "7MxDVXBd2e")
+(fixme-set "workflow" "test" "8BdLTM4Ds1")
\ No newline at end of file
diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs
index 2e3a0ff3..a2882e28 100644
--- a/hbs2-peer/app/BlockDownload.hs
+++ b/hbs2-peer/app/BlockDownload.hs
@@ -41,6 +41,7 @@ import Data.Maybe
 import Lens.Micro.Platform
 import System.Random (randomRIO)
 import System.Random.Shuffle (shuffleM)
+import Numeric (showGFloat)
 
 getBlockForDownload :: forall e m . (MonadIO m, IsPeerAddr e m, MyPeer e)
                      => Peer e
@@ -492,13 +493,13 @@ blockDownloadLoop env0 = do
       down      <- liftIO $ readTVarIO (view peerDownloadedBlk pinfo)
       rtt       <- liftIO $ readTVarIO (view peerRTT pinfo) <&> fmap realToFrac
 
-      let rttMs = (/1e6) <$> rtt  <&> floor
+      let rttMs = (/1e6) <$> rtt <&> (\x -> showGFloat (Just 2) x "") <&> (<> "ms")
 
       notice $ "peer" <+> pretty p <+> "burst:" <+> pretty burst
                                    <+> "burst-max:" <+> pretty buM
                                    <+> "errors:" <+> pretty (downFails + errors)
                                    <+> "down:" <+> pretty down
-                                   <+> "rtt:" <+> pretty rttMs <> "ms"
+                                   <+> "rtt:" <+> pretty rttMs
       pure ()
 
   void $ liftIO $ async $ forever $ withPeerM e $ withDownload env0 do
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index fa9c187a..c2d8e1e9 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -591,6 +591,25 @@ runPeer opts = Exception.handle myException $ do
 
                 banned <- peerBanned p d
 
+                let doAddPeer p = do
+                        addPeers pl [p]
+
+                        -- TODO: better-handling-for-new-peers
+                        npi    <- newPeerInfo
+
+                        here <- find @e (KnownPeerKey p) id <&> isJust
+
+                        pfails <- fetch True npi (PeerInfoKey p) (view peerPingFailed)
+                        liftIO $ atomically $ writeTVar pfails 0
+                        -- pdownfails <- fetch True npi (PeerInfoKey p) (view peerDownloadFail)
+
+                        unless here do
+                          -- liftIO $ atomically $ writeTVar pdownfails 0
+
+                          debug $ "Got authorized peer!" <+> pretty p
+                                                         <+> pretty (AsBase58 (view peerSignKey d))
+
+
                 -- FIXME: check if we've got a reference to ourselves
                 if | pnonce == thatNonce -> do
                     delPeers pl [p]
@@ -616,25 +635,29 @@ runPeer opts = Exception.handle myException $ do
                       -- TODO: prefer-local-peer-with-same-nonce-over-remote-peer
                       --   remove remote peer
                       --   add local peer
-                      Just p0 | p0 /= p -> debug "Same peer, different address"
-                      _ -> do
+                      Just p0 | p0 /= p -> do
+                        debug "Same peer, different address"
 
-                        addPeers pl [p]
+                        void $ runMaybeT do
+                          tv0 <- MaybeT $ find (PeerInfoKey p0) (view peerRTT)
+                          tv1 <- MaybeT $ find (PeerInfoKey p) (view peerRTT)
 
-                        -- TODO: better-handling-for-new-peers
-                        npi    <- newPeerInfo
+                          rtt0 <- MaybeT $ liftIO $ readTVarIO tv0
+                          rtt1 <- MaybeT $ liftIO $ readTVarIO tv1
 
-                        here <- find @e (KnownPeerKey p) id <&> isJust
+                          when ( rtt1 < rtt0 ) do
+                            debug $ "Better rtt!" <+> pretty p0
+                                                  <+> pretty p
+                                                  <+> pretty rtt0
+                                                  <+> pretty rtt1
 
-                        pfails <- fetch True npi (PeerInfoKey p) (view peerPingFailed)
-                        liftIO $ atomically $ writeTVar pfails 0
-                        -- pdownfails <- fetch True npi (PeerInfoKey p) (view peerDownloadFail)
+                            lift $ do
+                              expire (KnownPeerKey p0)
+                              delPeers pl [p]
+                              doAddPeer p
 
-                        unless here do
-                          -- liftIO $ atomically $ writeTVar pdownfails 0
+                      _ -> doAddPeer p
 
-                          debug $ "Got authorized peer!" <+> pretty p
-                                                         <+> pretty (AsBase58 (view peerSignKey d))
 
               void $ liftIO $ async $ withPeerM env do
                 pause @'Seconds 1