{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE ScopedTypeVariables   #-}

#if __GLASGOW_HASKELL__ < 904
{-# OPTIONS_GHC -Wno-name-shadowing #-}
#endif

-- | This subsystem manages the discovery and selection of /upstream/ peers.
--
module Ouroboros.Cardano.PeerSelection.Churn (peerChurnGovernor) where

import Data.Void (Void)

import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Tracer (traceWith)
import System.Random

import Cardano.Network.ConsensusMode (ConsensusMode (..))
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Cardano.Network.Types (LedgerStateJudgement (..))
import Control.Applicative (Alternative)
import Data.Functor (($>))
import Data.Monoid.Synchronisation (FirstToFinish (..))
import Ouroboros.Cardano.Network.LedgerPeerConsensusInterface qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Churn.ExtraArguments qualified as Churn
import Ouroboros.Cardano.Network.Types (ChurnMode (..))
import Ouroboros.Network.BlockFetch (FetchMode (..), PraosFetchMode (..))
import Ouroboros.Network.Diffusion.Policies (churnEstablishConnectionTimeout,
           closeConnectionTimeout, deactivateTimeout)
import Ouroboros.Network.PeerSelection.Churn (CheckPeerSelectionCounters,
           ChurnCounters (..), ModifyPeerSelectionTargets, PeerChurnArgs (..))
import Ouroboros.Network.PeerSelection.Governor.Types hiding (targets)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..))

-- | Tag indicating churning approach
-- There are three syncing methods that networking layer supports, the legacy
-- method with or without bootstrap peers, and the Genesis method that relies
-- on chain skipping optimization courtesy of consensus, which also provides

--
data ChurnRegime = ChurnDefault
                 -- ^ tag to use Praos targets when caught up, or Genesis
                 -- targets when syncing in case that is the consensus mode
                 | ChurnPraosSync
                 -- ^ Praos targets to churn normally when syncing
                 | ChurnBootstrapPraosSync
                 -- ^ Praos targets further reduced to conserve resources
                 -- when syncing

getPeerSelectionTargets
  :: ConsensusMode
  -> LedgerStateJudgement
  -> PeerSelectionTargets
  -> PeerSelectionTargets
  -> PeerSelectionTargets
getPeerSelectionTargets :: ConsensusMode
-> LedgerStateJudgement
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
getPeerSelectionTargets ConsensusMode
consensus LedgerStateJudgement
lsj PeerSelectionTargets
deadlineTargets PeerSelectionTargets
syncTargets =
  case (ConsensusMode
consensus, LedgerStateJudgement
lsj) of
    (ConsensusMode
GenesisMode, LedgerStateJudgement
TooOld) -> PeerSelectionTargets
syncTargets
    (ConsensusMode, LedgerStateJudgement)
_otherwise            -> PeerSelectionTargets
deadlineTargets

pickChurnRegime :: ConsensusMode -> ChurnMode -> UseBootstrapPeers -> ChurnRegime
pickChurnRegime :: ConsensusMode -> ChurnMode -> UseBootstrapPeers -> ChurnRegime
pickChurnRegime ConsensusMode
consensus ChurnMode
churn UseBootstrapPeers
ubp =
  case (ChurnMode
churn, UseBootstrapPeers
ubp, ConsensusMode
consensus) of
    (ChurnMode
ChurnModeNormal, UseBootstrapPeers
_, ConsensusMode
_)                     -> ChurnRegime
ChurnDefault
    (ChurnMode
_, UseBootstrapPeers
_, ConsensusMode
GenesisMode)                         -> ChurnRegime
ChurnDefault
    (ChurnMode
ChurnModeBulkSync, UseBootstrapPeers [RelayAccessPoint]
_, ConsensusMode
_) -> ChurnRegime
ChurnBootstrapPraosSync
    (ChurnMode
ChurnModeBulkSync, UseBootstrapPeers
_, ConsensusMode
_)                   -> ChurnRegime
ChurnPraosSync

-- | Churn governor.
--
-- At every churn interval decrease active peers for a short while (1s), so that
-- we can pick new ones. Then we churn non-active peers.
--
-- On startup the churn governor gives a head start to local root peers over
-- root peers.
--
peerChurnGovernor
  :: forall m extraState extraFlags extraCounters extraPeers peeraddr.
     ( MonadDelay m
     , Alternative (STM m)
     , MonadTimer m
     , MonadCatch m
     )
  => PeerChurnArgs
      m
      (Churn.ExtraArguments m)
      extraState
      extraFlags
      extraPeers
      (Cardano.LedgerPeersConsensusInterface m)
      extraCounters
      peeraddr
  -> m Void
peerChurnGovernor :: forall (m :: * -> *) extraState extraFlags extraCounters extraPeers
       peeraddr.
(MonadDelay m, Alternative (STM m), MonadTimer m, MonadCatch m) =>
PeerChurnArgs
  m
  (ExtraArguments m)
  extraState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface m)
  extraCounters
  peeraddr
-> m Void
peerChurnGovernor PeerChurnArgs {
                    pcaPeerSelectionTracer :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> Tracer
     m
     (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
pcaPeerSelectionTracer = Tracer
  m (TracePeerSelection extraState extraFlags extraPeers peeraddr)
tracer,
                    pcaChurnTracer :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> Tracer m ChurnCounters
pcaChurnTracer         = Tracer m ChurnCounters
churnTracer,
                    pcaDeadlineInterval :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> DiffTime
pcaDeadlineInterval    = DiffTime
deadlineChurnInterval,
                    pcaBulkInterval :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> DiffTime
pcaBulkInterval        = DiffTime
bulkChurnInterval,
                    pcaPeerRequestTimeout :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> DiffTime
pcaPeerRequestTimeout  = DiffTime
requestPeersTimeout,
                    pcaRng :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> StdGen
pcaRng                 = StdGen
inRng,
                    pcaPeerSelectionVar :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> StrictTVar m PeerSelectionTargets
pcaPeerSelectionVar    = StrictTVar m PeerSelectionTargets
peerSelectionVar,
                    pcaReadCounters :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> STM m (PeerSelectionCounters extraCounters)
pcaReadCounters        = STM m (PeerSelectionCounters extraCounters)
readCounters,
                    getLedgerStateCtx :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> LedgerPeersConsensusInterface extraAPI m
getLedgerStateCtx = LedgerPeersConsensusInterface {
                      lpExtraAPI :: forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m -> extraAPI
lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
                        STM m LedgerStateJudgement
getLedgerStateJudgement :: STM m LedgerStateJudgement
getLedgerStateJudgement :: forall (m :: * -> *).
LedgerPeersConsensusInterface m -> STM m LedgerStateJudgement
Cardano.getLedgerStateJudgement
                      }
                    },
                    STM m HotValency
getLocalRootHotTarget :: STM m HotValency
getLocalRootHotTarget :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> STM m HotValency
getLocalRootHotTarget,
                    PeerSelectionTargets
getOriginalPeerTargets :: PeerSelectionTargets
getOriginalPeerTargets :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> PeerSelectionTargets
getOriginalPeerTargets,
                    getExtraArgs :: forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> extraArgs
getExtraArgs = Churn.ExtraArguments {
                      modeVar :: forall (m :: * -> *). ExtraArguments m -> StrictTVar m ChurnMode
Churn.modeVar             = StrictTVar m ChurnMode
churnModeVar,
                      readFetchMode :: forall (m :: * -> *). ExtraArguments m -> STM m FetchMode
Churn.readFetchMode       = STM m FetchMode
getFetchMode,
                      readUseBootstrap :: forall (m :: * -> *). ExtraArguments m -> STM m UseBootstrapPeers
Churn.readUseBootstrap    = STM m UseBootstrapPeers
getUseBootstrapPeers,
                      consensusMode :: forall (m :: * -> *). ExtraArguments m -> ConsensusMode
Churn.consensusMode       = ConsensusMode
consensusMode,
                      PeerSelectionTargets
genesisPeerTargets :: PeerSelectionTargets
genesisPeerTargets :: forall (m :: * -> *). ExtraArguments m -> PeerSelectionTargets
Churn.genesisPeerTargets
                    }
                  } = do
  -- Wait a while so that not only the closest peers have had the time
  -- to become warm.
  startTs0 <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
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 $ do
    (churnMode, ledgerStateJudgement, useBootstrapPeers, ltt)
      <- (,,,) <$> updateChurnMode <*> getLedgerStateJudgement <*> getUseBootstrapPeers <*> getLocalRootHotTarget
    let regime  = ConsensusMode -> ChurnMode -> UseBootstrapPeers -> ChurnRegime
pickChurnRegime ConsensusMode
consensusMode ChurnMode
churnMode UseBootstrapPeers
useBootstrapPeers
        targets = ConsensusMode
-> LedgerStateJudgement
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
getPeerSelectionTargets ConsensusMode
consensusMode LedgerStateJudgement
ledgerStateJudgement PeerSelectionTargets
getOriginalPeerTargets PeerSelectionTargets
genesisPeerTargets

    modifyTVar peerSelectionVar ( increaseActivePeers regime ltt targets
                                . increaseEstablishedPeers regime ltt targets)

  endTs0 <- getMonotonicTime
  fuzzyDelay inRng (endTs0 `diffTime` startTs0) >>= churnLoop

  where
    updateChurnMode :: STM m ChurnMode
    updateChurnMode :: STM m ChurnMode
updateChurnMode = do
        fm <- STM m FetchMode
getFetchMode
        let mode = case FetchMode
fm of
                     PraosFetchMode PraosFetchMode
FetchModeDeadline -> ChurnMode
ChurnModeNormal
                     PraosFetchMode PraosFetchMode
FetchModeBulkSync -> ChurnMode
ChurnModeBulkSync
                     FetchMode
FetchModeGenesis                 -> ChurnMode
ChurnModeBulkSync
        writeTVar churnModeVar mode
        return mode

    -- | Update the targets to a given value, and block until they are reached.
    -- The time we are blocked is limited by a timeout.
    --
    updateTargets
      :: ChurnAction
      -- ^ churn actions for tracing
      -> (PeerSelectionCounters extraCounters -> Int)
      -- ^ counter getter
      -> DiffTime
      -- ^ timeout
      -> (ChurnRegime -> HotValency -> PeerSelectionTargets -> ModifyPeerSelectionTargets)
      -- ^ update counters function
      -> CheckPeerSelectionCounters extraCounters
      -- ^ check counters
      -> m ()
    updateTargets :: ChurnAction
-> (PeerSelectionCounters extraCounters -> Int)
-> DiffTime
-> (ChurnRegime
    -> HotValency
    -> PeerSelectionTargets
    -> PeerSelectionTargets
    -> PeerSelectionTargets)
-> CheckPeerSelectionCounters extraCounters
-> m ()
updateTargets ChurnAction
churnAction PeerSelectionCounters extraCounters -> Int
getCounter DiffTime
timeoutDelay ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
modifyTargets CheckPeerSelectionCounters extraCounters
checkCounters = do
      -- update targets, and return the new targets
      startTime <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
      (c, targets) <- atomically $ do
        churnMode <- updateChurnMode
        ltt       <- getLocalRootHotTarget
        lsj       <- getLedgerStateJudgement
        regime    <- pickChurnRegime consensusMode churnMode <$> getUseBootstrapPeers
        let targets = ConsensusMode
-> LedgerStateJudgement
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
getPeerSelectionTargets ConsensusMode
consensusMode LedgerStateJudgement
lsj PeerSelectionTargets
getOriginalPeerTargets PeerSelectionTargets
genesisPeerTargets

        (,) <$> (getCounter <$> readCounters)
            <*> stateTVar peerSelectionVar ((\PeerSelectionTargets
a -> (PeerSelectionTargets
a, PeerSelectionTargets
a)) . modifyTargets regime ltt targets)

      -- create timeout and block on counters
      bracketOnError (registerDelayCancellable timeoutDelay)
                     (\(STM m TimeoutState
_readTimeout, m ()
cancelTimeout) -> m ()
cancelTimeout)
                     (\( STM m TimeoutState
readTimeout, m ()
cancelTimeout) -> do
                         -- block until counters reached the targets, or the timeout fires
                         a <- STM m (Either Int Int) -> m (Either Int Int)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Either Int Int) -> m (Either Int Int))
-> STM m (Either Int Int) -> m (Either Int Int)
forall a b. (a -> b) -> a -> b
$ do
                                counters <- STM m (PeerSelectionCounters extraCounters)
readCounters
                                runFirstToFinish $
                                  FirstToFinish (check (checkCounters counters targets) $> (Right $ getCounter counters ))
                                  <>
                                  FirstToFinish (readTimeout >>= \case TimeoutState
TimeoutPending -> STM m (Either Int Int)
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
                                                                       TimeoutState
_              -> Either Int Int -> STM m (Either Int Int)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Int Int
forall a b. a -> Either a b
Left (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ PeerSelectionCounters extraCounters -> Int
getCounter PeerSelectionCounters extraCounters
counters))
                         case a of
                           Right Int
c' -> do
                             let r :: Int
r = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                             endTime <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                             traceWith tracer (TraceChurnAction (endTime `diffTime` startTime) churnAction r)
                             traceWith churnTracer (ChurnCounter churnAction r)
                           Left Int
c' -> do
                             endTime <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                             cancelTimeout
                             let r = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                             traceWith tracer (TraceChurnTimeout (endTime `diffTime` startTime) churnAction r)
                             traceWith churnTracer (ChurnCounter churnAction r)
                     )

    --
    -- Functions to modify `PeerSelectionTargets` and check
    -- `PeerSelectionCounters`.
    --

    -- TODO: #3396 revisit the policy for genesis
    increaseActivePeers :: ChurnRegime
                        -> HotValency
                        -> PeerSelectionTargets
                        -> ModifyPeerSelectionTargets
    increaseActivePeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseActivePeers ChurnRegime
regime (HotValency Int
ltt) PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfActivePeers =
          case regime of
            ChurnRegime
ChurnDefault -> PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base
            ChurnRegime
_otherwise   -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min ((Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
ltt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base) }

    checkActivePeersIncreased :: CheckPeerSelectionCounters extraCounters
    checkActivePeersIncreased :: CheckPeerSelectionCounters extraCounters
checkActivePeersIncreased
      PeerSelectionCounters { Int
numberOfActivePeers :: Int
numberOfActivePeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActivePeers }
      PeerSelectionTargets { Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers }
      =
      Int
numberOfActivePeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfActivePeers

    decreaseActivePeers :: ChurnRegime
                        -> HotValency
                        -> PeerSelectionTargets
                        -> ModifyPeerSelectionTargets
    decreaseActivePeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseActivePeers ChurnRegime
regime (HotValency Int
ltt) PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfActivePeers =
          case regime of
            ChurnRegime
ChurnDefault -> Int -> Int
decrease (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base
            ChurnRegime
_otherwise   -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
ltt) (PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) }

    checkActivePeersDecreased :: CheckPeerSelectionCounters extraCounters
    checkActivePeersDecreased :: CheckPeerSelectionCounters extraCounters
checkActivePeersDecreased
      PeerSelectionCounters { Int
numberOfActivePeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActivePeers :: Int
numberOfActivePeers }
      PeerSelectionTargets { Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers }
      =
         Int
numberOfActivePeers
      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfActivePeers

    increaseEstablishedPeers :: ChurnRegime
                             -> HotValency
                             -> PeerSelectionTargets
                             -> ModifyPeerSelectionTargets
    increaseEstablishedPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseEstablishedPeers ChurnRegime
regime HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfEstablishedPeers =
          case regime of
            ChurnRegime
ChurnBootstrapPraosSync -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
targets Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                           (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
base)
            -- ^ In this mode, we are only connected to a handful of bootstrap peers.
            -- The original churn strategy was to increase the targets by small
            -- fixed amount (e.g. 1). Therefore, we use
            -- targets to calculate the upper bound, ie. active + 1 here.
            ChurnRegime
_otherwise -> PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
base }

    checkEstablishedPeersIncreased :: CheckPeerSelectionCounters extraCounters
    checkEstablishedPeersIncreased :: CheckPeerSelectionCounters extraCounters
checkEstablishedPeersIncreased
      PeerSelectionCounters { Int
numberOfEstablishedPeers :: Int
numberOfEstablishedPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedPeers }
      PeerSelectionTargets { Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers }
      =
         Int
numberOfEstablishedPeers
      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfEstablishedPeers

    increaseEstablishedBigLedgerPeers
      :: ChurnRegime
      -> HotValency
      -> PeerSelectionTargets
      -> ModifyPeerSelectionTargets
    increaseEstablishedBigLedgerPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseEstablishedBigLedgerPeers ChurnRegime
_ HotValency
_ PeerSelectionTargets
base
      PeerSelectionTargets
targets
      =
      PeerSelectionTargets
targets { targetNumberOfEstablishedBigLedgerPeers = targetNumberOfEstablishedBigLedgerPeers base }

    checkEstablishedBigLedgerPeersIncreased
      :: CheckPeerSelectionCounters extraCounters
    checkEstablishedBigLedgerPeersIncreased :: CheckPeerSelectionCounters extraCounters
checkEstablishedBigLedgerPeersIncreased
      PeerSelectionCounters { Int
numberOfEstablishedBigLedgerPeers :: Int
numberOfEstablishedBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedBigLedgerPeers }
      PeerSelectionTargets { Int
targetNumberOfEstablishedBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers }
      =
      Int
numberOfEstablishedBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfEstablishedBigLedgerPeers

    decreaseEstablishedPeers
      :: ChurnRegime
      -> HotValency
      -> PeerSelectionTargets
      -> ModifyPeerSelectionTargets
    decreaseEstablishedPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseEstablishedPeers ChurnRegime
regime HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfEstablishedPeers =
          case regime of
            ChurnRegime
ChurnBootstrapPraosSync -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
targets)
                                           (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
base Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            -- ^ In this mode, we are only connected to a handful of bootstrap peers.
            -- The original churn strategy was to decrease the targets by small
            -- fixed amount (e.g. 1) and then increase it back, and to churn out
            -- all warm peers to speed up the time to find the best performers.
            -- That is why we use the number of active peers in current targets
            -- as the upper bound on the number of established peers during this action.
            ChurnRegime
_otherwise ->   Int -> Int
decrease (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
base Int -> Int -> Int
forall a. Num a => a -> a -> a
- PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base)
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base }

    checkEstablishedPeersDecreased
      :: CheckPeerSelectionCounters extraCounters
    checkEstablishedPeersDecreased :: CheckPeerSelectionCounters extraCounters
checkEstablishedPeersDecreased
      PeerSelectionCounters { Int
numberOfEstablishedPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedPeers :: Int
numberOfEstablishedPeers }
      PeerSelectionTargets { Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers }
      =
         Int
numberOfEstablishedPeers
      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfEstablishedPeers

    increaseActiveBigLedgerPeers :: ChurnRegime
                                 -> HotValency
                                 -> PeerSelectionTargets
                                 -> ModifyPeerSelectionTargets
    increaseActiveBigLedgerPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseActiveBigLedgerPeers ChurnRegime
regime HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfActiveBigLedgerPeers =
          let praosSyncTargets = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base)
          in case regime of
               ChurnRegime
ChurnBootstrapPraosSync -> Int
praosSyncTargets
               ChurnRegime
ChurnPraosSync -> Int
praosSyncTargets
               ChurnRegime
ChurnDefault -> PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base }

    checkActiveBigLedgerPeersIncreased
      :: CheckPeerSelectionCounters extraCounters
    checkActiveBigLedgerPeersIncreased :: CheckPeerSelectionCounters extraCounters
checkActiveBigLedgerPeersIncreased
      PeerSelectionCounters { Int
numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveBigLedgerPeers }
      PeerSelectionTargets { Int
targetNumberOfActiveBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers }
      =
      Int
numberOfActiveBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfActiveBigLedgerPeers

    decreaseActiveBigLedgerPeers :: ChurnRegime
                                 -> HotValency
                                 -> PeerSelectionTargets
                                 -> ModifyPeerSelectionTargets
    decreaseActiveBigLedgerPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseActiveBigLedgerPeers ChurnRegime
regime HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfActiveBigLedgerPeers =
          let praosSyncTargets = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base)
          in case regime of
               ChurnRegime
ChurnBootstrapPraosSync -> Int
praosSyncTargets
               ChurnRegime
ChurnPraosSync -> Int
praosSyncTargets
               ChurnRegime
ChurnDefault -> Int -> Int
decrease (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base }

    checkActiveBigLedgerPeersDecreased
      :: CheckPeerSelectionCounters extraCounters
    checkActiveBigLedgerPeersDecreased :: CheckPeerSelectionCounters extraCounters
checkActiveBigLedgerPeersDecreased
      PeerSelectionCounters { Int
numberOfActiveBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeers }
      PeerSelectionTargets { Int
targetNumberOfActiveBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers }
      =
         Int
numberOfActiveBigLedgerPeers
      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfActiveBigLedgerPeers

    decreaseEstablishedBigLedgerPeers :: ChurnRegime
                                      -> HotValency
                                      -> PeerSelectionTargets
                                      -> ModifyPeerSelectionTargets
    decreaseEstablishedBigLedgerPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseEstablishedBigLedgerPeers ChurnRegime
_ HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfEstablishedBigLedgerPeers =
          decrease (targetNumberOfEstablishedBigLedgerPeers base -
                    targetNumberOfActiveBigLedgerPeers base)
          + targetNumberOfActiveBigLedgerPeers base
        }

    checkEstablishedBigLedgerPeersDecreased
      :: CheckPeerSelectionCounters extraCounters
    checkEstablishedBigLedgerPeersDecreased :: CheckPeerSelectionCounters extraCounters
checkEstablishedBigLedgerPeersDecreased
      PeerSelectionCounters { Int
numberOfEstablishedBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedBigLedgerPeers :: Int
numberOfEstablishedBigLedgerPeers }
      PeerSelectionTargets { Int
targetNumberOfEstablishedBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers }
      =
         Int
numberOfEstablishedBigLedgerPeers
      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfEstablishedBigLedgerPeers


    decreaseKnownPeers
      :: ChurnRegime
      -> HotValency
      -> PeerSelectionTargets
      -> ModifyPeerSelectionTargets
    decreaseKnownPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseKnownPeers ChurnRegime
_ HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfRootPeers =
            decrease (targetNumberOfRootPeers base - targetNumberOfEstablishedPeers base)
            + targetNumberOfEstablishedPeers base
        , targetNumberOfKnownPeers =
            decrease (targetNumberOfKnownPeers base - targetNumberOfEstablishedPeers base)
            + targetNumberOfEstablishedPeers base
        }

    checkKnownPeersDecreased
      :: PeerSelectionCounters extraCounters -> PeerSelectionTargets -> Bool
    checkKnownPeersDecreased :: CheckPeerSelectionCounters extraCounters
checkKnownPeersDecreased
      PeerSelectionCounters { Int
numberOfKnownPeers :: Int
numberOfKnownPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownPeers }
      PeerSelectionTargets { Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers }
      =
        -- note: we are not checking target root peers, since it is a one-sided
        -- target
         Int
numberOfKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfKnownPeers

    decreaseKnownBigLedgerPeers
      :: ChurnRegime
      -> HotValency
      -> PeerSelectionTargets
      -> ModifyPeerSelectionTargets
    decreaseKnownBigLedgerPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseKnownBigLedgerPeers ChurnRegime
_ HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfKnownBigLedgerPeers =
            decrease (targetNumberOfKnownBigLedgerPeers base -
                      targetNumberOfEstablishedBigLedgerPeers base)
            + targetNumberOfEstablishedBigLedgerPeers base
        }

    checkKnownBigLedgerPeersDecreased
      :: PeerSelectionCounters extraCounters -> PeerSelectionTargets -> Bool
    checkKnownBigLedgerPeersDecreased :: CheckPeerSelectionCounters extraCounters
checkKnownBigLedgerPeersDecreased
      PeerSelectionCounters { Int
numberOfKnownBigLedgerPeers :: Int
numberOfKnownBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownBigLedgerPeers }
      PeerSelectionTargets { Int
targetNumberOfKnownBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers }
      = Int
numberOfKnownBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfKnownBigLedgerPeers


    increaseKnownPeers
      :: ChurnRegime
      -> HotValency
      -> PeerSelectionTargets
      -> ModifyPeerSelectionTargets
    increaseKnownPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseKnownPeers ChurnRegime
_ HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfRootPeers = targetNumberOfRootPeers base
        , targetNumberOfKnownPeers = targetNumberOfKnownPeers base
        }

    checkKnownPeersIncreased
      :: CheckPeerSelectionCounters extraCounters
    checkKnownPeersIncreased :: CheckPeerSelectionCounters extraCounters
checkKnownPeersIncreased
      PeerSelectionCounters { Int
numberOfRootPeers :: Int
numberOfRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfRootPeers,
                              Int
numberOfKnownPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownPeers :: Int
numberOfKnownPeers }
      PeerSelectionTargets { Int
targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers :: Int
targetNumberOfRootPeers,
                             Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers }
      =
         Int
numberOfRootPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfRootPeers
      Bool -> Bool -> Bool
&& Int
numberOfKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfKnownPeers


    increaseKnownBigLedgerPeers
      :: ChurnRegime
      -> HotValency
      -> PeerSelectionTargets
      -> ModifyPeerSelectionTargets
    increaseKnownBigLedgerPeers :: ChurnRegime
-> HotValency
-> PeerSelectionTargets
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseKnownBigLedgerPeers ChurnRegime
_ HotValency
_ PeerSelectionTargets
base PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfKnownBigLedgerPeers = targetNumberOfKnownBigLedgerPeers base
        }

    checkKnownBigLedgerPeersIncreased
      :: CheckPeerSelectionCounters extraCounters
    checkKnownBigLedgerPeersIncreased :: CheckPeerSelectionCounters extraCounters
checkKnownBigLedgerPeersIncreased
      PeerSelectionCounters { Int
numberOfKnownBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownBigLedgerPeers :: Int
numberOfKnownBigLedgerPeers }
      PeerSelectionTargets { Int
targetNumberOfKnownBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers }
      =
      Int
numberOfKnownBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetNumberOfKnownBigLedgerPeers


    --
    -- Main loop
    --

    churnLoop :: StdGen -> m Void
    churnLoop :: StdGen -> m Void
churnLoop !StdGen
rng = do
      startTs <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime

      churnMode <- atomically updateChurnMode
      traceWith tracer $ TraceChurnMode churnMode

      -- Purge the worst active big ledger peers.
      updateTargets DecreasedActiveBigLedgerPeers
                    numberOfActiveBigLedgerPeers
                    deactivateTimeout
                    decreaseActiveBigLedgerPeers
                    checkActiveBigLedgerPeersDecreased

      -- Pick new active big ledger peers.
      updateTargets IncreasedActiveBigLedgerPeers
                    numberOfActiveBigLedgerPeers
                    shortTimeout
                    increaseActiveBigLedgerPeers
                    checkActiveBigLedgerPeersIncreased

      -- Forget the worst performing established big ledger peers.
      updateTargets DecreasedEstablishedBigLedgerPeers
                    numberOfEstablishedBigLedgerPeers
                    (1 + closeConnectionTimeout)
                    decreaseEstablishedBigLedgerPeers
                    checkEstablishedBigLedgerPeersDecreased

      -- Forget the worst performing known big ledger peers.
      updateTargets DecreasedKnownBigLedgerPeers
                    numberOfKnownBigLedgerPeers
                    shortTimeout
                    decreaseKnownBigLedgerPeers
                    checkKnownBigLedgerPeersDecreased

      -- Pick new known big ledger peers
      updateTargets IncreasedKnownBigLedgerPeers
                    numberOfKnownBigLedgerPeers
                    (2 * requestPeersTimeout + shortTimeout)
                    increaseKnownBigLedgerPeers
                    checkKnownBigLedgerPeersIncreased

      -- Pick new non-active big ledger peers
      updateTargets IncreasedEstablishedBigLedgerPeers
                    numberOfEstablishedBigLedgerPeers
                    churnEstablishConnectionTimeout
                    increaseEstablishedBigLedgerPeers
                    checkEstablishedBigLedgerPeersIncreased

      -- Purge the worst active peers.
      updateTargets DecreasedActivePeers
                    numberOfActivePeers
                    deactivateTimeout
                    decreaseActivePeers
                    checkActivePeersDecreased

      -- Pick new active peers.
      updateTargets IncreasedActivePeers
                    numberOfActivePeers
                    shortTimeout
                    increaseActivePeers
                    checkActivePeersIncreased

      -- Forget the worst performing established peers.
      updateTargets DecreasedEstablishedPeers
                    numberOfEstablishedPeers
                    (1 + closeConnectionTimeout)
                    decreaseEstablishedPeers
                    checkEstablishedPeersDecreased

      -- Forget the worst performing known peers (root peers, ledger peers)
      updateTargets DecreasedKnownPeers
                    numberOfKnownPeers
                    shortTimeout
                    decreaseKnownPeers
                    checkKnownPeersDecreased

      -- Pick new known peers
      updateTargets IncreasedKnownPeers
                    numberOfKnownPeers
                    (2 * requestPeersTimeout + shortTimeout)
                    increaseKnownPeers
                    checkKnownPeersIncreased

      -- Pick new non-active peers
      updateTargets IncreasedEstablishedPeers
                    numberOfEstablishedPeers
                    churnEstablishConnectionTimeout
                    increaseEstablishedPeers
                    checkEstablishedPeersIncreased

      endTs <- getMonotonicTime

      fuzzyDelay rng (endTs `diffTime` startTs) >>= churnLoop

    --
    -- Auxiliary functions and constants
    --

    -- Randomly delay between churnInterval and churnInterval + maxFuzz seconds.
    fuzzyDelay :: StdGen -> DiffTime -> m StdGen
    fuzzyDelay :: StdGen -> DiffTime -> m StdGen
fuzzyDelay StdGen
rng DiffTime
execTime = do
      mode <- STM m FetchMode -> m FetchMode
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m FetchMode
getFetchMode
      -- todo: is this right?
      case (mode, consensusMode) of
        (PraosFetchMode PraosFetchMode
FetchModeDeadline, ConsensusMode
_) -> StdGen -> DiffTime -> m StdGen
longDelay StdGen
rng DiffTime
execTime
        (FetchMode
_, ConsensusMode
GenesisMode)                      -> StdGen -> DiffTime -> m StdGen
longDelay StdGen
rng DiffTime
execTime
        (FetchMode, ConsensusMode)
_otherwise                            -> StdGen -> DiffTime -> m StdGen
shortDelay StdGen
rng DiffTime
execTime

    fuzzyDelay' :: DiffTime -> Double -> StdGen -> DiffTime -> m StdGen
    fuzzyDelay' :: DiffTime -> Double -> StdGen -> DiffTime -> m StdGen
fuzzyDelay' DiffTime
baseDelay Double
maxFuzz StdGen
rng DiffTime
execTime = do
      let (Double
fuzz, StdGen
rng') = (Double, Double) -> StdGen -> (Double, StdGen)
forall g. RandomGen g => (Double, Double) -> g -> (Double, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Double
0, Double
maxFuzz) StdGen
rng
          delay :: DiffTime
delay = Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fuzz DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
baseDelay DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
execTime
      Tracer
  m (TracePeerSelection extraState extraFlags extraPeers peeraddr)
-> TracePeerSelection extraState extraFlags extraPeers peeraddr
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m (TracePeerSelection extraState extraFlags extraPeers peeraddr)
tracer (TracePeerSelection extraState extraFlags extraPeers peeraddr
 -> m ())
-> TracePeerSelection extraState extraFlags extraPeers peeraddr
-> m ()
forall a b. (a -> b) -> a -> b
$ DiffTime
-> TracePeerSelection extraState extraFlags extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
DiffTime
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceChurnWait DiffTime
delay
      DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
delay
      StdGen -> m StdGen
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StdGen
rng'


    longDelay :: StdGen -> DiffTime -> m StdGen
    longDelay :: StdGen -> DiffTime -> m StdGen
longDelay = DiffTime -> Double -> StdGen -> DiffTime -> m StdGen
fuzzyDelay' DiffTime
deadlineChurnInterval Double
600

    shortDelay :: StdGen -> DiffTime -> m StdGen
    shortDelay :: StdGen -> DiffTime -> m StdGen
shortDelay = DiffTime -> Double -> StdGen -> DiffTime -> m StdGen
fuzzyDelay' DiffTime
bulkChurnInterval Double
60

    -- Ideally this would be as low as possible but the governor might be in
    -- the process of promoting/demoting a peer and it will take some time
    -- before it can act on new targets set by churn
    shortTimeout :: DiffTime
    shortTimeout :: DiffTime
shortTimeout = DiffTime
60

    -- Replace 20% or at least one peer every churnInterval.
    decrease :: Int -> Int
    decrease :: Int -> Int
decrease Int
v = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
v  Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5)