rtt peer selection

This commit is contained in:
Dmitry Zuikov 2023-04-02 13:29:56 +03:00
parent fd7b0e31d5
commit 585f2a8025
3 changed files with 42 additions and 16 deletions

View File

@ -1,2 +1,4 @@
(fixme-set "workflow" "test" "FkbL6CVp5Q") (fixme-set "workflow" "test" "FkbL6CVp5Q")
(fixme-set "workflow" "test" "7MxDVXBd2e")
(fixme-set "workflow" "test" "8BdLTM4Ds1")

View File

@ -41,6 +41,7 @@ import Data.Maybe
import Lens.Micro.Platform import Lens.Micro.Platform
import System.Random (randomRIO) import System.Random (randomRIO)
import System.Random.Shuffle (shuffleM) import System.Random.Shuffle (shuffleM)
import Numeric (showGFloat)
getBlockForDownload :: forall e m . (MonadIO m, IsPeerAddr e m, MyPeer e) getBlockForDownload :: forall e m . (MonadIO m, IsPeerAddr e m, MyPeer e)
=> Peer e => Peer e
@ -492,13 +493,13 @@ blockDownloadLoop env0 = do
down <- liftIO $ readTVarIO (view peerDownloadedBlk pinfo) down <- liftIO $ readTVarIO (view peerDownloadedBlk pinfo)
rtt <- liftIO $ readTVarIO (view peerRTT pinfo) <&> fmap realToFrac 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 notice $ "peer" <+> pretty p <+> "burst:" <+> pretty burst
<+> "burst-max:" <+> pretty buM <+> "burst-max:" <+> pretty buM
<+> "errors:" <+> pretty (downFails + errors) <+> "errors:" <+> pretty (downFails + errors)
<+> "down:" <+> pretty down <+> "down:" <+> pretty down
<+> "rtt:" <+> pretty rttMs <> "ms" <+> "rtt:" <+> pretty rttMs
pure () pure ()
void $ liftIO $ async $ forever $ withPeerM e $ withDownload env0 do void $ liftIO $ async $ forever $ withPeerM e $ withDownload env0 do

View File

@ -591,6 +591,25 @@ runPeer opts = Exception.handle myException $ do
banned <- peerBanned p d 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 -- FIXME: check if we've got a reference to ourselves
if | pnonce == thatNonce -> do if | pnonce == thatNonce -> do
delPeers pl [p] delPeers pl [p]
@ -616,25 +635,29 @@ runPeer opts = Exception.handle myException $ do
-- TODO: prefer-local-peer-with-same-nonce-over-remote-peer -- TODO: prefer-local-peer-with-same-nonce-over-remote-peer
-- remove remote peer -- remove remote peer
-- add local peer -- add local peer
Just p0 | p0 /= p -> debug "Same peer, different address" Just p0 | p0 /= p -> do
_ -> 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 rtt0 <- MaybeT $ liftIO $ readTVarIO tv0
npi <- newPeerInfo 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) lift $ do
liftIO $ atomically $ writeTVar pfails 0 expire (KnownPeerKey p0)
-- pdownfails <- fetch True npi (PeerInfoKey p) (view peerDownloadFail) delPeers pl [p]
doAddPeer p
unless here do _ -> doAddPeer p
-- liftIO $ atomically $ writeTVar pdownfails 0
debug $ "Got authorized peer!" <+> pretty p
<+> pretty (AsBase58 (view peerSignKey d))
void $ liftIO $ async $ withPeerM env do void $ liftIO $ async $ withPeerM env do
pause @'Seconds 1 pause @'Seconds 1