mirror of https://github.com/voidlizard/hbs2
rtt peer selection
This commit is contained in:
parent
fd7b0e31d5
commit
585f2a8025
|
@ -1,2 +1,4 @@
|
||||||
|
|
||||||
(fixme-set "workflow" "test" "FkbL6CVp5Q")
|
(fixme-set "workflow" "test" "FkbL6CVp5Q")
|
||||||
|
(fixme-set "workflow" "test" "7MxDVXBd2e")
|
||||||
|
(fixme-set "workflow" "test" "8BdLTM4Ds1")
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue