{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE NamedFieldPuns           #-}

module Cardano.Network.PeerSelection.Governor.Types
  ( empty
  , outboundConnectionsState
  , cardanoPeerSelectionGovernorArgs
  , readAssociationMode
  , SupportsPeerSelectionState (..)
  , Cardano.NumberOfBigLedgerPeers (..)
  ) where

import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadSTM
import Control.Monad.Class.MonadTimer.SI
import Data.Set qualified as Set

import Cardano.Network.ConsensusMode (ConsensusMode (..))
import Cardano.Network.LedgerPeerConsensusInterface qualified as Cardano
import Cardano.Network.LedgerStateJudgement
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
           requiresBootstrapPeers)
import Cardano.Network.PeerSelection.ExtraRootPeers qualified as Cardano
import Cardano.Network.PeerSelection.Governor.Monitor
           (monitorBootstrapPeersFlag, monitorLedgerStateJudgement,
           waitForSystemToQuiesce)
import Cardano.Network.PeerSelection.Governor.Monitor qualified as Cardano
import Cardano.Network.PeerSelection.Governor.PeerSelectionActions qualified as Cardano
import Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
import Cardano.Network.PeerSelection.LocalRootPeers
           (OutboundConnectionsState (..))
import Cardano.Network.PeerSelection.PeerTrustable
           (PeerTrustable (IsNotTrustable))
import Cardano.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers

import Ouroboros.Network.PeerSelection (PeerSharing (..), UseLedgerPeers (..))
import Ouroboros.Network.PeerSelection.Governor.Types (AssociationMode (..),
           BootstrapPeersCriticalTimeoutError (..), ExtraGuardedDecisions (..),
           PeerSelectionActions (..), PeerSelectionGovernorArgs (..),
           PeerSelectionInterfaces (..), PeerSelectionSetsWithSizes,
           PeerSelectionState (..), PeerSelectionView (..),
           SupportsPeerSelectionState (..))
import Ouroboros.Network.PeerSelection.LedgerPeers
           (LedgerPeersConsensusInterface (lpExtraAPI))


empty :: (Cardano.ViewExtraPeers (Cardano.ExtraPeers peeraddr))
empty :: forall peeraddr. ViewExtraPeers (ExtraPeers peeraddr)
empty = Cardano.ExtraPeerSelectionSetsWithSizes {
    viewKnownBootstrapPeers :: (Set peeraddr, Int)
viewKnownBootstrapPeers           = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  , viewColdBootstrapPeersPromotions :: (Set peeraddr, Int)
viewColdBootstrapPeersPromotions  = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  , viewEstablishedBootstrapPeers :: (Set peeraddr, Int)
viewEstablishedBootstrapPeers     = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  , viewWarmBootstrapPeersDemotions :: (Set peeraddr, Int)
viewWarmBootstrapPeersDemotions   = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  , viewWarmBootstrapPeersPromotions :: (Set peeraddr, Int)
viewWarmBootstrapPeersPromotions  = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  , viewActiveBootstrapPeers :: (Set peeraddr, Int)
viewActiveBootstrapPeers          = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  , viewActiveBootstrapPeersDemotions :: (Set peeraddr, Int)
viewActiveBootstrapPeersDemotions = (Set peeraddr
forall a. Set a
Set.empty, Int
0)
  }

outboundConnectionsState
    :: Ord peeraddr
    => AssociationMode
    -> PeerSelectionSetsWithSizes (Cardano.ViewExtraPeers (Cardano.ExtraPeers peeraddr)) peeraddr
    -> PeerSelectionState Cardano.ExtraState PeerTrustable extraPeers peeraddr peerconn
    -> OutboundConnectionsState
outboundConnectionsState :: forall peeraddr extraPeers peerconn.
Ord peeraddr =>
AssociationMode
-> PeerSelectionSetsWithSizes
     (ViewExtraPeers (ExtraPeers peeraddr)) peeraddr
-> PeerSelectionState
     ExtraState PeerTrustable extraPeers peeraddr peerconn
-> OutboundConnectionsState
outboundConnectionsState
    AssociationMode
associationMode
    PeerSelectionView {
      viewEstablishedPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedPeers       = (Set peeraddr
viewEstablishedPeers, Int
_),
        viewActiveBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveBigLedgerPeers = (Set peeraddr
_, Int
activeNumBigLedgerPeers),
      viewExtraViews :: forall extraViews a. PeerSelectionView extraViews a -> extraViews
viewExtraViews = Cardano.ExtraPeerSelectionSetsWithSizes {
        viewEstablishedBootstrapPeers :: forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewEstablishedBootstrapPeers = (Set peeraddr
viewEstablishedBootstrapPeers, Int
_),
        viewActiveBootstrapPeers :: forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewActiveBootstrapPeers      = (Set peeraddr
viewActiveBootstrapPeers, Int
_)
      }
    }
    PeerSelectionState {
      LocalRootPeers PeerTrustable peeraddr
localRootPeers :: LocalRootPeers PeerTrustable peeraddr
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers,
      extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState = Cardano.ExtraState {
        ConsensusMode
consensusMode :: ConsensusMode
consensusMode :: ExtraState -> ConsensusMode
Cardano.consensusMode,
        UseBootstrapPeers
bootstrapPeersFlag :: UseBootstrapPeers
bootstrapPeersFlag :: ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag,
        NumberOfBigLedgerPeers
minNumberOfBigLedgerPeers :: NumberOfBigLedgerPeers
minNumberOfBigLedgerPeers :: ExtraState -> NumberOfBigLedgerPeers
Cardano.minNumberOfBigLedgerPeers
      }
    }
    =
    case (AssociationMode
associationMode, UseBootstrapPeers
bootstrapPeersFlag, ConsensusMode
consensusMode) of
      (AssociationMode
LocalRootsOnly, UseBootstrapPeers
_, ConsensusMode
_)
        |  -- we are only connected to trusted local root
           -- peers
           Set peeraddr
viewEstablishedPeers Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set peeraddr
trustableLocalRootSet
        -> OutboundConnectionsState
TrustedStateWithExternalPeers

        |  Bool
otherwise
        -> OutboundConnectionsState
UntrustedState

       -- bootstrap mode
      (AssociationMode
Unrestricted, UseBootstrapPeers {}, ConsensusMode
_)
        |  -- we are only connected to trusted local root
           -- peers or bootstrap peers
           Set peeraddr
viewEstablishedPeers Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` (Set peeraddr
viewEstablishedBootstrapPeers Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
trustableLocalRootSet)
           -- there's at least one active bootstrap peer
        ,  Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
viewActiveBootstrapPeers)
        -> OutboundConnectionsState
TrustedStateWithExternalPeers

        |  Bool
otherwise
        -> OutboundConnectionsState
UntrustedState

       -- praos mode with public roots
      (AssociationMode
Unrestricted, UseBootstrapPeers
DontUseBootstrapPeers, ConsensusMode
PraosMode)
        -> OutboundConnectionsState
UntrustedState

      -- Genesis mode
      (AssociationMode
Unrestricted, UseBootstrapPeers
DontUseBootstrapPeers, ConsensusMode
GenesisMode)
        |  Int
activeNumBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= NumberOfBigLedgerPeers -> Int
Cardano.getNumberOfBigLedgerPeers NumberOfBigLedgerPeers
minNumberOfBigLedgerPeers
        -> OutboundConnectionsState
TrustedStateWithExternalPeers

        |  Bool
otherwise
        -> OutboundConnectionsState
UntrustedState
  where
    trustableLocalRootSet :: Set peeraddr
trustableLocalRootSet = LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
forall peeraddr.
LocalRootPeers PeerTrustable peeraddr -> Set peeraddr
LocalRootPeers.trustableKeysSet LocalRootPeers PeerTrustable peeraddr
localRootPeers


cardanoPeerSelectionGovernorArgs
  :: ( MonadTimer m
     , Alternative (STM m)
     , Ord peeraddr
     )
  => Cardano.ExtraPeerSelectionActions m
  -> PeerSelectionGovernorArgs
       Cardano.ExtraState
       extraDebugState
       PeerTrustable
       (Cardano.ExtraPeers peeraddr)
       (Cardano.LedgerPeersConsensusInterface m)
       peeraddr
       peerconn
       BootstrapPeersCriticalTimeoutError
       m
cardanoPeerSelectionGovernorArgs :: forall (m :: * -> *) peeraddr extraDebugState peerconn.
(MonadTimer m, Alternative (STM m), Ord peeraddr) =>
ExtraPeerSelectionActions m
-> PeerSelectionGovernorArgs
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     BootstrapPeersCriticalTimeoutError
     m
cardanoPeerSelectionGovernorArgs ExtraPeerSelectionActions m
extraActions =
  PeerSelectionGovernorArgs {
    -- If by any chance the node takes more than 15 minutes to converge to a
    -- clean state, we crash the node. This could happen in very rare
    -- conditions such as a global network issue, DNS, or a bug in the code.
    -- In any case crashing the node will force the node to be restarted,
    -- starting in the correct state for it to make progress.
    abortGovernor :: Time
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Maybe BootstrapPeersCriticalTimeoutError
abortGovernor   = \Time
blockedAt PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st ->
      case ExtraState -> Maybe Time
Cardano.bootstrapPeersTimeout (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st) of
        Maybe Time
Nothing -> Maybe BootstrapPeersCriticalTimeoutError
forall a. Maybe a
Nothing
        Just Time
t
          | Time
blockedAt Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
t -> BootstrapPeersCriticalTimeoutError
-> Maybe BootstrapPeersCriticalTimeoutError
forall a. a -> Maybe a
Just BootstrapPeersCriticalTimeoutError
BootstrapPeersCriticalTimeoutError
          | Bool
otherwise      -> Maybe BootstrapPeersCriticalTimeoutError
forall a. Maybe a
Nothing
  , updateWithState :: PeerSelectionInterfaces
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionSetsWithSizes
     (ViewExtraPeers (ExtraPeers peeraddr)) peeraddr
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> STM m ()
updateWithState = \PeerSelectionInterfaces { STM m UseLedgerPeers
readUseLedgerPeers :: STM m UseLedgerPeers
readUseLedgerPeers :: forall extraState extraFlags extraPeers peeraddr peerconn
       (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers peeraddr peerconn m
-> STM m UseLedgerPeers
readUseLedgerPeers }
                       PeerSelectionActions { LedgerPeersConsensusInterface (LedgerPeersConsensusInterface m) m
getLedgerStateCtx :: LedgerPeersConsensusInterface (LedgerPeersConsensusInterface m) m
getLedgerStateCtx :: forall extraState extraFlags extraPeers extraAPI peeraddr peerconn
       (m :: * -> *).
PeerSelectionActions
  extraState extraFlags extraPeers extraAPI peeraddr peerconn m
-> LedgerPeersConsensusInterface extraAPI m
getLedgerStateCtx,
                                              PeerSharing
peerSharing :: PeerSharing
peerSharing :: forall extraState extraFlags extraPeers extraAPI peeraddr peerconn
       (m :: * -> *).
PeerSelectionActions
  extraState extraFlags extraPeers extraAPI peeraddr peerconn m
-> PeerSharing
peerSharing }
                       PeerSelectionSetsWithSizes
  (ViewExtraPeers (ExtraPeers peeraddr)) peeraddr
psv PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st -> do
      associationMode <- STM m UseLedgerPeers
-> PeerSharing -> UseBootstrapPeers -> STM m AssociationMode
forall (m :: * -> *).
MonadSTM m =>
STM m UseLedgerPeers
-> PeerSharing -> UseBootstrapPeers -> STM m AssociationMode
readAssociationMode STM m UseLedgerPeers
readUseLedgerPeers
                                             PeerSharing
peerSharing
                                             (ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
st))
      Cardano.updateOutboundConnectionsState
        (lpExtraAPI getLedgerStateCtx)
        (outboundConnectionsState associationMode psv st)
  , extraDecisions :: ExtraGuardedDecisions
  ExtraState
  extraDebugState
  PeerTrustable
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
extraDecisions  =
      ExtraGuardedDecisions {
        preBlocking :: PeerSelectionPolicy peeraddr m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
preBlocking     = \PeerSelectionPolicy peeraddr m
_ PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
psa PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
pst ->
             ExtraPeerSelectionActions m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) peeraddr extraFlags extraAPI peerconn
       extraDebugState.
(MonadSTM m, Ord peeraddr) =>
ExtraPeerSelectionActions m
-> PeerSelectionActions
     ExtraState
     extraFlags
     (ExtraPeers peeraddr)
     extraAPI
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
monitorBootstrapPeersFlag   ExtraPeerSelectionActions m
extraActions PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
psa PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
pst
          Guarded
  (STM m)
  (TimedDecision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn)
-> Guarded
     (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. Semigroup a => a -> a -> a
<> PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) peeraddr extraFlags peerconn extraDebugState.
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions
  ExtraState
  extraFlags
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        extraFlags
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
monitorLedgerStateJudgement PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
psa PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
pst
          Guarded
  (STM m)
  (TimedDecision
     m
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     peeraddr
     peerconn)
-> Guarded
     (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. Semigroup a => a -> a -> a
<> PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
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          PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
pst
      , postBlocking :: PeerSelectionPolicy peeraddr m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
postBlocking    = PeerSelectionPolicy peeraddr m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a. Monoid a => a
mempty
      , postNonBlocking :: PeerSelectionPolicy peeraddr m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
postNonBlocking = PeerSelectionPolicy peeraddr m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall a. Monoid a => a
mempty
      , customTargetsAction :: Maybe
  (PeerSelectionPolicy peeraddr m
   -> PeerSelectionActions
        ExtraState
        PeerTrustable
        (ExtraPeers peeraddr)
        (LedgerPeersConsensusInterface m)
        peeraddr
        peerconn
        m
   -> PeerSelectionState
        ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
   -> Guarded
        (STM m)
        (TimedDecision
           m
           ExtraState
           extraDebugState
           PeerTrustable
           (ExtraPeers peeraddr)
           peeraddr
           peerconn))
customTargetsAction         = (PeerSelectionPolicy peeraddr m
 -> PeerSelectionActions
      ExtraState
      PeerTrustable
      (ExtraPeers peeraddr)
      (LedgerPeersConsensusInterface m)
      peeraddr
      peerconn
      m
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> Maybe
     (PeerSelectionPolicy peeraddr m
      -> PeerSelectionActions
           ExtraState
           PeerTrustable
           (ExtraPeers peeraddr)
           (LedgerPeersConsensusInterface m)
           peeraddr
           peerconn
           m
      -> PeerSelectionState
           ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
      -> Guarded
           (STM m)
           (TimedDecision
              m
              ExtraState
              extraDebugState
              PeerTrustable
              (ExtraPeers peeraddr)
              peeraddr
              peerconn))
forall a. a -> Maybe a
Just ((PeerSelectionPolicy peeraddr m
  -> PeerSelectionActions
       ExtraState
       PeerTrustable
       (ExtraPeers peeraddr)
       (LedgerPeersConsensusInterface m)
       peeraddr
       peerconn
       m
  -> PeerSelectionState
       ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
  -> Guarded
       (STM m)
       (TimedDecision
          m
          ExtraState
          extraDebugState
          PeerTrustable
          (ExtraPeers peeraddr)
          peeraddr
          peerconn))
 -> Maybe
      (PeerSelectionPolicy peeraddr m
       -> PeerSelectionActions
            ExtraState
            PeerTrustable
            (ExtraPeers peeraddr)
            (LedgerPeersConsensusInterface m)
            peeraddr
            peerconn
            m
       -> PeerSelectionState
            ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
       -> Guarded
            (STM m)
            (TimedDecision
               m
               ExtraState
               extraDebugState
               PeerTrustable
               (ExtraPeers peeraddr)
               peeraddr
               peerconn)))
-> (PeerSelectionPolicy peeraddr m
    -> PeerSelectionActions
         ExtraState
         PeerTrustable
         (ExtraPeers peeraddr)
         (LedgerPeersConsensusInterface m)
         peeraddr
         peerconn
         m
    -> PeerSelectionState
         ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
    -> Guarded
         (STM m)
         (TimedDecision
            m
            ExtraState
            extraDebugState
            PeerTrustable
            (ExtraPeers peeraddr)
            peeraddr
            peerconn))
-> Maybe
     (PeerSelectionPolicy peeraddr m
      -> PeerSelectionActions
           ExtraState
           PeerTrustable
           (ExtraPeers peeraddr)
           (LedgerPeersConsensusInterface m)
           peeraddr
           peerconn
           m
      -> PeerSelectionState
           ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
      -> Guarded
           (STM m)
           (TimedDecision
              m
              ExtraState
              extraDebugState
              PeerTrustable
              (ExtraPeers peeraddr)
              peeraddr
              peerconn))
forall a b. (a -> b) -> a -> b
$ \PeerSelectionPolicy peeraddr m
_ -> ExtraPeerSelectionActions m
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     peeraddr
     peerconn
     m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall (m :: * -> *) peeraddr extraFlags extraPeers extraAPI
       peerconn extraDebugState.
(MonadSTM m, Ord peeraddr) =>
ExtraPeerSelectionActions m
-> PeerSelectionActions
     ExtraState extraFlags extraPeers extraAPI peeraddr peerconn m
-> PeerSelectionState
     ExtraState PeerTrustable extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        extraPeers
        peeraddr
        peerconn)
Cardano.targetPeers ExtraPeerSelectionActions m
extraActions
      , customLocalRootsAction :: Maybe
  (PeerSelectionPolicy peeraddr m
   -> PeerSelectionActions
        ExtraState
        PeerTrustable
        (ExtraPeers peeraddr)
        (LedgerPeersConsensusInterface m)
        peeraddr
        peerconn
        m
   -> PeerSelectionState
        ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
   -> Guarded
        (STM m)
        (TimedDecision
           m
           ExtraState
           extraDebugState
           PeerTrustable
           (ExtraPeers peeraddr)
           peeraddr
           peerconn))
customLocalRootsAction      = (PeerSelectionPolicy peeraddr m
 -> PeerSelectionActions
      ExtraState
      PeerTrustable
      (ExtraPeers peeraddr)
      (LedgerPeersConsensusInterface m)
      peeraddr
      peerconn
      m
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
 -> Guarded
      (STM m)
      (TimedDecision
         m
         ExtraState
         extraDebugState
         PeerTrustable
         (ExtraPeers peeraddr)
         peeraddr
         peerconn))
-> Maybe
     (PeerSelectionPolicy peeraddr m
      -> PeerSelectionActions
           ExtraState
           PeerTrustable
           (ExtraPeers peeraddr)
           (LedgerPeersConsensusInterface m)
           peeraddr
           peerconn
           m
      -> PeerSelectionState
           ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
      -> Guarded
           (STM m)
           (TimedDecision
              m
              ExtraState
              extraDebugState
              PeerTrustable
              (ExtraPeers peeraddr)
              peeraddr
              peerconn))
forall a. a -> Maybe a
Just ((PeerSelectionPolicy peeraddr m
  -> PeerSelectionActions
       ExtraState
       PeerTrustable
       (ExtraPeers peeraddr)
       (LedgerPeersConsensusInterface m)
       peeraddr
       peerconn
       m
  -> PeerSelectionState
       ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
  -> Guarded
       (STM m)
       (TimedDecision
          m
          ExtraState
          extraDebugState
          PeerTrustable
          (ExtraPeers peeraddr)
          peeraddr
          peerconn))
 -> Maybe
      (PeerSelectionPolicy peeraddr m
       -> PeerSelectionActions
            ExtraState
            PeerTrustable
            (ExtraPeers peeraddr)
            (LedgerPeersConsensusInterface m)
            peeraddr
            peerconn
            m
       -> PeerSelectionState
            ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
       -> Guarded
            (STM m)
            (TimedDecision
               m
               ExtraState
               extraDebugState
               PeerTrustable
               (ExtraPeers peeraddr)
               peeraddr
               peerconn)))
-> (PeerSelectionPolicy peeraddr m
    -> PeerSelectionActions
         ExtraState
         PeerTrustable
         (ExtraPeers peeraddr)
         (LedgerPeersConsensusInterface m)
         peeraddr
         peerconn
         m
    -> PeerSelectionState
         ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
    -> Guarded
         (STM m)
         (TimedDecision
            m
            ExtraState
            extraDebugState
            PeerTrustable
            (ExtraPeers peeraddr)
            peeraddr
            peerconn))
-> Maybe
     (PeerSelectionPolicy peeraddr m
      -> PeerSelectionActions
           ExtraState
           PeerTrustable
           (ExtraPeers peeraddr)
           (LedgerPeersConsensusInterface m)
           peeraddr
           peerconn
           m
      -> PeerSelectionState
           ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
      -> Guarded
           (STM m)
           (TimedDecision
              m
              ExtraState
              extraDebugState
              PeerTrustable
              (ExtraPeers peeraddr)
              peeraddr
              peerconn))
forall a b. (a -> b) -> a -> b
$ \PeerSelectionPolicy peeraddr m
_ -> PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  (LedgerPeersConsensusInterface m)
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
forall extraDebugState extraAPI peeraddr peerconn (m :: * -> *).
(MonadTimer m, Ord peeraddr) =>
PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  extraAPI
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
Cardano.localRoots
      , enableProgressMakingActions :: ExtraState -> Bool
enableProgressMakingActions = \ExtraState
st ->
          Bool -> Bool
not (UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers (ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag ExtraState
st) (ExtraState -> LedgerStateJudgement
Cardano.ledgerStateJudgement ExtraState
st))
      , ledgerPeerSnapshotExtraStateChange :: ExtraState -> ExtraState
ledgerPeerSnapshotExtraStateChange = \ExtraState
st ->
          ExtraState
st { Cardano.ledgerStateJudgement = YoungEnough }
      }
  , defaultExtraFlags :: PeerTrustable
defaultExtraFlags = PeerTrustable
IsNotTrustable
  }


-- | Classify if a node is in promiscuous mode.
--
-- A node is not in promiscuous mode only if: it doesn't use ledger peers, peer
-- sharing, the set of bootstrap peers is empty.
--
readAssociationMode
  :: MonadSTM m
  => STM m UseLedgerPeers
  -> PeerSharing
  -> UseBootstrapPeers
  -> STM m AssociationMode
readAssociationMode :: forall (m :: * -> *).
MonadSTM m =>
STM m UseLedgerPeers
-> PeerSharing -> UseBootstrapPeers -> STM m AssociationMode
readAssociationMode
  STM m UseLedgerPeers
readUseLedgerPeers
  PeerSharing
peerSharing
  UseBootstrapPeers
useBootstrapPeers
  =
  do useLedgerPeers <- STM m UseLedgerPeers
readUseLedgerPeers
     pure $
       case (useLedgerPeers, peerSharing, useBootstrapPeers) of
         (UseLedgerPeers
DontUseLedgerPeers, PeerSharing
PeerSharingDisabled, UseBootstrapPeers
DontUseBootstrapPeers)
           -> AssociationMode
LocalRootsOnly
         (UseLedgerPeers
DontUseLedgerPeers, PeerSharing
PeerSharingDisabled, UseBootstrapPeers [RelayAccessPoint]
config)
           |  [RelayAccessPoint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelayAccessPoint]
config
           -> AssociationMode
LocalRootsOnly
         (UseLedgerPeers, PeerSharing, UseBootstrapPeers)
_ -> AssociationMode
Unrestricted