{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# 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.Network.PeerSelection.Churn
  ( peerChurnGovernor
  , ChurnCounters (..)
  ) 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 (Tracer (..), traceWith)
import System.Random

import Control.Applicative (Alternative)
import Data.Functor (($>))
import Data.Monoid.Synchronisation (FirstToFinish (..))
import Ouroboros.Network.BlockFetch (FetchMode (..))
import Ouroboros.Network.Diffusion.Policies (churnEstablishConnectionTimeout,
           closeConnectionTimeout, deactivateTimeout)
import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Ouroboros.Network.PeerSelection.Governor.Types hiding (targets)
import Ouroboros.Network.PeerSelection.PeerMetric
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..))


type ModifyPeerSelectionTargets = PeerSelectionTargets -> PeerSelectionTargets
type CheckPeerSelectionCounters = PeerSelectionCounters -> PeerSelectionTargets -> Bool

data ChurnCounters = ChurnCounter ChurnAction Int

-- | 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 peeraddr.
                     ( MonadDelay m
                     , Alternative (STM m)
                     , MonadTimer m
                     , MonadCatch m
                     )
                  => Tracer m (TracePeerSelection peeraddr)
                  -> Tracer m ChurnCounters
                  -> DiffTime
                  -- ^ the base for churn interval in the deadline mode.
                  -> DiffTime
                  -- ^ the base for churn interval in the bulk sync mode.
                  -> DiffTime
                  -- ^ the timeout for outbound governor to find new (thus
                  -- cold) peers through peer sharing mechanism.
                  -> PeerMetrics m peeraddr
                  -> StrictTVar m ChurnMode
                  -> StdGen
                  -> STM m FetchMode
                  -> PeerSelectionTargets
                  -- ^ base targets; set in a configuration file
                  -> StrictTVar m PeerSelectionTargets
                  -> STM m PeerSelectionCounters
                  -> STM m UseBootstrapPeers
                  -> STM m HotValency
                  -> m Void
peerChurnGovernor :: forall (m :: * -> *) peeraddr.
(MonadDelay m, Alternative (STM m), MonadTimer m, MonadCatch m) =>
Tracer m (TracePeerSelection peeraddr)
-> Tracer m ChurnCounters
-> DiffTime
-> DiffTime
-> DiffTime
-> PeerMetrics m peeraddr
-> StrictTVar m ChurnMode
-> StdGen
-> STM m FetchMode
-> PeerSelectionTargets
-> StrictTVar m PeerSelectionTargets
-> STM m PeerSelectionCounters
-> STM m UseBootstrapPeers
-> STM m HotValency
-> m Void
peerChurnGovernor Tracer m (TracePeerSelection peeraddr)
tracer Tracer m ChurnCounters
churnTracer
                  DiffTime
deadlineChurnInterval DiffTime
bulkChurnInterval DiffTime
requestPeersTimeout
                  PeerMetrics m peeraddr
_metrics StrictTVar m ChurnMode
churnModeVar StdGen
inRng STM m FetchMode
getFetchMode PeerSelectionTargets
base
                  StrictTVar m PeerSelectionTargets
peerSelectionVar STM m PeerSelectionCounters
readCounters
                  STM m UseBootstrapPeers
getUseBootstrapPeers STM m HotValency
getLocalRootHotTarget = do
  -- Wait a while so that not only the closest peers have had the time
  -- to become warm.
  Time
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.
  DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
3
  (ChurnMode
mode, UseBootstrapPeers
ubp, HotValency
ltt) <- STM m (ChurnMode, UseBootstrapPeers, HotValency)
-> m (ChurnMode, UseBootstrapPeers, HotValency)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (ChurnMode, UseBootstrapPeers, HotValency)
getExtState
  Tracer m (TracePeerSelection peeraddr)
-> TracePeerSelection peeraddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TracePeerSelection peeraddr)
tracer (TracePeerSelection peeraddr -> m ())
-> TracePeerSelection peeraddr -> m ()
forall a b. (a -> b) -> a -> b
$ ChurnMode -> TracePeerSelection peeraddr
forall peeraddr. ChurnMode -> TracePeerSelection peeraddr
TraceChurnMode ChurnMode
mode
  STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    StrictTVar m PeerSelectionTargets
-> (PeerSelectionTargets -> PeerSelectionTargets) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar m PeerSelectionTargets
peerSelectionVar ( ChurnMode
-> HotValency -> PeerSelectionTargets -> PeerSelectionTargets
increaseActivePeers ChurnMode
mode HotValency
ltt
                                (PeerSelectionTargets -> PeerSelectionTargets)
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> PeerSelectionTargets
-> PeerSelectionTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChurnMode
-> UseBootstrapPeers
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseEstablishedPeers ChurnMode
mode UseBootstrapPeers
ubp )
  Time
endTs0 <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
  StdGen -> DiffTime -> m StdGen
fuzzyDelay StdGen
inRng (Time
endTs0 Time -> Time -> DiffTime
`diffTime` Time
startTs0) m StdGen -> (StdGen -> m Void) -> m Void
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdGen -> m Void
churnLoop

  where

    getExtState :: STM m (ChurnMode, UseBootstrapPeers, HotValency)
    getExtState :: STM m (ChurnMode, UseBootstrapPeers, HotValency)
getExtState = do
        ChurnMode
cm <- STM m ChurnMode
updateChurnMode
        UseBootstrapPeers
bp <- STM m UseBootstrapPeers
getUseBootstrapPeers
        HotValency
ltt <- STM m HotValency
getLocalRootHotTarget
        (ChurnMode, UseBootstrapPeers, HotValency)
-> STM m (ChurnMode, UseBootstrapPeers, HotValency)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChurnMode
cm, UseBootstrapPeers
bp, HotValency
ltt)

    updateChurnMode :: STM m ChurnMode
    updateChurnMode :: STM m ChurnMode
updateChurnMode = do
        FetchMode
fm <- STM m FetchMode
getFetchMode
        let mode :: ChurnMode
mode = case FetchMode
fm of
                     FetchMode
FetchModeDeadline -> ChurnMode
ChurnModeNormal
                     FetchMode
FetchModeBulkSync -> ChurnMode
ChurnModeBulkSync
        StrictTVar m ChurnMode -> ChurnMode -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m ChurnMode
churnModeVar ChurnMode
mode
        ChurnMode -> STM m ChurnMode
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ChurnMode
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 -> Int)
      -- ^ counter getter
      -> DiffTime
      -- ^ timeout
      -> ModifyPeerSelectionTargets
      -- ^ update counters function
      -> CheckPeerSelectionCounters
      -- ^ check counters
      -> m ()
    updateTargets :: ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
churnAction PeerSelectionCounters -> Int
getCounter DiffTime
timeoutDelay PeerSelectionTargets -> PeerSelectionTargets
modifyTargets CheckPeerSelectionCounters
checkCounters = do
      -- update targets, and return the new targets
      Time
startTime <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
      (Int
c, PeerSelectionTargets
targets) <- STM m (Int, PeerSelectionTargets) -> m (Int, PeerSelectionTargets)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Int, PeerSelectionTargets)
 -> m (Int, PeerSelectionTargets))
-> STM m (Int, PeerSelectionTargets)
-> m (Int, PeerSelectionTargets)
forall a b. (a -> b) -> a -> b
$
        (,) (Int -> PeerSelectionTargets -> (Int, PeerSelectionTargets))
-> STM m Int
-> STM m (PeerSelectionTargets -> (Int, PeerSelectionTargets))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PeerSelectionCounters -> Int
getCounter (PeerSelectionCounters -> Int)
-> STM m PeerSelectionCounters -> STM m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m PeerSelectionCounters
readCounters)
            STM m (PeerSelectionTargets -> (Int, PeerSelectionTargets))
-> STM m PeerSelectionTargets -> STM m (Int, PeerSelectionTargets)
forall a b. STM m (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictTVar m PeerSelectionTargets
-> (PeerSelectionTargets
    -> (PeerSelectionTargets, PeerSelectionTargets))
-> STM m PeerSelectionTargets
forall (m :: * -> *) s a.
MonadSTM m =>
StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar StrictTVar m PeerSelectionTargets
peerSelectionVar ((\PeerSelectionTargets
a -> (PeerSelectionTargets
a, PeerSelectionTargets
a)) (PeerSelectionTargets
 -> (PeerSelectionTargets, PeerSelectionTargets))
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> PeerSelectionTargets
-> (PeerSelectionTargets, PeerSelectionTargets)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionTargets -> PeerSelectionTargets
modifyTargets)

      -- create timeout and block on counters
      m (STM m TimeoutState, m ())
-> ((STM m TimeoutState, m ()) -> m ())
-> ((STM m TimeoutState, m ()) -> m ())
-> m ()
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError (DiffTime -> m (STM m TimeoutState, m ())
forall (m :: * -> *).
MonadTimer m =>
DiffTime -> m (STM m TimeoutState, m ())
registerDelayCancellable DiffTime
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
                         Either Int Int
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
                                PeerSelectionCounters
counters <- STM m PeerSelectionCounters
readCounters
                                FirstToFinish (STM m) (Either Int Int) -> STM m (Either Int Int)
forall (m :: * -> *) a. FirstToFinish m a -> m a
runFirstToFinish (FirstToFinish (STM m) (Either Int Int) -> STM m (Either Int Int))
-> FirstToFinish (STM m) (Either Int Int) -> STM m (Either Int Int)
forall a b. (a -> b) -> a -> b
$
                                  STM m (Either Int Int) -> FirstToFinish (STM m) (Either Int Int)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (Bool -> STM m ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check (CheckPeerSelectionCounters
checkCounters PeerSelectionCounters
counters PeerSelectionTargets
targets) STM m () -> Either Int Int -> STM m (Either Int Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ PeerSelectionCounters -> Int
getCounter PeerSelectionCounters
counters ))
                                  FirstToFinish (STM m) (Either Int Int)
-> FirstToFinish (STM m) (Either Int Int)
-> FirstToFinish (STM m) (Either Int Int)
forall a. Semigroup a => a -> a -> a
<>
                                  STM m (Either Int Int) -> FirstToFinish (STM m) (Either Int Int)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (STM m TimeoutState
readTimeout STM m TimeoutState
-> (TimeoutState -> STM m (Either Int Int))
-> STM m (Either Int Int)
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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 -> Int
getCounter PeerSelectionCounters
counters))
                         case Either Int Int
a of
                           Right Int
c' -> do
                             let r :: Int
r = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                             Time
endTime <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                             Tracer m (TracePeerSelection peeraddr)
-> TracePeerSelection peeraddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TracePeerSelection peeraddr)
tracer (DiffTime -> ChurnAction -> Int -> TracePeerSelection peeraddr
forall peeraddr.
DiffTime -> ChurnAction -> Int -> TracePeerSelection peeraddr
TraceChurnAction (Time
endTime Time -> Time -> DiffTime
`diffTime` Time
startTime) ChurnAction
churnAction Int
r)
                             Tracer m ChurnCounters -> ChurnCounters -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m ChurnCounters
churnTracer (ChurnAction -> Int -> ChurnCounters
ChurnCounter ChurnAction
churnAction Int
r)
                           Left Int
c' -> do
                             Time
endTime <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                             m ()
cancelTimeout
                             let r :: Int
r = Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
                             Tracer m (TracePeerSelection peeraddr)
-> TracePeerSelection peeraddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TracePeerSelection peeraddr)
tracer (DiffTime -> ChurnAction -> Int -> TracePeerSelection peeraddr
forall peeraddr.
DiffTime -> ChurnAction -> Int -> TracePeerSelection peeraddr
TraceChurnTimeout (Time
endTime Time -> Time -> DiffTime
`diffTime` Time
startTime) ChurnAction
churnAction Int
r)
                             Tracer m ChurnCounters -> ChurnCounters -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m ChurnCounters
churnTracer (ChurnAction -> Int -> ChurnCounters
ChurnCounter ChurnAction
churnAction Int
r)
                     )

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

    -- TODO: #3396 revisit the policy for genesis
    increaseActivePeers :: ChurnMode
                        -> HotValency
                        -> ModifyPeerSelectionTargets
    increaseActivePeers :: ChurnMode
-> HotValency -> PeerSelectionTargets -> PeerSelectionTargets
increaseActivePeers
      ChurnMode
mode (HotValency Int
ltt) PeerSelectionTargets
targets
      =
      PeerSelectionTargets
targets {
        targetNumberOfActivePeers =
          case mode of
            ChurnMode
ChurnModeNormal  ->
              PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base
            ChurnMode
ChurnModeBulkSync ->
              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
    checkActivePeersIncreased :: CheckPeerSelectionCounters
checkActivePeersIncreased
      PeerSelectionCounters { Int
numberOfActivePeers :: Int
numberOfActivePeers :: PeerSelectionCounters -> 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 :: ChurnMode
                        -> HotValency
                        -> ModifyPeerSelectionTargets
    decreaseActivePeers :: ChurnMode
-> HotValency -> PeerSelectionTargets -> PeerSelectionTargets
decreaseActivePeers ChurnMode
mode (HotValency Int
ltt) PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfActivePeers =
          case mode of
            ChurnMode
ChurnModeNormal ->
              Int -> Int
decrease (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
base
            ChurnMode
ChurnModeBulkSync ->
              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
    checkActivePeersDecreased :: CheckPeerSelectionCounters
checkActivePeersDecreased
      PeerSelectionCounters { Int
numberOfActivePeers :: PeerSelectionCounters -> 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
      :: ChurnMode -> UseBootstrapPeers
      -> ModifyPeerSelectionTargets
    increaseEstablishedPeers :: ChurnMode
-> UseBootstrapPeers
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseEstablishedPeers
      ChurnMode
mode UseBootstrapPeers
ubp PeerSelectionTargets
targets
      =
      PeerSelectionTargets
targets {
        targetNumberOfEstablishedPeers =
          case (mode, ubp) of
            (ChurnMode
ChurnModeBulkSync, UseBootstrapPeers [RelayAccessPoint]
_) ->
              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)
            (ChurnMode, UseBootstrapPeers)
_  -> PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
base
      }

    checkEstablishedPeersIncreased :: CheckPeerSelectionCounters
    checkEstablishedPeersIncreased :: CheckPeerSelectionCounters
checkEstablishedPeersIncreased
      PeerSelectionCounters { Int
numberOfEstablishedPeers :: Int
numberOfEstablishedPeers :: PeerSelectionCounters -> 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
      :: ModifyPeerSelectionTargets
    increaseEstablishedBigLedgerPeers :: PeerSelectionTargets -> PeerSelectionTargets
increaseEstablishedBigLedgerPeers
      PeerSelectionTargets
targets
      =
      PeerSelectionTargets
targets { targetNumberOfEstablishedBigLedgerPeers = targetNumberOfEstablishedBigLedgerPeers base }

    checkEstablishedBigLedgerPeersIncreased
      :: CheckPeerSelectionCounters
    checkEstablishedBigLedgerPeersIncreased :: CheckPeerSelectionCounters
checkEstablishedBigLedgerPeersIncreased
      PeerSelectionCounters { Int
numberOfEstablishedBigLedgerPeers :: Int
numberOfEstablishedBigLedgerPeers :: PeerSelectionCounters -> 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
      :: ChurnMode -> UseBootstrapPeers
      -> ModifyPeerSelectionTargets
    decreaseEstablishedPeers :: ChurnMode
-> UseBootstrapPeers
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseEstablishedPeers ChurnMode
mode UseBootstrapPeers
ubp PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfEstablishedPeers =
          case (mode, ubp) of
             (ChurnMode
ChurnModeBulkSync, UseBootstrapPeers [RelayAccessPoint]
_) ->
                 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)
             (ChurnMode, UseBootstrapPeers)
_ -> 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
    checkEstablishedPeersDecreased :: CheckPeerSelectionCounters
checkEstablishedPeersDecreased
      PeerSelectionCounters { Int
numberOfEstablishedPeers :: PeerSelectionCounters -> 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
      :: ChurnMode -> ModifyPeerSelectionTargets
    increaseActiveBigLedgerPeers :: ChurnMode -> PeerSelectionTargets -> PeerSelectionTargets
increaseActiveBigLedgerPeers ChurnMode
mode PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        -- TODO: when chain-skipping will be implemented and chain-sync client
        -- will take into account big ledger peers, we don't need pattern
        -- match on the churn mode, but use
        -- `targetNumberOfActiveBigLedgerPeers` (issue #4609).
        targetNumberOfActiveBigLedgerPeers =
          case mode of
            ChurnMode
ChurnModeNormal ->
              PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base
            ChurnMode
ChurnModeBulkSync ->
              Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base)
      }

    checkActiveBigLedgerPeersIncreased
      :: CheckPeerSelectionCounters
    checkActiveBigLedgerPeersIncreased :: CheckPeerSelectionCounters
checkActiveBigLedgerPeersIncreased
      PeerSelectionCounters { Int
numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeers :: PeerSelectionCounters -> 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
      :: ChurnMode
      -> ModifyPeerSelectionTargets
    decreaseActiveBigLedgerPeers :: ChurnMode -> PeerSelectionTargets -> PeerSelectionTargets
decreaseActiveBigLedgerPeers ChurnMode
mode PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfActiveBigLedgerPeers =
          case mode of
            ChurnMode
ChurnModeNormal ->
              Int -> Int
decrease (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base
            ChurnMode
ChurnModeBulkSync ->
              Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1 (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers PeerSelectionTargets
base)
      }

    checkActiveBigLedgerPeersDecreased
      :: CheckPeerSelectionCounters
    checkActiveBigLedgerPeersDecreased :: CheckPeerSelectionCounters
checkActiveBigLedgerPeersDecreased
      PeerSelectionCounters { Int
numberOfActiveBigLedgerPeers :: PeerSelectionCounters -> 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
      :: ModifyPeerSelectionTargets
    decreaseEstablishedBigLedgerPeers :: PeerSelectionTargets -> PeerSelectionTargets
decreaseEstablishedBigLedgerPeers PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
        targetNumberOfEstablishedBigLedgerPeers =
          decrease (targetNumberOfEstablishedBigLedgerPeers base -
                    targetNumberOfActiveBigLedgerPeers base)
          + targetNumberOfActiveBigLedgerPeers base
      }

    checkEstablishedBigLedgerPeersDecreased
      :: CheckPeerSelectionCounters
    checkEstablishedBigLedgerPeersDecreased :: CheckPeerSelectionCounters
checkEstablishedBigLedgerPeersDecreased
      PeerSelectionCounters { Int
numberOfEstablishedBigLedgerPeers :: PeerSelectionCounters -> 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
      :: ModifyPeerSelectionTargets
    decreaseKnownPeers :: PeerSelectionTargets -> PeerSelectionTargets
decreaseKnownPeers PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfRootPeers =
            decrease (targetNumberOfRootPeers base - targetNumberOfEstablishedPeers base)
            + targetNumberOfEstablishedPeers base
        , targetNumberOfKnownPeers =
            decrease (targetNumberOfKnownPeers base - targetNumberOfEstablishedPeers base)
            + targetNumberOfEstablishedPeers base
        }

    checkKnownPeersDecreased
      :: PeerSelectionCounters -> PeerSelectionTargets -> Bool
    checkKnownPeersDecreased :: CheckPeerSelectionCounters
checkKnownPeersDecreased
      PeerSelectionCounters { Int
numberOfKnownPeers :: Int
numberOfKnownPeers :: PeerSelectionCounters -> 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
      :: ModifyPeerSelectionTargets
    decreaseKnownBigLedgerPeers :: PeerSelectionTargets -> PeerSelectionTargets
decreaseKnownBigLedgerPeers PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfKnownBigLedgerPeers =
            decrease (targetNumberOfKnownBigLedgerPeers base -
                      targetNumberOfEstablishedBigLedgerPeers base)
            + targetNumberOfEstablishedBigLedgerPeers base
        }

    checkKnownBigLedgerPeersDecreased
      :: PeerSelectionCounters -> PeerSelectionTargets -> Bool
    checkKnownBigLedgerPeersDecreased :: CheckPeerSelectionCounters
checkKnownBigLedgerPeersDecreased
      PeerSelectionCounters { Int
numberOfKnownBigLedgerPeers :: Int
numberOfKnownBigLedgerPeers :: PeerSelectionCounters -> 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
      :: ModifyPeerSelectionTargets
    increaseKnownPeers :: PeerSelectionTargets -> PeerSelectionTargets
increaseKnownPeers PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfRootPeers = targetNumberOfRootPeers base
        , targetNumberOfKnownPeers = targetNumberOfKnownPeers base
        }

    checkKnownPeersIncreased
      :: CheckPeerSelectionCounters
    checkKnownPeersIncreased :: CheckPeerSelectionCounters
checkKnownPeersIncreased
      PeerSelectionCounters { Int
numberOfRootPeers :: Int
numberOfRootPeers :: PeerSelectionCounters -> Int
numberOfRootPeers,
                              Int
numberOfKnownPeers :: PeerSelectionCounters -> 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
      :: ModifyPeerSelectionTargets
    increaseKnownBigLedgerPeers :: PeerSelectionTargets -> PeerSelectionTargets
increaseKnownBigLedgerPeers PeerSelectionTargets
targets =
      PeerSelectionTargets
targets {
          targetNumberOfKnownBigLedgerPeers = targetNumberOfKnownBigLedgerPeers base
        }

    checkKnownBigLedgerPeersIncreased
      :: CheckPeerSelectionCounters
    checkKnownBigLedgerPeersIncreased :: CheckPeerSelectionCounters
checkKnownBigLedgerPeersIncreased
      PeerSelectionCounters { Int
numberOfKnownBigLedgerPeers :: PeerSelectionCounters -> 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
      Time
startTs <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime

      (ChurnMode
churnMode, UseBootstrapPeers
ubp, HotValency
ltt) <- STM m (ChurnMode, UseBootstrapPeers, HotValency)
-> m (ChurnMode, UseBootstrapPeers, HotValency)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (ChurnMode, UseBootstrapPeers, HotValency)
getExtState

      Tracer m (TracePeerSelection peeraddr)
-> TracePeerSelection peeraddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TracePeerSelection peeraddr)
tracer (TracePeerSelection peeraddr -> m ())
-> TracePeerSelection peeraddr -> m ()
forall a b. (a -> b) -> a -> b
$ ChurnMode -> TracePeerSelection peeraddr
forall peeraddr. ChurnMode -> TracePeerSelection peeraddr
TraceChurnMode ChurnMode
churnMode

      -- Purge the worst active peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
DecreasedActivePeers
                    PeerSelectionCounters -> Int
numberOfActivePeers
                    DiffTime
deactivateTimeout -- chainsync might timeout after 5mins
                    (ChurnMode
-> HotValency -> PeerSelectionTargets -> PeerSelectionTargets
decreaseActivePeers ChurnMode
churnMode HotValency
ltt)
                    CheckPeerSelectionCounters
checkActivePeersDecreased

      -- Pick new active peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
IncreasedActivePeers
                    PeerSelectionCounters -> Int
numberOfActivePeers
                    DiffTime
shortTimeout
                    (ChurnMode
-> HotValency -> PeerSelectionTargets -> PeerSelectionTargets
increaseActivePeers ChurnMode
churnMode HotValency
ltt)
                    CheckPeerSelectionCounters
checkActivePeersIncreased

      -- Purge the worst active big ledger peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
DecreasedActiveBigLedgerPeers
                    PeerSelectionCounters -> Int
numberOfActiveBigLedgerPeers
                    DiffTime
deactivateTimeout -- chainsync might timeout after 5mins
                    (ChurnMode -> PeerSelectionTargets -> PeerSelectionTargets
decreaseActiveBigLedgerPeers ChurnMode
churnMode)
                    (CheckPeerSelectionCounters
checkActiveBigLedgerPeersDecreased)

      -- Pick new active big ledger peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
IncreasedActiveBigLedgerPeers
                    PeerSelectionCounters -> Int
numberOfActiveBigLedgerPeers
                    DiffTime
shortTimeout
                    (ChurnMode -> PeerSelectionTargets -> PeerSelectionTargets
increaseActiveBigLedgerPeers ChurnMode
churnMode)
                    CheckPeerSelectionCounters
checkActiveBigLedgerPeersIncreased

      -- Forget the worst performing established peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
DecreasedEstablishedPeers
                    PeerSelectionCounters -> Int
numberOfEstablishedPeers
                    (DiffTime
1 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
closeConnectionTimeout)
                    (ChurnMode
-> UseBootstrapPeers
-> PeerSelectionTargets
-> PeerSelectionTargets
decreaseEstablishedPeers ChurnMode
churnMode UseBootstrapPeers
ubp)
                    (CheckPeerSelectionCounters
checkEstablishedPeersDecreased)

      -- Forget the worst performing established big ledger peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
DecreasedEstablishedBigLedgerPeers
                    PeerSelectionCounters -> Int
numberOfEstablishedBigLedgerPeers
                    (DiffTime
1 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
closeConnectionTimeout)
                    PeerSelectionTargets -> PeerSelectionTargets
decreaseEstablishedBigLedgerPeers
                    CheckPeerSelectionCounters
checkEstablishedBigLedgerPeersDecreased

      -- Forget the worst performing known peers (root peers, ledger peers)
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
DecreasedKnownPeers
                    PeerSelectionCounters -> Int
numberOfKnownPeers
                    DiffTime
shortTimeout
                    PeerSelectionTargets -> PeerSelectionTargets
decreaseKnownPeers
                    CheckPeerSelectionCounters
checkKnownPeersDecreased

      -- Pick new known peers
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
IncreasedKnownPeers
                    PeerSelectionCounters -> Int
numberOfKnownPeers
                    (DiffTime
2 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
requestPeersTimeout DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
shortTimeout)
                    PeerSelectionTargets -> PeerSelectionTargets
increaseKnownPeers
                    CheckPeerSelectionCounters
checkKnownPeersIncreased

      -- Forget the worst performing known big ledger peers.
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
DecreasedKnownBigLedgerPeers
                    PeerSelectionCounters -> Int
numberOfKnownBigLedgerPeers
                    DiffTime
shortTimeout
                    PeerSelectionTargets -> PeerSelectionTargets
decreaseKnownBigLedgerPeers
                    CheckPeerSelectionCounters
checkKnownBigLedgerPeersDecreased

      -- Pick new known big ledger peers
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
IncreasedKnownBigLedgerPeers
                    PeerSelectionCounters -> Int
numberOfKnownBigLedgerPeers
                    (DiffTime
2 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
requestPeersTimeout DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
shortTimeout)
                    PeerSelectionTargets -> PeerSelectionTargets
increaseKnownBigLedgerPeers
                    CheckPeerSelectionCounters
checkKnownBigLedgerPeersIncreased

      -- Pick new non-active peers
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
IncreasedEstablishedPeers
                    PeerSelectionCounters -> Int
numberOfEstablishedPeers
                    DiffTime
churnEstablishConnectionTimeout
                    (ChurnMode
-> UseBootstrapPeers
-> PeerSelectionTargets
-> PeerSelectionTargets
increaseEstablishedPeers ChurnMode
churnMode UseBootstrapPeers
ubp)
                    CheckPeerSelectionCounters
checkEstablishedPeersIncreased

      -- Pick new non-active big ledger peers
      ChurnAction
-> (PeerSelectionCounters -> Int)
-> DiffTime
-> (PeerSelectionTargets -> PeerSelectionTargets)
-> CheckPeerSelectionCounters
-> m ()
updateTargets ChurnAction
IncreasedEstablishedBigLedgerPeers
                    PeerSelectionCounters -> Int
numberOfEstablishedBigLedgerPeers
                    DiffTime
churnEstablishConnectionTimeout
                    PeerSelectionTargets -> PeerSelectionTargets
increaseEstablishedBigLedgerPeers
                    CheckPeerSelectionCounters
checkEstablishedBigLedgerPeersIncreased

      Time
endTs <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime

      StdGen -> DiffTime -> m StdGen
fuzzyDelay StdGen
rng (Time
endTs Time -> Time -> DiffTime
`diffTime` Time
startTs) m StdGen -> (StdGen -> m Void) -> m Void
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdGen -> m Void
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
      FetchMode
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
      case FetchMode
mode of
           FetchMode
FetchModeDeadline -> StdGen -> DiffTime -> m StdGen
longDelay StdGen
rng DiffTime
execTime
           FetchMode
FetchModeBulkSync -> 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 peeraddr)
-> TracePeerSelection peeraddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TracePeerSelection peeraddr)
tracer (TracePeerSelection peeraddr -> m ())
-> TracePeerSelection peeraddr -> m ()
forall a b. (a -> b) -> a -> b
$ DiffTime -> TracePeerSelection peeraddr
forall peeraddr. DiffTime -> TracePeerSelection 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)