{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module contains governor decisions for monitoring tasks:
--
-- * monitoring local root peer config changes
-- * monitoring changes to the peer target numbers
-- * monitoring the completion of asynchronous governor job
-- * monitoring connections
--
module Ouroboros.Cardano.Network.PeerSelection.Governor.Monitor
  ( targetPeers
  , localRoots
  , monitorLedgerStateJudgement
  , monitorBootstrapPeersFlag
  , waitForSystemToQuiesce
  ) where

import Data.Set qualified as Set

import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadTime.SI

import Cardano.Network.ConsensusMode
import Cardano.Network.PeerSelection.Bootstrap (isBootstrapPeersEnabled,
           isNodeAbleToMakeProgress, requiresBootstrapPeers)
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Cardano.Network.Types (LedgerStateJudgement (..))
import Control.Exception (assert)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Ouroboros.Cardano.Network.LedgerPeerConsensusInterface qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionActions qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
import Ouroboros.Cardano.Network.PublicRootPeers qualified as Cardano
import Ouroboros.Network.PeerSelection.Governor.ActivePeers
           (jobDemoteActivePeer)
import Ouroboros.Network.PeerSelection.Governor.Monitor (jobVerifyPeerSnapshot)
import Ouroboros.Network.PeerSelection.Governor.Types hiding
           (PeerSelectionCounters)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerPeersConsensusInterface (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.State.LocalRootPeers
           (LocalRootConfig (..))
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSelection.Types


-- | Used to set 'bootstrapPeersTimeout' for crashing the node in a critical
-- failure case
--
governor_BOOTSTRAP_PEERS_TIMEOUT :: DiffTime
governor_BOOTSTRAP_PEERS_TIMEOUT :: DiffTime
governor_BOOTSTRAP_PEERS_TIMEOUT = DiffTime
15 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60

-- | Monitor 'PeerSelectionTargets', if they change, we just need to update
-- 'PeerSelectionState', since we return it in a 'Decision' action it will be
-- picked by the governor's 'peerSelectionGovernorLoop'.
--
-- It should be noted if the node is in bootstrap mode (i.e. in a sensitive
-- state) then, until the node reaches a clean state, this monitoring action
-- will be disabled and thus churning will be disabled as well.
--
-- On the other hand, if Genesis mode is on for the node, this action responds
-- to changes in ledger state judgement monitoring actions to change the static
-- set of target peers.
targetPeers
  :: (MonadSTM m, Ord peeraddr)
  => Cardano.ExtraPeerSelectionActions m
  -> PeerSelectionActions
      Cardano.ExtraState
      extraFlags
      extraPeers
      extraAPI
      extraCounters
      peeraddr
      peerconn
      m
  -> PeerSelectionState
      Cardano.ExtraState
      PeerTrustable
      extraPeers
      peeraddr
      peerconn
  -> Guarded (STM m)
            (TimedDecision m Cardano.ExtraState extraDebugState PeerTrustable
                           extraPeers peeraddr peerconn)
targetPeers :: forall (m :: * -> *) peeraddr extraFlags extraPeers extraAPI
       extraCounters peerconn extraDebugState.
(MonadSTM m, Ord peeraddr) =>
ExtraPeerSelectionActions m
-> PeerSelectionActions
     ExtraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        extraPeers
        peeraddr
        peerconn)
targetPeers Cardano.ExtraPeerSelectionActions {
              PeerSelectionTargets
genesisPeerTargets :: PeerSelectionTargets
genesisPeerTargets :: forall (m :: * -> *).
ExtraPeerSelectionActions m -> PeerSelectionTargets
Cardano.genesisPeerTargets
            }
            PeerSelectionActions {
              PeerSelectionTargets
peerSelectionTargets :: PeerSelectionTargets
peerSelectionTargets :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionTargets
peerSelectionTargets,
              STM m PeerSelectionTargets
readPeerSelectionTargets :: STM m PeerSelectionTargets
readPeerSelectionTargets :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> STM m PeerSelectionTargets
readPeerSelectionTargets,
              PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI :: PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI
            }
            st :: PeerSelectionState
  ExtraState PeerTrustable extraPeers peeraddr peerconn
st@PeerSelectionState{
              PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers extraPeers peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers,
              LocalRootPeers PeerTrustable peeraddr
localRootPeers :: LocalRootPeers PeerTrustable peeraddr
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers,
              PeerSelectionTargets
targets :: PeerSelectionTargets
targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
targets,
              extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState = Cardano.ExtraState {
                UseBootstrapPeers
bootstrapPeersFlag :: UseBootstrapPeers
bootstrapPeersFlag :: ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag,
                Bool
hasOnlyBootstrapPeers :: Bool
hasOnlyBootstrapPeers :: ExtraState -> Bool
Cardano.hasOnlyBootstrapPeers,
                LedgerStateJudgement
ledgerStateJudgement :: LedgerStateJudgement
ledgerStateJudgement :: ExtraState -> LedgerStateJudgement
Cardano.ledgerStateJudgement,
                ConsensusMode
consensusMode :: ConsensusMode
consensusMode :: ExtraState -> ConsensusMode
Cardano.consensusMode
              }
            } =
    Maybe Time
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      ExtraState
      extraDebugState
      PeerTrustable
      extraPeers
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         extraPeers
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        extraPeers
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ do
      churnTargets <- STM m PeerSelectionTargets
readPeerSelectionTargets
      -- Genesis consensus mode:
      -- we check if targets proposed by churn are stale
      -- in the sense that they are the targets for
      -- opposite value of the current ledger state judgement.
      -- This indicates that we aren't churning currently, and
      -- furthermore it means that the ledger state has flipped since
      -- we last churned. Therefore we can't set the targets from
      -- the TVar, and instead we set the appropriate targets
      -- for the mode we are in.
      let targets' =
            case (LedgerStateJudgement
ledgerStateJudgement, ConsensusMode
consensusMode) of
              (LedgerStateJudgement
YoungEnough, ConsensusMode
GenesisMode)
                | PeerSelectionTargets
churnTargets PeerSelectionTargets -> PeerSelectionTargets -> Bool
forall a. Eq a => a -> a -> Bool
== PeerSelectionTargets
genesisPeerTargets ->
                  PeerSelectionTargets
peerSelectionTargets
              (LedgerStateJudgement
TooOld, ConsensusMode
GenesisMode)
                | PeerSelectionTargets
churnTargets PeerSelectionTargets -> PeerSelectionTargets -> Bool
forall a. Eq a => a -> a -> Bool
== PeerSelectionTargets
peerSelectionTargets ->
                  PeerSelectionTargets
genesisPeerTargets
              (LedgerStateJudgement, ConsensusMode)
_otherwise -> PeerSelectionTargets
churnTargets

      -- nb. first check is redundant in Genesis mode
      check (   isNodeAbleToMakeProgress bootstrapPeersFlag
                                         ledgerStateJudgement
                                         hasOnlyBootstrapPeers
             && targets /= targets'
             && sanePeerSelectionTargets targets')
      -- We simply ignore target updates that are not "sane".

      let usingBootstrapPeers = UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
bootstrapPeersFlag
                                                       LedgerStateJudgement
ledgerStateJudgement
          -- We have to enforce the invariant that the number of root peers is
          -- not more than the target number of known peers. It's unlikely in
          -- practice so it's ok to resolve it arbitrarily using clampToLimit.
          --
          -- Here we need to make sure that we prioritise the trustable peers
          -- by clamping to trustable first.
          --
          -- TODO: we ought to add a warning if 'clampToLimit' modified local
          -- root peers, even though this is unexpected in the most common
          -- scenarios.
          localRootPeers' =
              Int
-> LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall peeraddr extraFlags.
Ord peeraddr =>
Int
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.clampToLimit
                              (PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
targets')
            (LocalRootPeers PeerTrustable peeraddr
 -> LocalRootPeers PeerTrustable peeraddr)
-> LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall a b. (a -> b) -> a -> b
$ (if Bool
usingBootstrapPeers
                  then LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable
                  else LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall a. a -> a
id)
            (LocalRootPeers PeerTrustable peeraddr
 -> LocalRootPeers PeerTrustable peeraddr)
-> LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall a b. (a -> b) -> a -> b
$ LocalRootPeers PeerTrustable peeraddr
localRootPeers

          -- We have to enforce that local and big ledger peers are disjoint.
          publicRootPeers' =
            (extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers.difference (PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr -> extraPeers
forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI)
              PublicRootPeers extraPeers peeraddr
publicRootPeers (LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable peeraddr
localRootPeers')

      return $ \Time
_now -> Decision {
        decisionTrace :: [TracePeerSelection
   extraDebugState PeerTrustable extraPeers peeraddr]
decisionTrace = [PeerSelectionTargets
-> PeerSelectionTargets
-> TracePeerSelection
     extraDebugState PeerTrustable extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
PeerSelectionTargets
-> PeerSelectionTargets
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceTargetsChanged PeerSelectionTargets
targets PeerSelectionTargets
targets'],
        decisionJobs :: [Job
   ()
   m
   (Completion
      m
      ExtraState
      extraDebugState
      PeerTrustable
      extraPeers
      peeraddr
      peerconn)]
decisionJobs  = [],
        decisionState :: PeerSelectionState
  ExtraState PeerTrustable extraPeers peeraddr peerconn
decisionState = PeerSelectionState
  ExtraState PeerTrustable extraPeers peeraddr peerconn
st {
                          targets        = targets',
                          localRootPeers = localRootPeers',
                          publicRootPeers = publicRootPeers'
                        } }


-- | Monitor local roots using 'readLocalRootPeers' 'STM' action.
--
-- If the current ledger state is TooOld we can only trust our trustable local
-- root peers, this means that if we remove any local root peer we
-- might no longer abide by the invariant that we are only connected to
-- trusted peers. E.g. Local peers = A, B*, C* (* means trusted peer), if
-- the node is in bootstrap mode and decided to reconfigure the local root
-- peers to the following set: A*, B, C*, D*, E. Notice that B is no longer
-- trusted, however we will keep a connection to it until the outbound
-- governor notices it and disconnects from it.
localRoots
  :: forall extraDebugState extraAPI extraCounters peeraddr peerconn m.
    (MonadSTM m, Ord peeraddr)
  => PeerSelectionActions
      Cardano.ExtraState
      PeerTrustable
      (Cardano.ExtraPeers peeraddr)
      extraAPI
      extraCounters
      peeraddr
      peerconn
      m
  -> PeerSelectionState
      Cardano.ExtraState
      PeerTrustable
      (Cardano.ExtraPeers peeraddr)
      peeraddr
      peerconn
  -> Guarded (STM m)
            (TimedDecision m Cardano.ExtraState extraDebugState
                           PeerTrustable (Cardano.ExtraPeers peeraddr)
                           peeraddr peerconn)
localRoots :: forall extraDebugState extraAPI extraCounters peeraddr peerconn
       (m :: * -> *).
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
localRoots actions :: PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions@PeerSelectionActions{ STM m (Config PeerTrustable peeraddr)
readLocalRootPeers :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> STM m (Config extraFlags peeraddr)
readLocalRootPeers :: STM m (Config PeerTrustable peeraddr)
readLocalRootPeers
                                       , PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI :: PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI
                                       }
           st :: PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st@PeerSelectionState{
             LocalRootPeers PeerTrustable peeraddr
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers :: LocalRootPeers PeerTrustable peeraddr
localRootPeers,
             PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers,
             KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers,
             EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
             Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
activePeers,
             Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteHot,
             Set peeraddr
inProgressDemoteToCold :: Set peeraddr
inProgressDemoteToCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteToCold,
             targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
targets = PeerSelectionTargets{Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers},
             extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState = cpst :: ExtraState
cpst@Cardano.ExtraState {
               UseBootstrapPeers
bootstrapPeersFlag :: ExtraState -> UseBootstrapPeers
bootstrapPeersFlag :: UseBootstrapPeers
Cardano.bootstrapPeersFlag,
               Bool
hasOnlyBootstrapPeers :: ExtraState -> Bool
hasOnlyBootstrapPeers :: Bool
Cardano.hasOnlyBootstrapPeers,
               LedgerStateJudgement
ledgerStateJudgement :: ExtraState -> LedgerStateJudgement
ledgerStateJudgement :: LedgerStateJudgement
Cardano.ledgerStateJudgement
             }
           }
  | UseBootstrapPeers -> LedgerStateJudgement -> Bool -> Bool
isNodeAbleToMakeProgress UseBootstrapPeers
bootstrapPeersFlag
                             LedgerStateJudgement
ledgerStateJudgement
                             Bool
hasOnlyBootstrapPeers =
    Maybe Time
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ do
      -- We have to enforce the invariant that the number of root peers is
      -- not more than the target number of known peers. It's unlikely in
      -- practice so it's ok to resolve it arbitrarily using clampToLimit.
      --
      -- Here we need to make sure that we prioritise the trustable peers
      -- by clamping to trustable first.
      localRootPeersRaw <- STM m (Config PeerTrustable peeraddr)
readLocalRootPeers
      let inSensitiveState = UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
bootstrapPeersFlag LedgerStateJudgement
ledgerStateJudgement
          localRootPeers' = Int
-> LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall peeraddr extraFlags.
Ord peeraddr =>
Int
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.clampToLimit
                              Int
targetNumberOfKnownPeers
                          (LocalRootPeers PeerTrustable peeraddr
 -> LocalRootPeers PeerTrustable peeraddr)
-> (Config PeerTrustable peeraddr
    -> LocalRootPeers PeerTrustable peeraddr)
-> Config PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
inSensitiveState
                                then LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable
                                else LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall a. a -> a
id)
                          (LocalRootPeers PeerTrustable peeraddr
 -> LocalRootPeers PeerTrustable peeraddr)
-> (Config PeerTrustable peeraddr
    -> LocalRootPeers PeerTrustable peeraddr)
-> Config PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups
                          (Config PeerTrustable peeraddr
 -> LocalRootPeers PeerTrustable peeraddr)
-> Config PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall a b. (a -> b) -> a -> b
$ Config PeerTrustable peeraddr
localRootPeersRaw
      check (localRootPeers' /= localRootPeers)

      --TODO: trace when the clamping kicks in, and warn operators

      let added        = LocalRootPeers PeerTrustable peeraddr
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers PeerTrustable peeraddr
localRootPeers' Map peeraddr (LocalRootConfig PeerTrustable)
-> Map peeraddr (LocalRootConfig PeerTrustable)
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\
                         LocalRootPeers PeerTrustable peeraddr
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers PeerTrustable peeraddr
localRootPeers
          removed      = LocalRootPeers PeerTrustable peeraddr
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers PeerTrustable peeraddr
localRootPeers  Map peeraddr (LocalRootConfig PeerTrustable)
-> Map peeraddr (LocalRootConfig PeerTrustable)
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\
                         LocalRootPeers PeerTrustable peeraddr
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers PeerTrustable peeraddr
localRootPeers'
          -- LocalRoots are not ledger!
          addedInfoMap = (LocalRootConfig PeerTrustable -> (Maybe a, Maybe PeerAdvertise))
-> Map peeraddr (LocalRootConfig PeerTrustable)
-> Map peeraddr (Maybe a, Maybe PeerAdvertise)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
                           (\LocalRootConfig { PeerAdvertise
peerAdvertise :: PeerAdvertise
peerAdvertise :: forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise } ->
                             (Maybe a
forall a. Maybe a
Nothing, PeerAdvertise -> Maybe PeerAdvertise
forall a. a -> Maybe a
Just PeerAdvertise
peerAdvertise))
                           Map peeraddr (LocalRootConfig PeerTrustable)
added
          removedSet   = Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr (LocalRootConfig PeerTrustable)
removed
          knownPeers'  = Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall {a}. Map peeraddr (Maybe a, Maybe PeerAdvertise)
addedInfoMap KnownPeers peeraddr
knownPeers
                        -- We do not immediately remove old ones from the
                        -- known peers set because we may have established
                        -- connections

          localRootPeersSet = LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable peeraddr
localRootPeers'

          -- We have to adjust the publicRootPeers to maintain the invariant
          -- that the local and public sets are non-overlapping.
          --
          publicRootPeers' =
            (ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr)
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
-> Set peeraddr
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers.difference (PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
-> ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI)
              PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
              Set peeraddr
localRootPeersSet

          -- Non trustable peers that the outbound governor might keep. These
          -- should be demoted forgot as soon as possible. In order to do that
          -- we set 'hasOnlyBootstrapPeers' to False and
          -- 'ledgerStateJudgement' to TooOld in order to force clean state
          -- reconnections.
          hasOnlyBootstrapPeers' =
            Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Bool) -> Set peeraddr -> Bool
forall a b. (a -> b) -> a -> b
$ KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers'
                       Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference`
                       (  LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable peeraddr
localRootPeers'
                       Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers')

          -- If the node is in a vulnerable position, i.e. connected to a
          -- local root that is no longer deemed trustable we have to
          -- force clean state reconnections. We do this by setting the
          -- 'ledgerStateJudgement' value to 'YoungEnough' which
          -- 'monitorLedgerStateJudgement' will then read the original
          -- 'TooOld' value and trigger the clean state protocol.
          --
          -- Note that if the state actually changes to 'YoungEnough' it
          -- doesn't really matter.
          --
          ledgerStateJudgement' =
            if    UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
bootstrapPeersFlag LedgerStateJudgement
ledgerStateJudgement
               Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasOnlyBootstrapPeers'
            then LedgerStateJudgement
YoungEnough
            else LedgerStateJudgement
ledgerStateJudgement

          -- If we are removing local roots and we have active connections to
          -- them then things are a little more complicated. We would typically
          -- change local roots so that we can establish new connections to
          -- the new local roots. But since we will typically already be at our
          -- target for active peers then that will not be possible without us
          -- taking additional action. What we choose to do here is to demote
          -- the peer from active to warm, which will then allow new ones to
          -- be promoted to active.
          selectedToDemote  :: Set peeraddr
          selectedToDemote' :: Map peeraddr peerconn

          selectedToDemote  = Set peeraddr
activePeers Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
removedSet
                                Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressDemoteToCold
          selectedToDemote' = EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
EstablishedPeers.toMap EstablishedPeers peeraddr peerconn
establishedPeers
                               Map peeraddr peerconn -> Set peeraddr -> Map peeraddr peerconn
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peeraddr
selectedToDemote

      return $ \Time
_now ->

          Bool
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
                    ((ExtraPeers peeraddr -> Set peeraddr)
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
-> ExtraPeers peeraddr -> Set peeraddr
forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr
extraPeersToSet PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI)
                                           PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers')
                   (KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers'))
        (Decision
   m
   ExtraState
   extraDebugState
   PeerTrustable
   (ExtraPeers peeraddr)
   peeraddr
   peerconn
 -> Decision
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
-> (Decision
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn
    -> Decision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         (ExtraPeers peeraddr)
         peeraddr
         peerconn)
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
                   (LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable peeraddr
localRootPeers')
                   (KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers'))

        (Decision
   m
   ExtraState
   extraDebugState
   PeerTrustable
   (ExtraPeers peeraddr)
   peeraddr
   peerconn
 -> Decision
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
-> Decision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
forall a b. (a -> b) -> a -> b
$ Decision {
            decisionTrace :: [TracePeerSelection
   extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr]
decisionTrace = LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
-> TracePeerSelection
     extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceLocalRootPeersChanged LocalRootPeers PeerTrustable peeraddr
localRootPeers LocalRootPeers PeerTrustable peeraddr
localRootPeers'
                          TracePeerSelection
  extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr
-> [TracePeerSelection
      extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr]
-> [TracePeerSelection
      extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr]
forall a. a -> [a] -> [a]
: [ LedgerStateJudgement
-> TracePeerSelection
     extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
LedgerStateJudgement
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceLedgerStateJudgementChanged LedgerStateJudgement
YoungEnough
                            | LedgerStateJudgement
ledgerStateJudgement LedgerStateJudgement -> LedgerStateJudgement -> Bool
forall a. Eq a => a -> a -> Bool
/= LedgerStateJudgement
ledgerStateJudgement'
                            ],
            decisionState :: PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
decisionState = PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st {
                              localRootPeers      = localRootPeers',
                              publicRootPeers     = publicRootPeers',
                              knownPeers          = knownPeers',
                              inProgressDemoteHot = inProgressDemoteHot
                                                 <> selectedToDemote,
                              extraState = cpst {
                                Cardano.hasOnlyBootstrapPeers = hasOnlyBootstrapPeers',
                                Cardano.ledgerStateJudgement  = ledgerStateJudgement'
                              }
                            },
            decisionJobs :: [Job
   ()
   m
   (Completion
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)]
decisionJobs  = [ PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> peeraddr
-> peerconn
-> Job
     ()
     m
     (Completion
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
(Monad m, Ord peeraddr) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> peeraddr
-> peerconn
-> Job
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
jobDemoteActivePeer PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions peeraddr
peeraddr peerconn
peerconn
                          | (peeraddr
peeraddr, peerconn
peerconn) <- Map peeraddr peerconn -> [(peeraddr, peerconn)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map peeraddr peerconn
selectedToDemote' ]
          }
  | Bool
otherwise = Maybe Time
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> Guarded m a
GuardedSkip Maybe Time
forall a. Maybe a
Nothing

-- | Monitor 'UseBootstrapPeers' flag.
--
-- The user might reconfigure the node at any point to change the value of
-- UseBootstrapPeers. Essentially the user can enable or disable bootstrap
-- peers at any time. Since 'monitorLedgerStateJudgement' will act on the
-- ledger state judgement value changing, this monitoring action should only
-- be responsible for either disabling bootstrap peers (in case the user
-- disables this flag) or enabling the 'monitorLedgerStateJudgement' action to
-- work correctly in the case the node finds itself in bootstrap mode. In
-- order to achieve this behavior, when bootstrap peers are disabled we should
-- update the ledger state judgement value to 'YoungEnough'; and
-- 'hasOnlyBootstrapPeers' to 'False'.
--
-- Here's a brief explanation why this works. There's 4 scenarios to consider:
--
-- 1. The node is in 'YoungEnough' state and the user
--  1.1. Enables bootstrap peers: In this case since the node is caught up
--  nothing should happen, so setting the LSJ to YoungEnough state is
--  idempotent.
--  1.2. Disables bootstrap peers: In this case, since the node is caught up,
--  its functioning can't really be distinguished from that of a node that has
--  bootstrap peers disabled. So changing the LSJ and 'hasOnlyBootstrapPeers'
--  flag is idempotent.
-- 2. The node is in 'TooOld' state and the user
--  2.1. Enables bootstrap peers: If the node is behind, enabling bootstrap
--  peers will enable 'monitorLedgerStateJudgement'. So if we set the LSJ to
--  be in 'YoungEnough' state it is going to make sure 'monitorLedgerStateJudgement'
--  observes the 'TooOld' state, triggering the right measures to be taken.
--  2.2. Disables bootstrap peers: If this is the case, we want to let the
--  peer connect to non-trusted peers, so just updating the boostrap peers
--  flag will enable the previously disabled monitoring actions.
--
monitorBootstrapPeersFlag
  :: ( MonadSTM m
     , Ord peeraddr
     )
  => Cardano.ExtraPeerSelectionActions m
  -> PeerSelectionActions
      Cardano.ExtraState

      extraFlags
      (Cardano.ExtraPeers peeraddr)
      extraAPI
      extraCounters
      peeraddr
      peerconn
      m
  -> PeerSelectionState
      Cardano.ExtraState
      extraFlags
      (Cardano.ExtraPeers peeraddr)
      peeraddr
      peerconn
  -> Guarded (STM m)
            (TimedDecision m Cardano.ExtraState extraDebugState extraFlags
                           (Cardano.ExtraPeers peeraddr) peeraddr peerconn)
monitorBootstrapPeersFlag :: forall (m :: * -> *) peeraddr extraFlags extraAPI extraCounters
       peerconn extraDebugState.
(MonadSTM m, Ord peeraddr) =>
ExtraPeerSelectionActions m
-> PeerSelectionActions
     ExtraState
     extraFlags
     (ExtraPeers peeraddr)
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
monitorBootstrapPeersFlag Cardano.ExtraPeerSelectionActions { STM m UseBootstrapPeers
readUseBootstrapPeers :: STM m UseBootstrapPeers
readUseBootstrapPeers :: forall (m :: * -> *).
ExtraPeerSelectionActions m -> STM m UseBootstrapPeers
Cardano.readUseBootstrapPeers }
                          PeerSelectionActions { PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI :: PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI }
                          st :: PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st@PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers
                                                , EstablishedPeers peeraddr peerconn
establishedPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers
                                                , PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
                                                , Set peeraddr
inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteCold
                                                , Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm
                                                , extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState = cpst :: ExtraState
cpst@Cardano.ExtraState {
                                                    UseBootstrapPeers
bootstrapPeersFlag :: ExtraState -> UseBootstrapPeers
bootstrapPeersFlag :: UseBootstrapPeers
Cardano.bootstrapPeersFlag,
                                                    ConsensusMode
consensusMode :: ExtraState -> ConsensusMode
consensusMode :: ConsensusMode
Cardano.consensusMode
                                                  }
                                                }
  | ConsensusMode
GenesisMode <- ConsensusMode
consensusMode = Maybe Time
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> Guarded m a
GuardedSkip Maybe Time
forall a. Maybe a
Nothing
  | Bool
otherwise =
  Maybe Time
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      ExtraState
      extraDebugState
      extraFlags
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         extraFlags
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ do
    ubp <- STM m UseBootstrapPeers
readUseBootstrapPeers
    check (ubp /= bootstrapPeersFlag)
    let nonEstablishedBootstrapPeers =
          PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
          Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\
          EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers
          Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\
          (Set peeraddr
inProgressPromoteCold Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
inProgressPromoteWarm)
    return $ \Time
_now ->
      Decision {
        decisionTrace :: [TracePeerSelection
   extraDebugState extraFlags (ExtraPeers peeraddr) peeraddr]
decisionTrace = [UseBootstrapPeers
-> TracePeerSelection
     extraDebugState extraFlags (ExtraPeers peeraddr) peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
UseBootstrapPeers
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceUseBootstrapPeersChanged UseBootstrapPeers
ubp],
        decisionJobs :: [Job
   ()
   m
   (Completion
      m
      ExtraState
      extraDebugState
      extraFlags
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)]
decisionJobs  = [],
        decisionState :: PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
decisionState =
          PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st { knownPeers =
                 KnownPeers.delete
                   nonEstablishedBootstrapPeers
                   knownPeers
             , publicRootPeers =
                 PublicRootPeers.difference (differenceExtraPeers extraPeersAPI)
                   publicRootPeers
                   nonEstablishedBootstrapPeers
             , extraState = cpst {
                 Cardano.bootstrapPeersFlag    = ubp
               , Cardano.ledgerStateJudgement  = YoungEnough
               , Cardano.hasOnlyBootstrapPeers = False
               , Cardano.bootstrapPeersTimeout = Nothing
               }
             }
      }

-- | Monitor 'LedgerStateJudgement', if it changes,
--
-- For Praos mode:
-- If bootstrap peers are enabled, we need to update 'PeerSelectionTargets'.
-- If the ledger state changed to 'TooOld' we set all other targets to 0
-- and the governor waits for all active connections to drop and then set
-- the targets to sensible values for getting caught up again.
-- However if the state changes to 'YoungEnough' we reset the targets back to
-- their original values.
--
-- It should be noted if the node has bootstrap peers disabled then this
-- monitoring action will be disabled.
--
-- It should also be noted that churning is ignored until the node converges
-- to a clean state. I.e., it will disconnect from the targets source of truth.
--
monitorLedgerStateJudgement
  :: ( MonadSTM m
     , Ord peeraddr
     )
  => PeerSelectionActions
      Cardano.ExtraState
      extraFlags
      (Cardano.ExtraPeers peeraddr)
      (Cardano.LedgerPeersConsensusInterface m)
      extraCounters
      peeraddr
      peerconn
      m
  -> PeerSelectionState
      Cardano.ExtraState
      extraFlags
      (Cardano.ExtraPeers peeraddr)
      peeraddr
      peerconn
  -> Guarded (STM m)
            (TimedDecision m Cardano.ExtraState extraDebugState extraFlags
                           (Cardano.ExtraPeers peeraddr) peeraddr peerconn)
monitorLedgerStateJudgement :: forall (m :: * -> *) peeraddr extraFlags extraCounters peerconn
       extraDebugState.
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions
  ExtraState
  extraFlags
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
monitorLedgerStateJudgement PeerSelectionActions{
                              getLedgerStateCtx :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> LedgerPeersConsensusInterface extraAPI m
getLedgerStateCtx = ledgerCtx :: LedgerPeersConsensusInterface (LedgerPeersConsensusInterface m) m
ledgerCtx@LedgerPeersConsensusInterface {
                                lpExtraAPI :: forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m -> extraAPI
lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
                                  getLedgerStateJudgement :: forall (m :: * -> *).
LedgerPeersConsensusInterface m -> STM m LedgerStateJudgement
Cardano.getLedgerStateJudgement = STM m LedgerStateJudgement
readLedgerStateJudgement
                                }
                              }
                            , PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI :: PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
extraPeersAPI
                            }
                            st :: PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st@PeerSelectionState{ PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers,
                                                   KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers,
                                                   EstablishedPeers peeraddr peerconn
establishedPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers,
                                                   Set peeraddr
inProgressPromoteCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold,
                                                   Set peeraddr
inProgressPromoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm,
                                                   Maybe LedgerPeerSnapshot
ledgerPeerSnapshot :: Maybe LedgerPeerSnapshot
ledgerPeerSnapshot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Maybe LedgerPeerSnapshot
ledgerPeerSnapshot,
                                                   extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState = cpst :: ExtraState
cpst@Cardano.ExtraState {
                                                     UseBootstrapPeers
bootstrapPeersFlag :: ExtraState -> UseBootstrapPeers
bootstrapPeersFlag :: UseBootstrapPeers
Cardano.bootstrapPeersFlag,
                                                     LedgerStateJudgement
ledgerStateJudgement :: ExtraState -> LedgerStateJudgement
ledgerStateJudgement :: LedgerStateJudgement
Cardano.ledgerStateJudgement,
                                                     ConsensusMode
consensusMode :: ExtraState -> ConsensusMode
consensusMode :: ConsensusMode
Cardano.consensusMode
                                                   }
                                                 }
  | ConsensusMode
GenesisMode <- ConsensusMode
consensusMode =
    Maybe Time
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      ExtraState
      extraDebugState
      extraFlags
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         extraFlags
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ do
      lsj <- STM m LedgerStateJudgement
readLedgerStateJudgement
      check (lsj /= ledgerStateJudgement)

      return $ \Time
_now ->
        Decision {
          decisionTrace :: [TracePeerSelection
   extraDebugState extraFlags (ExtraPeers peeraddr) peeraddr]
decisionTrace = [LedgerStateJudgement
-> TracePeerSelection
     extraDebugState extraFlags (ExtraPeers peeraddr) peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
LedgerStateJudgement
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceLedgerStateJudgementChanged LedgerStateJudgement
lsj],
          decisionJobs :: [Job
   ()
   m
   (Completion
      m
      ExtraState
      extraDebugState
      extraFlags
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)]
decisionJobs = case (LedgerStateJudgement
lsj, Maybe LedgerPeerSnapshot
ledgerPeerSnapshot) of
                           (LedgerStateJudgement
TooOld, Just LedgerPeerSnapshot
ledgerPeerSnapshot') ->
                             [LedgerPeerSnapshot
-> LedgerPeersConsensusInterface
     (LedgerPeersConsensusInterface m) m
-> Job
     ()
     m
     (Completion
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) extraAPI extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
MonadSTM m =>
LedgerPeerSnapshot
-> LedgerPeersConsensusInterface extraAPI m
-> Job
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
jobVerifyPeerSnapshot LedgerPeerSnapshot
ledgerPeerSnapshot' LedgerPeersConsensusInterface (LedgerPeersConsensusInterface m) m
ledgerCtx]
                           (LedgerStateJudgement, Maybe LedgerPeerSnapshot)
_otherwise -> [],
          decisionState :: PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
decisionState = PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st {
            extraState = cpst {
              Cardano.ledgerStateJudgement = lsj
            }
          }
        }

  | ConsensusMode
PraosMode <- ConsensusMode
consensusMode
  , UseBootstrapPeers -> Bool
isBootstrapPeersEnabled UseBootstrapPeers
bootstrapPeersFlag =
    Maybe Time
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      ExtraState
      extraDebugState
      extraFlags
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         extraFlags
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ do
      lsj <- STM m LedgerStateJudgement
readLedgerStateJudgement
      check (lsj /= ledgerStateJudgement)
      st' <- case lsj of
        LedgerStateJudgement
TooOld      -> do
          (Time
 -> PeerSelectionState
      ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn)
-> STM
     m
     (Time
      -> PeerSelectionState
           ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Time
now -> PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st
            { targets =
                PeerSelectionTargets
                  { targetNumberOfRootPeers                 = 0
                  , targetNumberOfKnownPeers                = 0
                  , targetNumberOfEstablishedPeers          = 0
                  , targetNumberOfActivePeers               = 0
                  , targetNumberOfKnownBigLedgerPeers       = 0
                  , targetNumberOfEstablishedBigLedgerPeers = 0
                  , targetNumberOfActiveBigLedgerPeers      = 0
                  }
            -- We have to enforce the invariant that the number of root peers is
            -- not more than the target number of known peers. It's unlikely in
            -- practice so it's ok to resolve it arbitrarily using clampToLimit.
            , localRootPeers = LocalRootPeers.empty
            , publicRootBackoffs = 0
            , publicRootRetryTime = now
            , extraState = cpst {
                Cardano.ledgerStateJudgement = lsj
              , Cardano.hasOnlyBootstrapPeers = False
              , Cardano.bootstrapPeersTimeout = Just (addTime governor_BOOTSTRAP_PEERS_TIMEOUT now)
              }
            })
        LedgerStateJudgement
YoungEnough -> do
          let nonEstablishedBootstrapPeers :: Set peeraddr
nonEstablishedBootstrapPeers =
                PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
                Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\
                EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers
                Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\
                (Set peeraddr
inProgressPromoteCold Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
inProgressPromoteWarm)
          (Time
 -> PeerSelectionState
      ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn)
-> STM
     m
     (Time
      -> PeerSelectionState
           ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Time
now -> PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st
            { knownPeers =
                KnownPeers.delete
                  nonEstablishedBootstrapPeers
                  knownPeers
            , publicRootPeers =
                PublicRootPeers.difference (differenceExtraPeers extraPeersAPI)
                  publicRootPeers
                  nonEstablishedBootstrapPeers
            , publicRootBackoffs = 0
            , publicRootRetryTime = now
            , extraState = cpst {
                Cardano.ledgerStateJudgement  = lsj
              , Cardano.hasOnlyBootstrapPeers = False
              , Cardano.bootstrapPeersTimeout = Nothing
              }
            })
      return $ \Time
now ->
        Decision {
          decisionTrace :: [TracePeerSelection
   extraDebugState extraFlags (ExtraPeers peeraddr) peeraddr]
decisionTrace = [LedgerStateJudgement
-> TracePeerSelection
     extraDebugState extraFlags (ExtraPeers peeraddr) peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
LedgerStateJudgement
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceLedgerStateJudgementChanged LedgerStateJudgement
lsj],
          decisionJobs :: [Job
   ()
   m
   (Completion
      m
      ExtraState
      extraDebugState
      extraFlags
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)]
decisionJobs  = [],
          decisionState :: PeerSelectionState
  ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
decisionState = Time
-> PeerSelectionState
     ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
st' Time
now
        }
  | Bool
otherwise = Maybe Time
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> Guarded m a
GuardedSkip Maybe Time
forall a. Maybe a
Nothing

-- | If the node just got in the TooOld state, the node just had its targets
-- adjusted to get rid of all peers. This jobs monitors the node state and when
-- it has arrived to a clean (quiesced) state it sets the 'hasOnlyBootstrapPeers'
-- flag on which will unblock the 'localRoots' and 'targetPeers' monitoring actions,
-- allowing the node to make progress by only connecting to trusted peers.
--
-- It should be noted if the node is _not_ in bootstrap mode (i.e. _not_ in a
-- sensitive state) then this monitoring action will be disabled.
--
-- If the node takes more than 15 minutes to converge to a clean state the
-- node will crash itself so it can be brought back on again in a clean state.
-- If the node takes more than 15 minutes to converge to a clean state it
-- means something really bad must be going on, such a global network outage,
-- DNS issues, or there could be an actual bug in the code. In any case we'll
-- detect that and have a way to observe such cases.
--
waitForSystemToQuiesce
  :: ( MonadSTM m
     , Ord peeraddr
     )
  => PeerSelectionState
      Cardano.ExtraState
      PeerTrustable
      (Cardano.ExtraPeers peeraddr)
      peeraddr
      peerconn
  -> Guarded (STM m)
            (TimedDecision m Cardano.ExtraState extraDebugState PeerTrustable
                             (Cardano.ExtraPeers peeraddr) peeraddr peerconn)
waitForSystemToQuiesce :: forall (m :: * -> *) peeraddr peerconn extraDebugState.
(MonadSTM m, Ord peeraddr) =>
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
waitForSystemToQuiesce st :: PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st@PeerSelectionState{
                            KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers
                          , LocalRootPeers PeerTrustable peeraddr
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers :: LocalRootPeers PeerTrustable peeraddr
localRootPeers
                          , PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
                          , Set peeraddr
inProgressPromoteCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold
                          , Set peeraddr
inProgressPromoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm
                          , Int
inProgressPeerShareReqs :: Int
inProgressPeerShareReqs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
inProgressPeerShareReqs
                          , Bool
inProgressPublicRootsReq :: Bool
inProgressPublicRootsReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressPublicRootsReq
                          , Bool
inProgressBigLedgerPeersReq :: Bool
inProgressBigLedgerPeersReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressBigLedgerPeersReq
                          , extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState = cpst :: ExtraState
cpst@Cardano.ExtraState {
                              LedgerStateJudgement
ledgerStateJudgement :: ExtraState -> LedgerStateJudgement
ledgerStateJudgement :: LedgerStateJudgement
Cardano.ledgerStateJudgement
                            , UseBootstrapPeers
bootstrapPeersFlag :: ExtraState -> UseBootstrapPeers
bootstrapPeersFlag :: UseBootstrapPeers
Cardano.bootstrapPeersFlag
                            , Bool
hasOnlyBootstrapPeers :: ExtraState -> Bool
hasOnlyBootstrapPeers :: Bool
Cardano.hasOnlyBootstrapPeers
                            }
                          }
  -- Is the node in sensitive state?
  | UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
bootstrapPeersFlag LedgerStateJudgement
ledgerStateJudgement
  -- Has the node still haven't reached a clean state
  , Bool -> Bool
not Bool
hasOnlyBootstrapPeers
  -- Are the local root peers all trustable?
  , (LocalRootConfig PeerTrustable -> Bool)
-> Map peeraddr (LocalRootConfig PeerTrustable) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
          LocalRootConfig { extraFlags :: forall extraFlags. LocalRootConfig extraFlags -> extraFlags
extraFlags = PeerTrustable
IsTrustable }
            -> Bool
True
          LocalRootConfig PeerTrustable
_ -> Bool
False
        )
        (LocalRootPeers PeerTrustable peeraddr
-> Map peeraddr (LocalRootConfig PeerTrustable)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers PeerTrustable peeraddr
localRootPeers)
  -- Are the known peers all trustable or all in progress to be demoted?
  , KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf`
    (  PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
    Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable LocalRootPeers PeerTrustable peeraddr
localRootPeers)
    )

  -- Are there still any in progress promotion jobs?
  , Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
inProgressPromoteCold
  , Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
inProgressPromoteWarm
  , Int
inProgressPeerShareReqs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  , Bool -> Bool
not Bool
inProgressBigLedgerPeersReq
  , Bool -> Bool
not Bool
inProgressPublicRootsReq =
    Maybe Time
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ do
      TimedDecision
  m
  ExtraState
  extraDebugState
  PeerTrustable
  (ExtraPeers peeraddr)
  peeraddr
  peerconn
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimedDecision
   m
   ExtraState
   extraDebugState
   PeerTrustable
   (ExtraPeers peeraddr)
   peeraddr
   peerconn
 -> STM
      m
      (TimedDecision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> TimedDecision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn
-> STM
     m
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ \Time
_now ->
        Decision { decisionTrace :: [TracePeerSelection
   extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr]
decisionTrace = [TracePeerSelection
  extraDebugState PeerTrustable (ExtraPeers peeraddr) peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
TraceOnlyBootstrapPeers],
                   decisionJobs :: [Job
   ()
   m
   (Completion
      m
      ExtraState
      extraDebugState
      PeerTrustable
      (ExtraPeers peeraddr)
      peeraddr
      peerconn)]
decisionJobs  = [],
                   decisionState :: PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
decisionState = PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st { extraState = cpst {
                                          Cardano.hasOnlyBootstrapPeers = True
                                        , Cardano.bootstrapPeersTimeout = Nothing
                                        }
                                      }
        }
  | Bool
otherwise = Maybe Time
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> Guarded m a
GuardedSkip Maybe Time
forall a. Maybe a
Nothing