diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs index 9260b696269..53ce3104f96 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs @@ -55,6 +55,7 @@ import qualified Ouroboros.Network.PeerSelection.Governor.KnownPeers as Kn import qualified Ouroboros.Network.PeerSelection.Governor.Monitor as Monitor import qualified Ouroboros.Network.PeerSelection.Governor.RootPeers as RootPeers import Ouroboros.Network.PeerSelection.Governor.Types +import Ouroboros.Network.BlockFetch (FetchMode (..)) -- TODO: at a later patch it will be defined in @@ -569,16 +570,18 @@ $peer-churn-governor -- | -- -peerChurnGovernor :: forall m. +peerChurnGovernor :: forall m peeraddr. ( MonadSTM m , MonadMonotonicTime m , MonadDelay m ) - => StdGen + => Tracer m (TracePeerSelection peeraddr) + -> StdGen + -> STM m FetchMode -> PeerSelectionTargets -> StrictTVar m PeerSelectionTargets -> m Void -peerChurnGovernor inRng base peerSelectionVar = do +peerChurnGovernor tracer inRng getFetchMode base peerSelectionVar = do -- Wait a while so that not only the closest peers have had the time -- to become warm. startTs0 <- getMonotonicTime @@ -586,29 +589,51 @@ peerChurnGovernor inRng base peerSelectionVar = do -- The intention is to give local root peers give head start and avoid -- giving advantage to hostile and quick root peers. threadDelay 3 - atomically $ modifyTVar peerSelectionVar (\targets -> targets { - targetNumberOfActivePeers = targetNumberOfActivePeers base - }) + atomically increaseActivePeers endTs0 <- getMonotonicTime - fuzzyDelay inRng (Time $ diffTime endTs0 startTs0) >>= go + fuzzyDelay inRng (endTs0 `diffTime` startTs0) >>= go where + + -- TODO: #3396 revisit the policy for genesis + increaseActivePeers :: STM m () + increaseActivePeers = do + mode <- getFetchMode + modifyTVar peerSelectionVar (\targets -> targets { + targetNumberOfActivePeers = + case mode of + FetchModeDeadline -> + targetNumberOfActivePeers base + FetchModeBulkSync -> + min 2 (targetNumberOfActivePeers base) + }) + + decreaseActivePeers :: STM m () + decreaseActivePeers = do + mode <- getFetchMode + modifyTVar peerSelectionVar (\targets -> targets { + targetNumberOfActivePeers = + case mode of + FetchModeDeadline -> + decrease $ targetNumberOfActivePeers base + FetchModeBulkSync -> + min 1 (targetNumberOfActivePeers base - 1) + }) + + + go :: StdGen -> m Void go rng = do startTs <- getMonotonicTime -- Purge the worst active peer(s). - atomically $ modifyTVar peerSelectionVar (\targets -> targets { - targetNumberOfActivePeers = decrease (targetNumberOfActivePeers base) - }) + atomically decreaseActivePeers -- Short delay, we may have no active peers right now threadDelay 1 -- Pick new active peer(s) based on the best performing established -- peers. - atomically $ modifyTVar peerSelectionVar (\targets -> targets { - targetNumberOfActivePeers = targetNumberOfActivePeers base - }) + atomically increaseActivePeers -- Give the promotion process time to start threadDelay 1 @@ -632,19 +657,38 @@ peerChurnGovernor inRng base peerSelectionVar = do }) endTs <- getMonotonicTime - fuzzyDelay rng (Time $ diffTime endTs startTs) >>= go + fuzzyDelay rng (endTs `diffTime` startTs) >>= go -- Randomly delay between churnInterval and churnInterval + maxFuzz seconds. - fuzzyDelay :: StdGen -> Time -> m StdGen + fuzzyDelay :: StdGen -> DiffTime -> m StdGen fuzzyDelay rng execTime = do - let (fuzz, rng') = randomR (0, 600 :: Double) rng - threadDelay $ (realToFrac fuzz) + (diffTime churnInterval execTime) + mode <- atomically getFetchMode + case mode of + FetchModeDeadline -> longDelay rng execTime + FetchModeBulkSync -> shortDelay rng execTime + + fuzzyDelay' :: DiffTime -> Double -> StdGen -> DiffTime -> m StdGen + fuzzyDelay' baseDelay maxFuzz rng execTime = do + let (fuzz, rng') = randomR (0, maxFuzz :: Double) rng + !delay = realToFrac fuzz + baseDelay - execTime + traceWith tracer $ TraceChurnWait delay + threadDelay delay return rng' + + longDelay :: StdGen -> DiffTime -> m StdGen + longDelay = fuzzyDelay' churnInterval 600 + + + shortDelay :: StdGen -> DiffTime -> m StdGen + shortDelay = fuzzyDelay' churnIntervalBulk 60 + -- The min time between running the churn governor. - churnInterval :: Time - churnInterval = Time 3300 + churnInterval :: DiffTime + churnInterval = 3300 + churnIntervalBulk :: DiffTime + churnIntervalBulk = 300 -- Replace 20% or at least on peer every churnInterval. decrease :: Int -> Int diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs index 3b207b9f90d..f47c8edc629 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -540,6 +540,7 @@ data TracePeerSelection peeraddr = | TraceDemoteHotDone Int Int peeraddr | TraceDemoteAsynchronous (Map peeraddr PeerStatus) | TraceGovernorWakeup + | TraceChurnWait DiffTime deriving Show data DebugPeerSelection peeraddr peerconn =