p2p-governor: Adjust number of active peers based on fetchmode

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,46 +570,70 @@ $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
   -- TODO: revisit the policy once we have local root peers in the governor.
   -- 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

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 =