{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DeriveFunctor             #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE PatternSynonyms           #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE StandaloneDeriving        #-}
{-# LANGUAGE ViewPatterns              #-}

#if __GLASGOW_HASKELL__ < 904
-- Pattern synonym record fields with GHC-8.10 is issuing the `-Wname-shadowing`
-- warning.
{-# OPTIONS_GHC -Wno-name-shadowing #-}
#endif

module Ouroboros.Network.PeerSelection.Governor.Types
  ( -- * P2P governor policies
    PeerSelectionPolicy (..)
  , PeerSelectionTargets (..)
  , nullPeerSelectionTargets
  , sanePeerSelectionTargets
  , PickPolicy

    -- ** Cardano Node specific functions
  , pickPeers
  , pickUnknownPeers

    -- * P2P governor low level API
    -- These records are needed to run the peer selection.
  , PeerStateActions (..)
  , PeerSelectionActions (..)
  , PeerSelectionInterfaces (..)
  , MonitoringAction
  , ExtraGuardedDecisions (..)
  , PeerSelectionGovernorArgs (..)
    -- * P2P governor internals
  , PeerSelectionState (..)
  , emptyPeerSelectionState
  , AssociationMode (..)
  , DebugPeerSelectionState (..)
  , makeDebugPeerSelectionState
  , assertPeerSelectionState
  , establishedPeersStatus
  , PublicPeerSelectionState (..)
  , makePublicPeerSelectionStateVar
  , toPublicState
  , Guarded (GuardedSkip, Guarded)
  , Decision (..)
  , TimedDecision
  , MkGuardedDecision
  , Completion (..)
  , PeerSelectionView
      ( ..,
        PeerSelectionCounters,
        numberOfRootPeers,

        numberOfKnownPeers,
        numberOfAvailableToConnectPeers,
        numberOfColdPeersPromotions,
        numberOfEstablishedPeers,
        numberOfWarmPeersDemotions,
        numberOfWarmPeersPromotions,
        numberOfActivePeers,
        numberOfActivePeersDemotions,

        numberOfKnownBigLedgerPeers,
        numberOfAvailableToConnectBigLedgerPeers,
        numberOfColdBigLedgerPeersPromotions,
        numberOfEstablishedBigLedgerPeers,
        numberOfWarmBigLedgerPeersDemotions,
        numberOfWarmBigLedgerPeersPromotions,
        numberOfActiveBigLedgerPeers,
        numberOfActiveBigLedgerPeersDemotions,

        numberOfKnownLocalRootPeers,
        numberOfAvailableToConnectLocalRootPeers,
        numberOfColdLocalRootPeersPromotions,
        numberOfEstablishedLocalRootPeers,
        numberOfWarmLocalRootPeersPromotions,
        numberOfActiveLocalRootPeers,
        numberOfActiveLocalRootPeersDemotions,

        numberOfKnownNonRootPeers,
        numberOfColdNonRootPeersPromotions,
        numberOfEstablishedNonRootPeers,
        numberOfWarmNonRootPeersDemotions,
        numberOfWarmNonRootPeersPromotions,
        numberOfActiveNonRootPeers,
        numberOfActiveNonRootPeersDemotions,

        extraCounters,

        PeerSelectionCountersHWC,
        numberOfColdPeers,
        numberOfWarmPeers,
        numberOfHotPeers,

        numberOfColdBigLedgerPeers,
        numberOfWarmBigLedgerPeers,
        numberOfHotBigLedgerPeers,

        numberOfColdLocalRootPeers,
        numberOfWarmLocalRootPeers,
        numberOfHotLocalRootPeers
      )
  , PeerSelectionCounters
  , PeerSelectionSetsWithSizes
  , emptyPeerSelectionCounters

    -- ** Cardano Node specific functions
  , peerSelectionStateToCounters
  , peerSelectionStateToView

    -- * Peer Sharing Auxiliary data type
  , PeerSharingResult (..)
    -- * Traces
  , TracePeerSelection (..)
  , ChurnAction (..)
  , DebugPeerSelection (..)
    -- * Error types
  , BootstrapPeersCriticalTimeoutError (..)
  ) where

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Monoid.Synchronisation (FirstToFinish (..))
import Data.OrdPSQ qualified as PSQ
import Data.Semigroup (Min (..))
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Stack (HasCallStack)

import Control.Applicative (Alternative)
import Control.Concurrent.JobPool (Job)
import Control.Exception (Exception (..), SomeException, assert)
import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadTime.SI
import System.Random (StdGen)

import Control.Concurrent.Class.MonadSTM.Strict
import Ouroboros.Network.ExitPolicy
import Ouroboros.Network.NodeToNode.Version (DiffusionMode)
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
import Ouroboros.Network.PeerSelection.State.EstablishedPeers (EstablishedPeers)
import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
import Ouroboros.Network.PeerSelection.State.KnownPeers (KnownPeers)
import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..),
           LocalRootPeers, WarmValency (..))
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSelection.Types (PeerSource (..),
           PeerStatus (PeerHot, PeerWarm), PublicExtraPeersAPI)
import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount,
           PeerSharingResult (..))
import Cardano.Network.Types (LedgerStateJudgement (..))
import Ouroboros.Cardano.Network.Types (ChurnMode)
import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint)

-- | A peer pick policy is an action that picks a subset of elements from a
-- map of peers.
--
-- The pre-condition is that the map of available choices will be non-empty,
-- and the requested number to pick will be strictly positive.
--
-- The post-condition is that the picked set is non-empty but must not be
-- bigger than the requested number.
--
-- Peer selection API is using `STM m` monad, internally it is using `m`.
--
type PickPolicy peeraddr m =
         -- Extra peer attributes available to use in the picking policy.
         -- As more attributes are needed, extend this with more such functions.
         (peeraddr -> PeerSource) -- Where the peer is known from
      -> (peeraddr -> Int)        -- Connection failure count
      -> (peeraddr -> Bool)       -- Found to be tepid flag
      -> Set peeraddr             -- The set to pick from
      -> Int                      -- Max number to choose, fewer is ok.
      -> m (Set peeraddr)         -- The set picked.


data PeerSelectionPolicy peeraddr m = PeerSelectionPolicy {

       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickKnownPeersForPeerShare :: PickPolicy peeraddr (STM m),
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickColdPeersToPromote     :: PickPolicy peeraddr (STM m),
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickWarmPeersToPromote     :: PickPolicy peeraddr (STM m),
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickHotPeersToDemote       :: PickPolicy peeraddr (STM m),
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickWarmPeersToDemote      :: PickPolicy peeraddr (STM m),
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickColdPeersToForget      :: PickPolicy peeraddr (STM m),
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr (STM m)
policyPickInboundPeers           :: PickPolicy peeraddr (STM m),

       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyFindPublicRootTimeout      :: !DiffTime,
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> Int
policyMaxInProgressPeerShareReqs :: !Int,
       -- ^ Maximum number of peer sharing requests that can be in progress
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPeerShareRetryTime         :: !DiffTime,
       -- ^ Amount of time a node has to wait before issuing a new peer sharing
       -- request
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPeerShareBatchWaitTime     :: !DiffTime,
       -- ^ Amount of time a batch of peer sharing requests is allowed to take
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPeerShareOverallTimeout    :: !DiffTime,
       -- ^ Amount of time the overall batches of peer sharing requests are
       -- allowed to take
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPeerShareActivationDelay   :: !DiffTime,
       -- ^ Delay until we consider a peer suitable for peer sharing

       -- | Re-promote delay, passed from `ExitPolicy`.
       --
       forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyErrorDelay                 :: !DiffTime
     }


-- | Adjustable targets for the peer selection mechanism.
--
-- These are used by the peer selection governor as targets. They are used by
-- the peer churn governor loop as knobs to adjust, to influence the peer
-- selection governor.
--
-- The /known/, /established/ and /active/ peer targets are targets both from
-- below and from above: the governor will attempt to grow or shrink the sets
-- to hit these targets.
--
-- Unlike the other targets, the /root/ peer target is \"one sided\", it is
-- only a target from below. The governor does not try to shrink the root set
-- to hit it, it simply stops looking for more.
--
-- There is also an implicit target that enough local root peers are selected
-- as active. This comes from the configuration for local roots, and is not an
-- independently adjustable target.
--
data PeerSelectionTargets = PeerSelectionTargets {

       PeerSelectionTargets -> Int
targetNumberOfRootPeers                 :: !Int,

       -- | The target number of all known peers.  Doesn't include big ledger peers
       -- |
       PeerSelectionTargets -> Int
targetNumberOfKnownPeers                :: !Int,
       -- | The target number of established peers (does not include big ledger
       -- peers).
       --
       -- The target includes root peers, local root peers, and ledger peers
       --
       PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers          :: !Int,
       -- | The target number of active peers (does not include big ledger
       -- peers).
       --
       PeerSelectionTargets -> Int
targetNumberOfActivePeers               :: !Int,

       -- | Target number of known big ledger peers.
       --
       -- This target is independent of `targetNumberOfKnownPeers`.  The total
       -- number of known peers will be sum of the two targets.
       --
       PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers       :: !Int,
       -- | Target number of established big ledger peers.
       --
       -- This target is independent of `targetNumberOfEstablishedPeers`.  The
       -- total number of established peers will be sum of the two targets and
       -- local root peers.
       --
       PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers :: !Int,
       -- | Target number of active big ledger peers.
       --
       -- This target is independent of `targetNumberOfActivePeers`.  The total
       -- number of active peers will be sum of the two targets and active local
       -- root peers.
       --
       PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers      :: !Int

       -- Expressed as intervals rather than frequencies
--     targetChurnIntervalKnownPeers       :: !DiffTime,
--     targetChurnIntervalEstablishedPeers :: !DiffTime,
--     targetChurnIntervalActivePeers      :: !DiffTime
     }
  deriving (PeerSelectionTargets -> PeerSelectionTargets -> Bool
(PeerSelectionTargets -> PeerSelectionTargets -> Bool)
-> (PeerSelectionTargets -> PeerSelectionTargets -> Bool)
-> Eq PeerSelectionTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerSelectionTargets -> PeerSelectionTargets -> Bool
== :: PeerSelectionTargets -> PeerSelectionTargets -> Bool
$c/= :: PeerSelectionTargets -> PeerSelectionTargets -> Bool
/= :: PeerSelectionTargets -> PeerSelectionTargets -> Bool
Eq, Int -> PeerSelectionTargets -> ShowS
[PeerSelectionTargets] -> ShowS
PeerSelectionTargets -> String
(Int -> PeerSelectionTargets -> ShowS)
-> (PeerSelectionTargets -> String)
-> ([PeerSelectionTargets] -> ShowS)
-> Show PeerSelectionTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerSelectionTargets -> ShowS
showsPrec :: Int -> PeerSelectionTargets -> ShowS
$cshow :: PeerSelectionTargets -> String
show :: PeerSelectionTargets -> String
$cshowList :: [PeerSelectionTargets] -> ShowS
showList :: [PeerSelectionTargets] -> ShowS
Show)

nullPeerSelectionTargets :: PeerSelectionTargets
nullPeerSelectionTargets :: PeerSelectionTargets
nullPeerSelectionTargets =
    PeerSelectionTargets {
       targetNumberOfRootPeers :: Int
targetNumberOfRootPeers        = Int
0,
       targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers       = Int
0,
       targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
0,
       targetNumberOfActivePeers :: Int
targetNumberOfActivePeers      = Int
0,
       targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers       = Int
0,
       targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
       targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers      = Int
0
    }

sanePeerSelectionTargets :: PeerSelectionTargets -> Bool
sanePeerSelectionTargets :: PeerSelectionTargets -> Bool
sanePeerSelectionTargets PeerSelectionTargets{Int
targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers :: Int
targetNumberOfKnownPeers :: Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfActivePeers :: Int
targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers :: Int
..} =
                                 Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfActivePeers
 Bool -> Bool -> Bool
&& Int
targetNumberOfActivePeers      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfEstablishedPeers
 Bool -> Bool -> Bool
&& Int
targetNumberOfEstablishedPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfKnownPeers
 Bool -> Bool -> Bool
&&      Int
targetNumberOfRootPeers   Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfKnownPeers
 Bool -> Bool -> Bool
&&                              Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfRootPeers

 Bool -> Bool -> Bool
&&                                       Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfActiveBigLedgerPeers
 Bool -> Bool -> Bool
&& Int
targetNumberOfActiveBigLedgerPeers      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfEstablishedBigLedgerPeers
 Bool -> Bool -> Bool
&& Int
targetNumberOfEstablishedBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
targetNumberOfKnownBigLedgerPeers

 Bool -> Bool -> Bool
&& Int
targetNumberOfActivePeers      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100
 Bool -> Bool -> Bool
&& Int
targetNumberOfEstablishedPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1000
 Bool -> Bool -> Bool
&& Int
targetNumberOfKnownPeers       Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10000

 Bool -> Bool -> Bool
&& Int
targetNumberOfActiveBigLedgerPeers      Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100
 Bool -> Bool -> Bool
&& Int
targetNumberOfEstablishedBigLedgerPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1000
 Bool -> Bool -> Bool
&& Int
targetNumberOfKnownBigLedgerPeers       Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10000


-- These being pluggable allows:
--
-- * choice of known peer root sets
-- * running both in simulation and for real
--
data PeerSelectionActions extraState extraFlags extraPeers extraAPI extraCounters peeraddr peerconn m =
  PeerSelectionActions {
       -- | These are the targets as seen in the static configuration
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionTargets
peerSelectionTargets :: PeerSelectionTargets,

       -- | Read current Peer Selection Targets these can be changed by Churn
       -- Governor
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> STM m PeerSelectionTargets
readPeerSelectionTargets   :: STM m PeerSelectionTargets,

       -- | Read the original set of locally configured root peers.
       --
       -- This should come from 'ArgumentsExtra' when initializing Diffusion
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> STM m (Config extraFlags RelayAccessPoint)
readLocalRootPeersFromFile :: STM m (LocalRootPeers.Config extraFlags RelayAccessPoint),

       -- | Read the current set of locally or privately known root peers.
       --
       -- In general this is expected to be updated asynchronously by some
       -- other thread. It is intended to cover the use case of peers from
       -- local configuration. It could be dynamic due to DNS resolution, or
       -- due to dynamic configuration updates.
       --
       -- It is structured as a collection of (non-overlapping) groups of peers
       -- where we are supposed to select n from each group.
       --
       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 (LocalRootPeers.Config extraFlags peeraddr),

       -- | Read inbound peers which negotiated duplex connection.
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> m (Map peeraddr PeerSharing)
readInboundPeers       :: m (Map peeraddr PeerSharing),

       -- | Read the current Peer Sharing willingness value
       --
       -- This value comes from the Node's configuration file.
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSharing
peerSharing :: PeerSharing,

       -- | Get the remote's side PeerSharing value from 'peerconn'
       --
       -- 'peerconn' ideally comes from a call to 'establishPeerConnection'.
       -- This will establish a connection and perform handshake. The returned
       -- 'peerconn' has all the versionData negotiated in the handshake,
       -- including the remote peer's 'PeerSharing' willingness information.
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> peerconn -> PeerSharing
peerConnToPeerSharing :: peerconn -> PeerSharing,

       -- | Public Extra Peers Actions
       --
       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,

       -- | Compute extraCounters from PeerSelectionState
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters
         :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
         -> extraCounters,

       -- | Request a sample of public root peers.
       --
       -- It is intended to cover use cases including:
       --
       -- * federated relays from a DNS pool
       -- * Official bootstrap peers from a trusted source
       -- * stake pool relays published in the blockchain
       -- * a pre-distributed snapshot of stake pool relays from the blockchain
       --
       -- It also makes a distinction between normal and big ledger peers to be
       -- fetched.
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> LedgerPeersKind
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
requestPublicRootPeers   :: LedgerPeersKind -> Int -> m (PublicRootPeers extraPeers peeraddr, DiffTime),

       -- | The action to contact a known peer and request a sample of its
       -- known peers.
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSharingAmount -> peeraddr -> m (PeerSharingResult peeraddr)
requestPeerShare       :: PeerSharingAmount -> peeraddr -> m (PeerSharingResult peeraddr),

       -- | Core actions run by the governor to change 'PeerStatus'.
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerStateActions peeraddr peerconn m
peerStateActions       :: PeerStateActions peeraddr peerconn m,

       -- | Read the current ledger state
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> LedgerPeersConsensusInterface extraAPI m
getLedgerStateCtx :: LedgerPeersConsensusInterface extraAPI m,

       -- | Read the current state of ledger peer snapshot
       --
       forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> STM m (Maybe LedgerPeerSnapshot)
readLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
     }

-- | Interfaces required by the peer selection governor, which do not need to
-- be shared with actions and thus are not part of `PeerSelectionActions`.
--
data PeerSelectionInterfaces extraState extraFlags extraPeers extraCounters peeraddr peerconn m =
  PeerSelectionInterfaces {
      -- | PeerSelectionCounters are shared with churn through a `StrictTVar`.
      --
      forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> StrictTVar m (PeerSelectionCounters extraCounters)
countersVar        :: StrictTVar m (PeerSelectionCounters extraCounters),

      -- | PublicPeerSelectionState var.
      --
      forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> StrictTVar m (PublicPeerSelectionState peeraddr)
publicStateVar     :: StrictTVar m (PublicPeerSelectionState peeraddr),

      -- | PeerSelectionState shared for debugging purposes (to support SIGUSR1
      -- debug event tracing)
      --
      forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> StrictTVar
     m
     (PeerSelectionState
        extraState extraFlags extraPeers peeraddr peerconn)
debugStateVar      :: StrictTVar m (PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn),

      -- | `UseLedgerPeers` used by `peerSelectionGovernor` to support
      -- `HiddenRelayOrBP`
      --
      forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> STM m UseLedgerPeers
readUseLedgerPeers :: STM m UseLedgerPeers
  }


-- | Callbacks which are performed to change peer state.
--
data PeerStateActions peeraddr peerconn m = PeerStateActions {
    -- | Monitor peer state.  Must be non-blocking.
    --
    forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m
-> peerconn -> STM m (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection    :: peerconn -> STM m (PeerStatus, Maybe RepromoteDelay),

    -- | Establish new connection: cold to warm.
    --
    -- 'IsBigLedgerPeer' is passed from the outbound governor to the
    -- mini-protocol callbacks.
    --
    forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m
-> IsBigLedgerPeer -> DiffusionMode -> peeraddr -> m peerconn
establishPeerConnection  :: IsBigLedgerPeer
                             -> DiffusionMode
                             -> peeraddr -> m peerconn,

    -- | Activate a connection: warm to hot promotion.
    --
    -- 'IsBigLedgerPeer' is passed from the outbound governor to the
    -- mini-protocol callbacks.
    --
    forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m
-> IsBigLedgerPeer -> peerconn -> m ()
activatePeerConnection   :: IsBigLedgerPeer
                             -> peerconn -> m (),

    -- | Deactive a peer: hot to warm demotion.
    --
    forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m -> peerconn -> m ()
deactivatePeerConnection :: peerconn -> m (),

    -- | Close a connection: warm to cold transition.
    --
    forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m -> peerconn -> m ()
closePeerConnection      :: peerconn -> m ()
  }

-----------------------
-- Extra Guarded Decisions
--
type MonitoringAction extraState extraDebugState extraFlags
                      extraPeers extraAPI extraCounters peeraddr peerconn m =
     PeerSelectionPolicy peeraddr m
  -> PeerSelectionActions
      extraState
      extraFlags
      extraPeers
      extraAPI
      extraCounters
      peeraddr
      peerconn
      m
  -> PeerSelectionState
      extraState
      extraFlags
      extraPeers
      peeraddr
      peerconn
  -> Guarded (STM m)
            (TimedDecision m extraState extraDebugState extraFlags extraPeers
                           peeraddr peerconn)

data ExtraGuardedDecisions extraState extraDebugState extraFlags
                           extraPeers extraAPI extraCounters peeraddr peerconn m =
  ExtraGuardedDecisions {

    -- | This guarded decision will come before all default possibly
    -- blocking decisions. The order matters; first decisions have
    -- priority over the later ones.
    --
    -- Note that this action should be blocking.
    forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
preBlocking
      :: MonitoringAction extraState extraDebugState extraFlags
                          extraPeers extraAPI extraCounters peeraddr peerconn m

    -- | This guarded decision will come after all possibly preBlocking
    -- and default blocking decisions. The order matters; first decisions
    -- have priority over the later ones.
    --
    -- Note that these actions can be either blocking or non-blocking.
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
postBlocking
      :: MonitoringAction extraState extraDebugState extraFlags
                          extraPeers extraAPI extraCounters peeraddr peerconn m

    -- | This guarded decision will come before all default non-blocking
    -- decisions. The order matters; first decisions have priority over
    -- the later ones.
    --
    -- Note that these actions should not be blocking.
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
postNonBlocking
      :: MonitoringAction extraState extraDebugState extraFlags
                          extraPeers extraAPI extraCounters peeraddr peerconn m

    -- | This action is necessary to the well functioning of the Outbound
    -- Governor. In particular this action should monitor 'PeerSelectionTargets',
    -- if they change, update 'PeerSelectionState' accordingly.
    --
    -- Customization of this monitoring action is allowed since a 3rd party
    -- user might require more granular control over the targets of its
    -- Outbound Governor.
    --
    -- If no custom action is required (i.e. Nothing) a default will be provided by
    -- 'Ouroboros.Network.PeerSelection.Governor.Monitor.targetPeers'
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Maybe
     (MonitoringAction
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraAPI
        extraCounters
        peeraddr
        peerconn
        m)
customTargetsAction
      :: Maybe (MonitoringAction extraState extraDebugState
                                 extraFlags extraPeers extraAPI extraCounters
                                 peeraddr peerconn m)

    -- | This action is necessary to the well functioning of the Outbound
    -- Governor. In particular this action should monitor Monitor local roots
    -- using 'readLocalRootPeers' 'STM' action.
    --
    -- Customization of this monitoring action is allowed since a 3rd party
    -- user might require more granular control over the local roots of its
    -- Outbound Governor, according to 'extraFlags' for example.
    --
    -- If no custom action is required (i.e. Nothing) a default provided by
    -- 'Ouroboros.Network.PeerSelection.Governor.Monitor.localRoots'
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Maybe
     (MonitoringAction
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraAPI
        extraCounters
        peeraddr
        peerconn
        m)
customLocalRootsAction
      :: Maybe (MonitoringAction extraState extraDebugState
                                 extraFlags extraPeers extraAPI extraCounters
                                 peeraddr peerconn m)

    -- | This enables third party users to add extra guards to the following monitoring
    -- actions that make progress towards targets:
    --
    -- * BigLedgerPeers.belowTarget
    -- * KnownPeers.belowTarget
    -- * EstablishedPeers.belowTargetBigLedgerPeers
    -- * ActivePeers.belowTargetBigLedgerPeers
    --
    -- This might be useful if the user requires its diffusion layer to stop
    -- making progress during a sensitive/vulnerable situation and quarantine
    -- it and make sure it is only connected to trusted peers.
    --
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> extraState -> Bool
enableProgressMakingActions :: extraState -> Bool

    -- | This can safely be left as 'id'. This parameter is an artifact of the
    -- process of making the diffusion layer reusable. This function allows a
    -- constant 'extraState' change after a successfull ledger peer snapshot
    -- change.
    --
    -- TODO: Come up with a better solution (Issue #5065)
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> extraState -> extraState
ledgerPeerSnapshotExtraStateChange :: extraState -> extraState
  }

-----------------------
-- Peer Selection Arguments
--

data PeerSelectionGovernorArgs extraState extraDebugState extraFlags
                               extraPeers extraAPI extraCounters peeraddr peerconn
                               exception m =
  PeerSelectionGovernorArgs {
    forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn exception (m :: * -> *).
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Maybe exception
abortGovernor
      :: Time
      -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
      -> Maybe exception
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn exception (m :: * -> *).
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionSetsWithSizes extraCounters peeraddr
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> STM m ()
updateWithState
      :: PeerSelectionInterfaces extraState extraFlags extraPeers extraCounters peeraddr peerconn m
      -> PeerSelectionActions extraState extraFlags extraPeers extraAPI extraCounters peeraddr peerconn m
      -> PeerSelectionSetsWithSizes extraCounters peeraddr
      -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
      -> STM m ()
  , forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn exception (m :: * -> *).
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
-> ExtraGuardedDecisions
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
extraDecisions
      :: ExtraGuardedDecisions extraState extraDebugState extraFlags
                               extraPeers extraAPI extraCounters peeraddr peerconn m
  }

-----------------------
-- Peer Selection State
--

-- | The internal state used by the 'peerSelectionGovernor'.
--
-- The local and public root sets are disjoint, and their union is the
-- overall root set.
--
-- Documentation of individual fields describes some of the invariants these
-- structures should maintain. For the entire picture, see
-- 'assertPeerSelectionState'.
--
data PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn =
  PeerSelectionState {
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
targets                     :: !PeerSelectionTargets,

    -- | The current set of local root peers. This is structured as a
    -- bunch of groups, with a target for each group. This gives us a set of
    -- n-of-m choices, e.g. \"pick 2 from this group and 1 from this group\".
    --
    -- The targets must of course be achievable, and to keep things simple,
    -- the groups must be disjoint.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers              :: !(LocalRootPeers extraFlags peeraddr),

    -- | This set holds the public root peers (i.e. Ledger (small and big),
    -- Bootstrap peers and locally configured public root peers).
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers             :: !(PublicRootPeers extraPeers peeraddr),

    -- | Known peers.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers                  :: !(KnownPeers peeraddr),

    -- | Established peers.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers            :: !(EstablishedPeers peeraddr peerconn),

    -- | Active peers.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
activePeers                 :: !(Set peeraddr),

    -- | A counter to manage the exponential backoff strategy for when to
    -- retry querying for more public root peers. It is negative for retry
    -- counts after failure, and positive for retry counts that are
    -- successful but make no progress.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
publicRootBackoffs          :: !Int,

    -- | The earliest time we would be prepared to request more public root
    -- peers. This is used with the 'publicRootBackoffs' to manage the
    -- exponential backoff.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
publicRootRetryTime         :: !Time,

    -- | Whether a request for more public root peers is in progress.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressPublicRootsReq    :: !Bool,

    -- | A counter to manage the exponential backoff strategy for when to
    -- retry querying for more public root peers. It is negative for retry
    -- counts after failure, and positive for retry counts that are
    -- successful but make no progress.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
bigLedgerPeerBackoffs       :: !Int,

    -- | The earliest time we would be prepared to request more big ledger
    -- peers. This is used with the 'bigLedgerPeerBackoffs' to manage the
    -- exponential backoff.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
bigLedgerPeerRetryTime      :: !Time,

    -- | Whether a request for more big ledger peers is in progress.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressBigLedgerPeersReq :: !Bool,

    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
inProgressPeerShareReqs     :: !Int,
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteCold       :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm       :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteWarm        :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteHot         :: !(Set peeraddr),

    -- | Peers that had an async demotion and their connections are still
    -- being closed
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteToCold      :: !(Set peeraddr),

    -- | Rng for fuzzy delays and random choices.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> StdGen
stdGen                      :: !StdGen,

    -- | Time to query of inbound peers time.
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
inboundPeersRetryTime       :: !Time,

    -- | Internal state of ledger peer snapshot
    --
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Maybe LedgerPeerSnapshot
ledgerPeerSnapshot          :: Maybe LedgerPeerSnapshot,

    -- | Extension point so that 3rd party users can plug their own peer
    -- selection state if needed
    forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
extraState                  :: extraState

--     TODO: need something like this to distinguish between lots of bad peers
--     and us getting disconnected from the network locally. We don't want a
--     network disconnect to cause us to flush our full known peer set by
--     considering them all to have bad connectivity.
--     Should also take account of DNS failures for root peer set.
--     lastSuccessfulNetworkEvent :: Time
    } deriving Int
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> ShowS
[PeerSelectionState
   extraState extraFlags extraPeers peeraddr peerconn]
-> ShowS
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> String
(Int
 -> PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
 -> ShowS)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> String)
-> ([PeerSelectionState
       extraState extraFlags extraPeers peeraddr peerconn]
    -> ShowS)
-> Show
     (PeerSelectionState
        extraState extraFlags extraPeers peeraddr peerconn)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extraState extraFlags extraPeers peeraddr peerconn.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show peerconn, Show extraState) =>
Int
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> ShowS
forall extraState extraFlags extraPeers peeraddr peerconn.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show peerconn, Show extraState) =>
[PeerSelectionState
   extraState extraFlags extraPeers peeraddr peerconn]
-> ShowS
forall extraState extraFlags extraPeers peeraddr peerconn.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show peerconn, Show extraState) =>
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> String
$cshowsPrec :: forall extraState extraFlags extraPeers peeraddr peerconn.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show peerconn, Show extraState) =>
Int
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> ShowS
showsPrec :: Int
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> ShowS
$cshow :: forall extraState extraFlags extraPeers peeraddr peerconn.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show peerconn, Show extraState) =>
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> String
show :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> String
$cshowList :: forall extraState extraFlags extraPeers peeraddr peerconn.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show peerconn, Show extraState) =>
[PeerSelectionState
   extraState extraFlags extraPeers peeraddr peerconn]
-> ShowS
showList :: [PeerSelectionState
   extraState extraFlags extraPeers peeraddr peerconn]
-> ShowS
Show

-- | A node is classified as `LocalRootsOnly` if it is a hidden relay or
-- a BP, e.g. if it is configured such that it can only have a chance to be
-- connected to local roots. This is true if the node is configured in one of
-- two ways:
--
-- * `DontUseBootstrapPeers`, `DontUseLedgerPeers` and
--   `PeerSharingDisabled`; or
-- * `UseBootstrapPeers`, `DontUseLedgerPeers` and
--   `PeerSharingDisabled`, but it's not using any bootstrap peers (i.e. it is
--   synced).
--
-- Note that in the second case a node might transition between `LocalRootsOnly`
-- and `Unrestricted` modes, depending on `LedgerStateJudgement`.
--
-- See `Ouroboros.Network.PeerSelection.Governor.readAssociationMode`.
--
data AssociationMode =
     LocalRootsOnly
   | Unrestricted
  deriving Int -> AssociationMode -> ShowS
[AssociationMode] -> ShowS
AssociationMode -> String
(Int -> AssociationMode -> ShowS)
-> (AssociationMode -> String)
-> ([AssociationMode] -> ShowS)
-> Show AssociationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssociationMode -> ShowS
showsPrec :: Int -> AssociationMode -> ShowS
$cshow :: AssociationMode -> String
show :: AssociationMode -> String
$cshowList :: [AssociationMode] -> ShowS
showList :: [AssociationMode] -> ShowS
Show

-----------------------
-- Debug copy of Peer Selection State
--
-- Used for dumping the peer selection state upon getting a USR1 signal.
--
data DebugPeerSelectionState extraState extraFlags extraPeers peeraddr =
  DebugPeerSelectionState {
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> PeerSelectionTargets
dpssTargets                     :: !PeerSelectionTargets,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> LocalRootPeers extraFlags peeraddr
dpssLocalRootPeers              :: !(LocalRootPeers extraFlags peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
dpssPublicRootPeers             :: !(PublicRootPeers extraPeers peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> KnownPeers peeraddr
dpssKnownPeers                  :: !(KnownPeers peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssEstablishedPeers            :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssActivePeers                 :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Int
dpssPublicRootBackoffs          :: !Int,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Time
dpssPublicRootRetryTime         :: !Time,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Bool
dpssInProgressPublicRootsReq    :: !Bool,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Int
dpssBigLedgerPeerBackoffs       :: !Int,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Time
dpssBigLedgerPeerRetryTime      :: !Time,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Bool
dpssInProgressBigLedgerPeersReq :: !Bool,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Int
dpssInProgressPeerShareReqs     :: !Int,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssInProgressPromoteCold       :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssInProgressPromoteWarm       :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssInProgressDemoteWarm        :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssInProgressDemoteHot         :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Set peeraddr
dpssInProgressDemoteToCold      :: !(Set peeraddr),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Map peeraddr Int
dpssUpstreamyness               :: !(Map peeraddr Int),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> Map peeraddr Int
dpssFetchynessBlocks            :: !(Map peeraddr Int),
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> AssociationMode
dpssAssociationMode             :: !AssociationMode,
    forall extraState extraFlags extraPeers peeraddr.
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> extraState
dpssExtraState                  :: !extraState
  } deriving Int
-> DebugPeerSelectionState
     extraState extraFlags extraPeers peeraddr
-> ShowS
[DebugPeerSelectionState extraState extraFlags extraPeers peeraddr]
-> ShowS
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> String
(Int
 -> DebugPeerSelectionState
      extraState extraFlags extraPeers peeraddr
 -> ShowS)
-> (DebugPeerSelectionState
      extraState extraFlags extraPeers peeraddr
    -> String)
-> ([DebugPeerSelectionState
       extraState extraFlags extraPeers peeraddr]
    -> ShowS)
-> Show
     (DebugPeerSelectionState extraState extraFlags extraPeers peeraddr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extraState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show extraState) =>
Int
-> DebugPeerSelectionState
     extraState extraFlags extraPeers peeraddr
-> ShowS
forall extraState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show extraState) =>
[DebugPeerSelectionState extraState extraFlags extraPeers peeraddr]
-> ShowS
forall extraState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show extraState) =>
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> String
$cshowsPrec :: forall extraState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show extraState) =>
Int
-> DebugPeerSelectionState
     extraState extraFlags extraPeers peeraddr
-> ShowS
showsPrec :: Int
-> DebugPeerSelectionState
     extraState extraFlags extraPeers peeraddr
-> ShowS
$cshow :: forall extraState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show extraState) =>
DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> String
show :: DebugPeerSelectionState extraState extraFlags extraPeers peeraddr
-> String
$cshowList :: forall extraState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show peeraddr, Show extraPeers,
 Show extraState) =>
[DebugPeerSelectionState extraState extraFlags extraPeers peeraddr]
-> ShowS
showList :: [DebugPeerSelectionState extraState extraFlags extraPeers peeraddr]
-> ShowS
Show

makeDebugPeerSelectionState
  :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
  -> Map peeraddr Int
  -> Map peeraddr Int
  -> extraDebugState
  -> AssociationMode
  -> DebugPeerSelectionState extraDebugState extraFlags extraPeers peeraddr
makeDebugPeerSelectionState :: forall extraState extraFlags extraPeers peeraddr peerconn
       extraDebugState.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Map peeraddr Int
-> Map peeraddr Int
-> extraDebugState
-> AssociationMode
-> DebugPeerSelectionState
     extraDebugState extraFlags extraPeers peeraddr
makeDebugPeerSelectionState PeerSelectionState {extraState
Bool
Int
Maybe LedgerPeerSnapshot
StdGen
Set peeraddr
Time
EstablishedPeers peeraddr peerconn
KnownPeers peeraddr
LocalRootPeers extraFlags peeraddr
PublicRootPeers extraPeers peeraddr
PeerSelectionTargets
extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
establishedPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
activePeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
publicRootBackoffs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
publicRootRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
inProgressPublicRootsReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
bigLedgerPeerBackoffs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
bigLedgerPeerRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
inProgressBigLedgerPeersReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressPeerShareReqs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
inProgressPromoteCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteHot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteToCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
stdGen :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> StdGen
inboundPeersRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
ledgerPeerSnapshot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Maybe LedgerPeerSnapshot
targets :: PeerSelectionTargets
localRootPeers :: LocalRootPeers extraFlags peeraddr
publicRootPeers :: PublicRootPeers extraPeers peeraddr
knownPeers :: KnownPeers peeraddr
establishedPeers :: EstablishedPeers peeraddr peerconn
activePeers :: Set peeraddr
publicRootBackoffs :: Int
publicRootRetryTime :: Time
inProgressPublicRootsReq :: Bool
bigLedgerPeerBackoffs :: Int
bigLedgerPeerRetryTime :: Time
inProgressBigLedgerPeersReq :: Bool
inProgressPeerShareReqs :: Int
inProgressPromoteCold :: Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteToCold :: Set peeraddr
stdGen :: StdGen
inboundPeersRetryTime :: Time
ledgerPeerSnapshot :: Maybe LedgerPeerSnapshot
extraState :: extraState
..} Map peeraddr Int
up Map peeraddr Int
bp extraDebugState
es AssociationMode
am =
  DebugPeerSelectionState {
      dpssTargets :: PeerSelectionTargets
dpssTargets                     = PeerSelectionTargets
targets
    , dpssLocalRootPeers :: LocalRootPeers extraFlags peeraddr
dpssLocalRootPeers              = LocalRootPeers extraFlags peeraddr
localRootPeers
    , dpssPublicRootPeers :: PublicRootPeers extraPeers peeraddr
dpssPublicRootPeers             = PublicRootPeers extraPeers peeraddr
publicRootPeers
    , dpssKnownPeers :: KnownPeers peeraddr
dpssKnownPeers                  = KnownPeers peeraddr
knownPeers
    , dpssEstablishedPeers :: Set peeraddr
dpssEstablishedPeers            = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers
    , dpssActivePeers :: Set peeraddr
dpssActivePeers                 = Set peeraddr
activePeers
    , dpssPublicRootBackoffs :: Int
dpssPublicRootBackoffs          = Int
publicRootBackoffs
    , dpssPublicRootRetryTime :: Time
dpssPublicRootRetryTime         = Time
publicRootRetryTime
    , dpssInProgressPublicRootsReq :: Bool
dpssInProgressPublicRootsReq    = Bool
inProgressPublicRootsReq
    , dpssBigLedgerPeerBackoffs :: Int
dpssBigLedgerPeerBackoffs       = Int
bigLedgerPeerBackoffs
    , dpssBigLedgerPeerRetryTime :: Time
dpssBigLedgerPeerRetryTime      = Time
bigLedgerPeerRetryTime
    , dpssInProgressBigLedgerPeersReq :: Bool
dpssInProgressBigLedgerPeersReq = Bool
inProgressBigLedgerPeersReq
    , dpssInProgressPeerShareReqs :: Int
dpssInProgressPeerShareReqs     = Int
inProgressPeerShareReqs
    , dpssInProgressPromoteCold :: Set peeraddr
dpssInProgressPromoteCold       = Set peeraddr
inProgressPromoteCold
    , dpssInProgressPromoteWarm :: Set peeraddr
dpssInProgressPromoteWarm       = Set peeraddr
inProgressPromoteWarm
    , dpssInProgressDemoteWarm :: Set peeraddr
dpssInProgressDemoteWarm        = Set peeraddr
inProgressDemoteWarm
    , dpssInProgressDemoteHot :: Set peeraddr
dpssInProgressDemoteHot         = Set peeraddr
inProgressDemoteHot
    , dpssInProgressDemoteToCold :: Set peeraddr
dpssInProgressDemoteToCold      = Set peeraddr
inProgressDemoteToCold
    , dpssUpstreamyness :: Map peeraddr Int
dpssUpstreamyness               = Map peeraddr Int
up
    , dpssFetchynessBlocks :: Map peeraddr Int
dpssFetchynessBlocks            = Map peeraddr Int
bp
    , dpssAssociationMode :: AssociationMode
dpssAssociationMode             = AssociationMode
am
    , dpssExtraState :: extraDebugState
dpssExtraState                  = extraDebugState
es
  }

-- | Public 'PeerSelectionState' that can be accessed by Peer Sharing
-- mechanisms without any problem.
--
-- This data type should not expose too much information and keep only
-- essential data needed for computing the peer sharing request result
--
newtype PublicPeerSelectionState peeraddr =
  PublicPeerSelectionState {
    forall peeraddr. PublicPeerSelectionState peeraddr -> Set peeraddr
availableToShare :: Set peeraddr
  }

emptyPublicPeerSelectionState :: Ord peeraddr
                              => PublicPeerSelectionState peeraddr
emptyPublicPeerSelectionState :: forall peeraddr. Ord peeraddr => PublicPeerSelectionState peeraddr
emptyPublicPeerSelectionState =
  PublicPeerSelectionState {
    availableToShare :: Set peeraddr
availableToShare = Set peeraddr
forall a. Monoid a => a
mempty
  }

makePublicPeerSelectionStateVar
 :: (MonadSTM m, Ord peeraddr)
 => m (StrictTVar m (PublicPeerSelectionState peeraddr))
makePublicPeerSelectionStateVar :: forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
m (StrictTVar m (PublicPeerSelectionState peeraddr))
makePublicPeerSelectionStateVar = PublicPeerSelectionState peeraddr
-> m (StrictTVar m (PublicPeerSelectionState peeraddr))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO PublicPeerSelectionState peeraddr
forall peeraddr. Ord peeraddr => PublicPeerSelectionState peeraddr
emptyPublicPeerSelectionState


-- | Convert a 'PeerSelectionState' into a public record accessible by the
-- Peer Sharing mechanisms so we can know about which peers are available and
-- possibly other needed context.
--
toPublicState :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
              -> PublicPeerSelectionState peeraddr
toPublicState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicPeerSelectionState peeraddr
toPublicState PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers } =
   PublicPeerSelectionState {
     availableToShare :: Set peeraddr
availableToShare =
       KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.getPeerSharingResponsePeers KnownPeers peeraddr
knownPeers
   }

-- | Peer selection view.
--
-- This is a functor which is used to hold computation of various peer sets and
-- their sizes.  See `peerSelectionStateToView`, `peerSelectionStateToCounters`.
--
data PeerSelectionView extraViews a = PeerSelectionView {
      forall extraViews a. PeerSelectionView extraViews a -> a
viewRootPeers                        :: a,

      --
      -- Non Big Ledger Peers
      --

      forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownPeers                       :: a,
      -- ^ number of known peers excluding big ledger peers
      forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectPeers          :: a,
      -- ^ number of known peers available to connect
      forall extraViews a. PeerSelectionView extraViews a -> a
viewColdPeersPromotions              :: a,
      -- ^ number of known peers (excluding big ledger peers) being promoted to
      -- warm
      forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedPeers                 :: a,
      -- ^ number of established peers excluding big ledger peers
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmPeersDemotions               :: a,
      -- ^ number of warm peers (excluding big ledger peers) being demoted to
      -- cold
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmPeersPromotions              :: a,
      -- ^ number of warm peers (excluding big ledger peers) being promote to
      -- hot
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActivePeers                      :: a,
      -- ^ number of active peers excluding big ledger peers
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActivePeersDemotions             :: a,
      -- ^ number of active peers (excluding big ledger peers) being demoted to
      -- warm

      --
      -- Big Ledger Peers
      --

      forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownBigLedgerPeers              :: a,
      -- ^ number of known big ledger peers
      forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectBigLedgerPeers :: a,
      -- ^ number of known big ledger peers available to connect
      forall extraViews a. PeerSelectionView extraViews a -> a
viewColdBigLedgerPeersPromotions     :: a,
      -- ^ number of cold big ledger peers being promoted to warm
      forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedBigLedgerPeers        :: a,
      -- ^ number of established big ledger peers
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmBigLedgerPeersDemotions      :: a,
      -- ^ number of warm big ledger peers being demoted to cold
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmBigLedgerPeersPromotions     :: a,
      -- ^ number of warm big ledger peers being promote to hot
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveBigLedgerPeers             :: a,
      -- ^ number of active big ledger peers
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveBigLedgerPeersDemotions    :: a,
      -- ^ number of active big ledger peers being demoted to warm

      --
      -- Local Roots
      --

      forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownLocalRootPeers              :: a,
      -- ^ number of known local root peers should always be equal to the sum
      -- of established & active local roots.
      forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectLocalRootPeers :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewColdLocalRootPeersPromotions     :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedLocalRootPeers        :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmLocalRootPeersPromotions     :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveLocalRootPeers             :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveLocalRootPeersDemotions    :: a,

      --
      -- Non-Root Peers
      --

      forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownNonRootPeers                 :: a,
      -- ^ number of known non root peers.  These are mostly peers received
      -- through peer sharing (or light peer sharing); but also will contains
      -- peers which used to be local roots after a reconfiguration.
      forall extraViews a. PeerSelectionView extraViews a -> a
viewColdNonRootPeersPromotions        :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedNonRootPeers           :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmNonRootPeersDemotions         :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmNonRootPeersPromotions        :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveNonRootPeers                :: a,
      forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveNonRootPeersDemotions       :: a,

      forall extraViews a. PeerSelectionView extraViews a -> extraViews
viewExtraViews :: extraViews
    } deriving (PeerSelectionView extraViews a
-> PeerSelectionView extraViews a -> Bool
(PeerSelectionView extraViews a
 -> PeerSelectionView extraViews a -> Bool)
-> (PeerSelectionView extraViews a
    -> PeerSelectionView extraViews a -> Bool)
-> Eq (PeerSelectionView extraViews a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall extraViews a.
(Eq a, Eq extraViews) =>
PeerSelectionView extraViews a
-> PeerSelectionView extraViews a -> Bool
$c== :: forall extraViews a.
(Eq a, Eq extraViews) =>
PeerSelectionView extraViews a
-> PeerSelectionView extraViews a -> Bool
== :: PeerSelectionView extraViews a
-> PeerSelectionView extraViews a -> Bool
$c/= :: forall extraViews a.
(Eq a, Eq extraViews) =>
PeerSelectionView extraViews a
-> PeerSelectionView extraViews a -> Bool
/= :: PeerSelectionView extraViews a
-> PeerSelectionView extraViews a -> Bool
Eq, (forall a b.
 (a -> b)
 -> PeerSelectionView extraViews a
 -> PeerSelectionView extraViews b)
-> (forall a b.
    a
    -> PeerSelectionView extraViews b
    -> PeerSelectionView extraViews a)
-> Functor (PeerSelectionView extraViews)
forall a b.
a
-> PeerSelectionView extraViews b -> PeerSelectionView extraViews a
forall a b.
(a -> b)
-> PeerSelectionView extraViews a -> PeerSelectionView extraViews b
forall extraViews a b.
a
-> PeerSelectionView extraViews b -> PeerSelectionView extraViews a
forall extraViews a b.
(a -> b)
-> PeerSelectionView extraViews a -> PeerSelectionView extraViews b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall extraViews a b.
(a -> b)
-> PeerSelectionView extraViews a -> PeerSelectionView extraViews b
fmap :: forall a b.
(a -> b)
-> PeerSelectionView extraViews a -> PeerSelectionView extraViews b
$c<$ :: forall extraViews a b.
a
-> PeerSelectionView extraViews b -> PeerSelectionView extraViews a
<$ :: forall a b.
a
-> PeerSelectionView extraViews b -> PeerSelectionView extraViews a
Functor, Int -> PeerSelectionView extraViews a -> ShowS
[PeerSelectionView extraViews a] -> ShowS
PeerSelectionView extraViews a -> String
(Int -> PeerSelectionView extraViews a -> ShowS)
-> (PeerSelectionView extraViews a -> String)
-> ([PeerSelectionView extraViews a] -> ShowS)
-> Show (PeerSelectionView extraViews a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extraViews a.
(Show a, Show extraViews) =>
Int -> PeerSelectionView extraViews a -> ShowS
forall extraViews a.
(Show a, Show extraViews) =>
[PeerSelectionView extraViews a] -> ShowS
forall extraViews a.
(Show a, Show extraViews) =>
PeerSelectionView extraViews a -> String
$cshowsPrec :: forall extraViews a.
(Show a, Show extraViews) =>
Int -> PeerSelectionView extraViews a -> ShowS
showsPrec :: Int -> PeerSelectionView extraViews a -> ShowS
$cshow :: forall extraViews a.
(Show a, Show extraViews) =>
PeerSelectionView extraViews a -> String
show :: PeerSelectionView extraViews a -> String
$cshowList :: forall extraViews a.
(Show a, Show extraViews) =>
[PeerSelectionView extraViews a] -> ShowS
showList :: [PeerSelectionView extraViews a] -> ShowS
Show)


type PeerSelectionCounters extraCounters = PeerSelectionView extraCounters Int
pattern PeerSelectionCounters
          :: Int
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int
          -> extraCounters
          -> PeerSelectionCounters extraCounters
pattern $bPeerSelectionCounters :: forall extraCounters.
Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> extraCounters
-> PeerSelectionCounters extraCounters
$mPeerSelectionCounters :: forall {r} {extraCounters}.
PeerSelectionCounters extraCounters
-> (Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> extraCounters
    -> r)
-> ((# #) -> r)
-> r
PeerSelectionCounters {
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfRootPeers,

      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfAvailableToConnectPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmPeersDemotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActivePeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActivePeersDemotions,

      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownBigLedgerPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfAvailableToConnectBigLedgerPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdBigLedgerPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedBigLedgerPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmBigLedgerPeersDemotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmBigLedgerPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveBigLedgerPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveBigLedgerPeersDemotions,

      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownLocalRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfAvailableToConnectLocalRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdLocalRootPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedLocalRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmLocalRootPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveLocalRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveLocalRootPeersDemotions,

      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownNonRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdNonRootPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedNonRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmNonRootPeersDemotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmNonRootPeersPromotions,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveNonRootPeers,
      forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveNonRootPeersDemotions,

      forall extraCounters.
PeerSelectionCounters extraCounters -> extraCounters
extraCounters
    }
  =
  PeerSelectionView {
      viewRootPeers                        = numberOfRootPeers,

      viewKnownPeers                       = numberOfKnownPeers,
      viewAvailableToConnectPeers          = numberOfAvailableToConnectPeers,
      viewColdPeersPromotions              = numberOfColdPeersPromotions,
      viewEstablishedPeers                 = numberOfEstablishedPeers,
      viewWarmPeersDemotions               = numberOfWarmPeersDemotions,
      viewWarmPeersPromotions              = numberOfWarmPeersPromotions,
      viewActivePeers                      = numberOfActivePeers,
      viewActivePeersDemotions             = numberOfActivePeersDemotions,

      viewKnownBigLedgerPeers              = numberOfKnownBigLedgerPeers,
      viewAvailableToConnectBigLedgerPeers = numberOfAvailableToConnectBigLedgerPeers,
      viewColdBigLedgerPeersPromotions     = numberOfColdBigLedgerPeersPromotions,
      viewEstablishedBigLedgerPeers        = numberOfEstablishedBigLedgerPeers,
      viewWarmBigLedgerPeersDemotions      = numberOfWarmBigLedgerPeersDemotions,
      viewWarmBigLedgerPeersPromotions     = numberOfWarmBigLedgerPeersPromotions,
      viewActiveBigLedgerPeers             = numberOfActiveBigLedgerPeers,
      viewActiveBigLedgerPeersDemotions    = numberOfActiveBigLedgerPeersDemotions,

      viewKnownLocalRootPeers              = numberOfKnownLocalRootPeers,
      viewAvailableToConnectLocalRootPeers = numberOfAvailableToConnectLocalRootPeers,
      viewColdLocalRootPeersPromotions     = numberOfColdLocalRootPeersPromotions,
      viewEstablishedLocalRootPeers        = numberOfEstablishedLocalRootPeers,
      viewWarmLocalRootPeersPromotions     = numberOfWarmLocalRootPeersPromotions,
      viewActiveLocalRootPeers             = numberOfActiveLocalRootPeers,
      viewActiveLocalRootPeersDemotions    = numberOfActiveLocalRootPeersDemotions,

      viewKnownNonRootPeers                 = numberOfKnownNonRootPeers,
      viewColdNonRootPeersPromotions        = numberOfColdNonRootPeersPromotions,
      viewEstablishedNonRootPeers           = numberOfEstablishedNonRootPeers,
      viewWarmNonRootPeersDemotions         = numberOfWarmNonRootPeersDemotions,
      viewWarmNonRootPeersPromotions        = numberOfWarmNonRootPeersPromotions,
      viewActiveNonRootPeers                = numberOfActiveNonRootPeers,
      viewActiveNonRootPeersDemotions       = numberOfActiveNonRootPeersDemotions,

      viewExtraViews = extraCounters
    }

{-# COMPLETE PeerSelectionCounters #-}

type PeerSelectionSetsWithSizes extraViews peeraddr = PeerSelectionView extraViews (Set peeraddr, Int)

-- | A Pattern synonym which computes `hot`, `warm`, `cold` counters from
-- `PeerSelectionCounters`.
--
pattern PeerSelectionCountersHWC :: Int -> Int -> Int -- peers
                                 -> Int -> Int -> Int -- big ledger peers
                                 -> Int -> Int -> Int -- local roots
                                 -> PeerSelectionCounters extraCounters
pattern $mPeerSelectionCountersHWC :: forall {r} {extraCounters}.
PeerSelectionCounters extraCounters
-> (Int
    -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> r)
-> ((# #) -> r)
-> r
PeerSelectionCountersHWC { forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdPeers,
                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmPeers,
                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfHotPeers,

                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdBigLedgerPeers,
                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmBigLedgerPeers,
                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfHotBigLedgerPeers,

                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdLocalRootPeers,
                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmLocalRootPeers,
                                   forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfHotLocalRootPeers }

        <- (peerSelectionCountersHWC ->
             PeerSelectionView { viewKnownPeers                = numberOfColdPeers,
                                 viewEstablishedPeers          = numberOfWarmPeers,
                                 viewActivePeers               = numberOfHotPeers,

                                 viewKnownBigLedgerPeers       = numberOfColdBigLedgerPeers,
                                 viewEstablishedBigLedgerPeers = numberOfWarmBigLedgerPeers,
                                 viewActiveBigLedgerPeers      = numberOfHotBigLedgerPeers,

                                 viewKnownLocalRootPeers       = numberOfColdLocalRootPeers,
                                 viewEstablishedLocalRootPeers = numberOfWarmLocalRootPeers,
                                 viewActiveLocalRootPeers      = numberOfHotLocalRootPeers
                               })

{-# COMPLETE PeerSelectionCountersHWC #-}


-- | Internal function; used to implement `PeerSelectionCountersHWC` pattern synonym.
--
peerSelectionCountersHWC :: PeerSelectionCounters extraCounters -> PeerSelectionCounters extraCounters
peerSelectionCountersHWC :: forall extraCounters.
PeerSelectionCounters extraCounters
-> PeerSelectionCounters extraCounters
peerSelectionCountersHWC PeerSelectionCounters {extraCounters
Int
numberOfRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfAvailableToConnectPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmPeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActivePeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActivePeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfAvailableToConnectBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdBigLedgerPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmBigLedgerPeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmBigLedgerPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveBigLedgerPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveBigLedgerPeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownLocalRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfAvailableToConnectLocalRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdLocalRootPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedLocalRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmLocalRootPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveLocalRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveLocalRootPeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfKnownNonRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfColdNonRootPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfEstablishedNonRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmNonRootPeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfWarmNonRootPeersPromotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveNonRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfActiveNonRootPeersDemotions :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
extraCounters :: forall extraCounters.
PeerSelectionCounters extraCounters -> extraCounters
numberOfRootPeers :: Int
numberOfKnownPeers :: Int
numberOfAvailableToConnectPeers :: Int
numberOfColdPeersPromotions :: Int
numberOfEstablishedPeers :: Int
numberOfWarmPeersDemotions :: Int
numberOfWarmPeersPromotions :: Int
numberOfActivePeers :: Int
numberOfActivePeersDemotions :: Int
numberOfKnownBigLedgerPeers :: Int
numberOfAvailableToConnectBigLedgerPeers :: Int
numberOfColdBigLedgerPeersPromotions :: Int
numberOfEstablishedBigLedgerPeers :: Int
numberOfWarmBigLedgerPeersDemotions :: Int
numberOfWarmBigLedgerPeersPromotions :: Int
numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeersDemotions :: Int
numberOfKnownLocalRootPeers :: Int
numberOfAvailableToConnectLocalRootPeers :: Int
numberOfColdLocalRootPeersPromotions :: Int
numberOfEstablishedLocalRootPeers :: Int
numberOfWarmLocalRootPeersPromotions :: Int
numberOfActiveLocalRootPeers :: Int
numberOfActiveLocalRootPeersDemotions :: Int
numberOfKnownNonRootPeers :: Int
numberOfColdNonRootPeersPromotions :: Int
numberOfEstablishedNonRootPeers :: Int
numberOfWarmNonRootPeersDemotions :: Int
numberOfWarmNonRootPeersPromotions :: Int
numberOfActiveNonRootPeers :: Int
numberOfActiveNonRootPeersDemotions :: Int
extraCounters :: extraCounters
..} =
    PeerSelectionCounters {
      Int
numberOfRootPeers :: Int
numberOfRootPeers :: Int
numberOfRootPeers,

      numberOfKnownPeers :: Int
numberOfKnownPeers                         = Int
numberOfKnownPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfEstablishedPeers,
      Int
numberOfAvailableToConnectPeers :: Int
numberOfAvailableToConnectPeers :: Int
numberOfAvailableToConnectPeers,
      Int
numberOfColdPeersPromotions :: Int
numberOfColdPeersPromotions :: Int
numberOfColdPeersPromotions,
      numberOfEstablishedPeers :: Int
numberOfEstablishedPeers                   = Int
numberOfEstablishedPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfActivePeers,
      Int
numberOfWarmPeersDemotions :: Int
numberOfWarmPeersDemotions :: Int
numberOfWarmPeersDemotions,
      Int
numberOfWarmPeersPromotions :: Int
numberOfWarmPeersPromotions :: Int
numberOfWarmPeersPromotions,
      Int
numberOfActivePeers :: Int
numberOfActivePeers :: Int
numberOfActivePeers,
      Int
numberOfActivePeersDemotions :: Int
numberOfActivePeersDemotions :: Int
numberOfActivePeersDemotions,

      numberOfKnownBigLedgerPeers :: Int
numberOfKnownBigLedgerPeers                = Int
numberOfKnownBigLedgerPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfEstablishedBigLedgerPeers,
      Int
numberOfAvailableToConnectBigLedgerPeers :: Int
numberOfAvailableToConnectBigLedgerPeers :: Int
numberOfAvailableToConnectBigLedgerPeers,
      Int
numberOfColdBigLedgerPeersPromotions :: Int
numberOfColdBigLedgerPeersPromotions :: Int
numberOfColdBigLedgerPeersPromotions,
      numberOfEstablishedBigLedgerPeers :: Int
numberOfEstablishedBigLedgerPeers          = Int
numberOfEstablishedBigLedgerPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfActiveBigLedgerPeers,
      Int
numberOfWarmBigLedgerPeersDemotions :: Int
numberOfWarmBigLedgerPeersDemotions :: Int
numberOfWarmBigLedgerPeersDemotions,
      Int
numberOfWarmBigLedgerPeersPromotions :: Int
numberOfWarmBigLedgerPeersPromotions :: Int
numberOfWarmBigLedgerPeersPromotions,
      Int
numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeers,
      Int
numberOfActiveBigLedgerPeersDemotions :: Int
numberOfActiveBigLedgerPeersDemotions :: Int
numberOfActiveBigLedgerPeersDemotions,

      numberOfKnownLocalRootPeers :: Int
numberOfKnownLocalRootPeers                = Int
numberOfKnownLocalRootPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfEstablishedLocalRootPeers,
      Int
numberOfAvailableToConnectLocalRootPeers :: Int
numberOfAvailableToConnectLocalRootPeers :: Int
numberOfAvailableToConnectLocalRootPeers,
      Int
numberOfColdLocalRootPeersPromotions :: Int
numberOfColdLocalRootPeersPromotions :: Int
numberOfColdLocalRootPeersPromotions,
      numberOfEstablishedLocalRootPeers :: Int
numberOfEstablishedLocalRootPeers          = Int
numberOfEstablishedLocalRootPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfActiveLocalRootPeers,
      Int
numberOfWarmLocalRootPeersPromotions :: Int
numberOfWarmLocalRootPeersPromotions :: Int
numberOfWarmLocalRootPeersPromotions,
      Int
numberOfActiveLocalRootPeers :: Int
numberOfActiveLocalRootPeers :: Int
numberOfActiveLocalRootPeers,
      Int
numberOfActiveLocalRootPeersDemotions :: Int
numberOfActiveLocalRootPeersDemotions :: Int
numberOfActiveLocalRootPeersDemotions,

      numberOfKnownNonRootPeers :: Int
numberOfKnownNonRootPeers                   = Int
numberOfKnownNonRootPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfEstablishedNonRootPeers,
      Int
numberOfColdNonRootPeersPromotions :: Int
numberOfColdNonRootPeersPromotions :: Int
numberOfColdNonRootPeersPromotions,
      numberOfEstablishedNonRootPeers :: Int
numberOfEstablishedNonRootPeers             = Int
numberOfEstablishedNonRootPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfActiveNonRootPeers,
      Int
numberOfWarmNonRootPeersDemotions :: Int
numberOfWarmNonRootPeersDemotions :: Int
numberOfWarmNonRootPeersDemotions,
      Int
numberOfWarmNonRootPeersPromotions :: Int
numberOfWarmNonRootPeersPromotions :: Int
numberOfWarmNonRootPeersPromotions,
      Int
numberOfActiveNonRootPeers :: Int
numberOfActiveNonRootPeers :: Int
numberOfActiveNonRootPeers,
      Int
numberOfActiveNonRootPeersDemotions :: Int
numberOfActiveNonRootPeersDemotions :: Int
numberOfActiveNonRootPeersDemotions,

      extraCounters
extraCounters :: extraCounters
extraCounters :: extraCounters
extraCounters
    }

emptyPeerSelectionState :: StdGen
                        -> extraState
                        -> extraPeers
                        -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
emptyPeerSelectionState :: forall extraState extraPeers extraFlags peeraddr peerconn.
StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
emptyPeerSelectionState StdGen
rng extraState
es extraPeers
ep =
    PeerSelectionState {
      targets :: PeerSelectionTargets
targets                     = PeerSelectionTargets
nullPeerSelectionTargets,
      localRootPeers :: LocalRootPeers extraFlags peeraddr
localRootPeers              = LocalRootPeers extraFlags peeraddr
forall extraFlags peeraddr. LocalRootPeers extraFlags peeraddr
LocalRootPeers.empty,
      publicRootPeers :: PublicRootPeers extraPeers peeraddr
publicRootPeers             = extraPeers -> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty extraPeers
ep,
      knownPeers :: KnownPeers peeraddr
knownPeers                  = KnownPeers peeraddr
forall peeraddr. KnownPeers peeraddr
KnownPeers.empty,
      establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers            = EstablishedPeers peeraddr peerconn
forall peeraddr perconn. EstablishedPeers peeraddr perconn
EstablishedPeers.empty,
      activePeers :: Set peeraddr
activePeers                 = Set peeraddr
forall a. Set a
Set.empty,
      publicRootBackoffs :: Int
publicRootBackoffs          = Int
0,
      publicRootRetryTime :: Time
publicRootRetryTime         = DiffTime -> Time
Time DiffTime
0,
      inProgressPublicRootsReq :: Bool
inProgressPublicRootsReq    = Bool
False,
      bigLedgerPeerBackoffs :: Int
bigLedgerPeerBackoffs       = Int
0,
      bigLedgerPeerRetryTime :: Time
bigLedgerPeerRetryTime      = DiffTime -> Time
Time DiffTime
0,
      inProgressBigLedgerPeersReq :: Bool
inProgressBigLedgerPeersReq = Bool
False,
      inProgressPeerShareReqs :: Int
inProgressPeerShareReqs     = Int
0,
      inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold       = Set peeraddr
forall a. Set a
Set.empty,
      inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm       = Set peeraddr
forall a. Set a
Set.empty,
      inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm        = Set peeraddr
forall a. Set a
Set.empty,
      inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot         = Set peeraddr
forall a. Set a
Set.empty,
      inProgressDemoteToCold :: Set peeraddr
inProgressDemoteToCold      = Set peeraddr
forall a. Set a
Set.empty,
      stdGen :: StdGen
stdGen                      = StdGen
rng,
      inboundPeersRetryTime :: Time
inboundPeersRetryTime       = DiffTime -> Time
Time DiffTime
0,
      ledgerPeerSnapshot :: Maybe LedgerPeerSnapshot
ledgerPeerSnapshot          = Maybe LedgerPeerSnapshot
forall a. Maybe a
Nothing,
      extraState :: extraState
extraState                  = extraState
es
    }

emptyPeerSelectionCounters :: extraCounters -> PeerSelectionCounters extraCounters
emptyPeerSelectionCounters :: forall extraCounters.
extraCounters -> PeerSelectionCounters extraCounters
emptyPeerSelectionCounters extraCounters
emptyEC =
  PeerSelectionCounters {
    numberOfRootPeers :: Int
numberOfRootPeers                        = Int
0,

    numberOfKnownPeers :: Int
numberOfKnownPeers                       = Int
0,
    numberOfAvailableToConnectPeers :: Int
numberOfAvailableToConnectPeers          = Int
0,
    numberOfColdPeersPromotions :: Int
numberOfColdPeersPromotions              = Int
0,
    numberOfEstablishedPeers :: Int
numberOfEstablishedPeers                 = Int
0,
    numberOfWarmPeersDemotions :: Int
numberOfWarmPeersDemotions               = Int
0,
    numberOfWarmPeersPromotions :: Int
numberOfWarmPeersPromotions              = Int
0,
    numberOfActivePeers :: Int
numberOfActivePeers                      = Int
0,
    numberOfActivePeersDemotions :: Int
numberOfActivePeersDemotions             = Int
0,

    numberOfKnownBigLedgerPeers :: Int
numberOfKnownBigLedgerPeers              = Int
0,
    numberOfAvailableToConnectBigLedgerPeers :: Int
numberOfAvailableToConnectBigLedgerPeers = Int
0,
    numberOfColdBigLedgerPeersPromotions :: Int
numberOfColdBigLedgerPeersPromotions     = Int
0,
    numberOfEstablishedBigLedgerPeers :: Int
numberOfEstablishedBigLedgerPeers        = Int
0,
    numberOfWarmBigLedgerPeersDemotions :: Int
numberOfWarmBigLedgerPeersDemotions      = Int
0,
    numberOfWarmBigLedgerPeersPromotions :: Int
numberOfWarmBigLedgerPeersPromotions     = Int
0,
    numberOfActiveBigLedgerPeers :: Int
numberOfActiveBigLedgerPeers             = Int
0,
    numberOfActiveBigLedgerPeersDemotions :: Int
numberOfActiveBigLedgerPeersDemotions    = Int
0,

    numberOfKnownLocalRootPeers :: Int
numberOfKnownLocalRootPeers              = Int
0,
    numberOfAvailableToConnectLocalRootPeers :: Int
numberOfAvailableToConnectLocalRootPeers = Int
0,
    numberOfColdLocalRootPeersPromotions :: Int
numberOfColdLocalRootPeersPromotions     = Int
0,
    numberOfEstablishedLocalRootPeers :: Int
numberOfEstablishedLocalRootPeers        = Int
0,
    numberOfWarmLocalRootPeersPromotions :: Int
numberOfWarmLocalRootPeersPromotions     = Int
0,
    numberOfActiveLocalRootPeers :: Int
numberOfActiveLocalRootPeers             = Int
0,
    numberOfActiveLocalRootPeersDemotions :: Int
numberOfActiveLocalRootPeersDemotions    = Int
0,

    numberOfKnownNonRootPeers :: Int
numberOfKnownNonRootPeers                 = Int
0,
    numberOfColdNonRootPeersPromotions :: Int
numberOfColdNonRootPeersPromotions        = Int
0,
    numberOfEstablishedNonRootPeers :: Int
numberOfEstablishedNonRootPeers           = Int
0,
    numberOfWarmNonRootPeersDemotions :: Int
numberOfWarmNonRootPeersDemotions         = Int
0,
    numberOfWarmNonRootPeersPromotions :: Int
numberOfWarmNonRootPeersPromotions        = Int
0,
    numberOfActiveNonRootPeers :: Int
numberOfActiveNonRootPeers                = Int
0,
    numberOfActiveNonRootPeersDemotions :: Int
numberOfActiveNonRootPeersDemotions       = Int
0,

    extraCounters :: extraCounters
extraCounters = extraCounters
emptyEC
  }

-- | A view of the status of each established peer, for testing and debugging.
--
establishedPeersStatus :: Ord peeraddr
                       => PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                       -> Map peeraddr PeerStatus
establishedPeersStatus :: forall peeraddr extraState extraFlags extraPeers peerconn.
Ord peeraddr =>
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Map peeraddr PeerStatus
establishedPeersStatus PeerSelectionState{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
activePeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
activePeers :: Set peeraddr
activePeers} =
    -- map union-override, left to right
    (peeraddr -> PeerStatus) -> Set peeraddr -> Map peeraddr PeerStatus
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\peeraddr
_ -> PeerStatus
PeerHot)  Set peeraddr
activePeers
 Map peeraddr PeerStatus
-> Map peeraddr PeerStatus -> Map peeraddr PeerStatus
forall a. Semigroup a => a -> a -> a
<> (peeraddr -> PeerStatus) -> Set peeraddr -> Map peeraddr PeerStatus
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\peeraddr
_ -> PeerStatus
PeerWarm) (EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers)

-----------------------------------------------
-- Cardano Node specific PeerSelection functions
--
-- | Compute peer selection sets & their sizes.
--
-- This function is used internally by the outbound-governor and to compute
-- `PeerSelectionCounters` which are used by churn or are traced (e.g. as EKG
-- metrics).  For this reason one has to be very careful when changing the
-- function, as it will affect the outbound governor behaviour.
--
peerSelectionStateToView
  :: Ord peeraddr
  => (extraPeers -> Set peeraddr)
  -> (PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn -> extraViews)
  -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
  -> PeerSelectionSetsWithSizes extraViews peeraddr
peerSelectionStateToView :: forall peeraddr extraPeers extraState extraFlags peerconn
       extraViews.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraViews)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionSetsWithSizes extraViews peeraddr
peerSelectionStateToView
    extraPeers -> Set peeraddr
extraPeersToSet
    PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraViews
extraStateToExtraViews
    st :: PeerSelectionState
  extraState extraFlags extraPeers 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,
        Set peeraddr
activePeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
activePeers :: Set peeraddr
activePeers,
        PublicRootPeers extraPeers peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers extraPeers peeraddr
publicRootPeers,
        LocalRootPeers extraFlags peeraddr
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers :: LocalRootPeers extraFlags peeraddr
localRootPeers,
        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,
        Set peeraddr
inProgressDemoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm,
        Set peeraddr
inProgressDemoteHot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot
      }
    =
    PeerSelectionView {
      viewRootPeers :: (Set peeraddr, Int)
viewRootPeers                          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size Set peeraddr
rootPeersSet,

      viewKnownPeers :: (Set peeraddr, Int)
viewKnownPeers                         = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
knownPeersSet,
      viewAvailableToConnectPeers :: (Set peeraddr, Int)
viewAvailableToConnectPeers            = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
availableToConnectSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
bigLedgerSet,
      viewColdPeersPromotions :: (Set peeraddr, Int)
viewColdPeersPromotions                = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
inProgressPromoteCold
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
bigLedgerSet,
      viewEstablishedPeers :: (Set peeraddr, Int)
viewEstablishedPeers                   = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
establishedPeersSet,
      viewWarmPeersDemotions :: (Set peeraddr, Int)
viewWarmPeersDemotions                 = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
inProgressDemoteWarm
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
bigLedgerSet,
      viewWarmPeersPromotions :: (Set peeraddr, Int)
viewWarmPeersPromotions                = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
inProgressPromoteWarm
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
bigLedgerSet,
      viewActivePeers :: (Set peeraddr, Int)
viewActivePeers                        = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
activePeersSet,
      viewActivePeersDemotions :: (Set peeraddr, Int)
viewActivePeersDemotions               = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
activePeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteHot,

      viewKnownBigLedgerPeers :: (Set peeraddr, Int)
viewKnownBigLedgerPeers                = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
bigLedgerSet,
      viewAvailableToConnectBigLedgerPeers :: (Set peeraddr, Int)
viewAvailableToConnectBigLedgerPeers   = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
availableToConnectSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bigLedgerSet,
      viewColdBigLedgerPeersPromotions :: (Set peeraddr, Int)
viewColdBigLedgerPeersPromotions       = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
bigLedgerSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteCold,
      viewEstablishedBigLedgerPeers :: (Set peeraddr, Int)
viewEstablishedBigLedgerPeers          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
establishedBigLedgerPeersSet,
      viewWarmBigLedgerPeersDemotions :: (Set peeraddr, Int)
viewWarmBigLedgerPeersDemotions        = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
inProgressDemoteWarm
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
establishedBigLedgerPeersSet,
      viewWarmBigLedgerPeersPromotions :: (Set peeraddr, Int)
viewWarmBigLedgerPeersPromotions       = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
inProgressPromoteWarm
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
establishedBigLedgerPeersSet,
      viewActiveBigLedgerPeers :: (Set peeraddr, Int)
viewActiveBigLedgerPeers               = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
activeBigLedgerPeersSet,
      viewActiveBigLedgerPeersDemotions :: (Set peeraddr, Int)
viewActiveBigLedgerPeersDemotions      = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
activeBigLedgerPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteHot,

      viewKnownLocalRootPeers :: (Set peeraddr, Int)
viewKnownLocalRootPeers                = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
knownLocalRootPeersSet,
      viewAvailableToConnectLocalRootPeers :: (Set peeraddr, Int)
viewAvailableToConnectLocalRootPeers   = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
availableToConnectSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
knownLocalRootPeersSet,
      viewColdLocalRootPeersPromotions :: (Set peeraddr, Int)
viewColdLocalRootPeersPromotions       = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
inProgressPromoteCold
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
knownLocalRootPeersSet,

      viewEstablishedLocalRootPeers :: (Set peeraddr, Int)
viewEstablishedLocalRootPeers          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
establishedLocalRootsPeersSet,
      viewWarmLocalRootPeersPromotions :: (Set peeraddr, Int)
viewWarmLocalRootPeersPromotions       = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
establishedLocalRootsPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteWarm,
      viewActiveLocalRootPeers :: (Set peeraddr, Int)
viewActiveLocalRootPeers               = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
activeLocalRootsPeersSet,
      viewActiveLocalRootPeersDemotions :: (Set peeraddr, Int)
viewActiveLocalRootPeersDemotions      = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
activeLocalRootsPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteHot,

      viewKnownNonRootPeers :: (Set peeraddr, Int)
viewKnownNonRootPeers                   = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
knownNonRootPeersSet,
      viewColdNonRootPeersPromotions :: (Set peeraddr, Int)
viewColdNonRootPeersPromotions          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
knownNonRootPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteCold,
      viewEstablishedNonRootPeers :: (Set peeraddr, Int)
viewEstablishedNonRootPeers             = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
establishedNonRootPeersSet,
      viewWarmNonRootPeersDemotions :: (Set peeraddr, Int)
viewWarmNonRootPeersDemotions           = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
establishedNonRootPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteWarm,
      viewWarmNonRootPeersPromotions :: (Set peeraddr, Int)
viewWarmNonRootPeersPromotions          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
establishedNonRootPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteWarm,
      viewActiveNonRootPeers :: (Set peeraddr, Int)
viewActiveNonRootPeers                  = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
activeNonRootPeersSet,
      viewActiveNonRootPeersDemotions :: (Set peeraddr, Int)
viewActiveNonRootPeersDemotions         = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
activeNonRootPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteHot,
      viewExtraViews :: extraViews
viewExtraViews = PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraViews
extraStateToExtraViews PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
    }
  where
    size :: Set a -> (Set a, Int)
size Set a
s = (Set a
s, Set a -> Int
forall a. Set a -> Int
Set.size Set a
s)

    -- common sets
    knownSet :: Set peeraddr
knownSet       = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers
    establishedSet :: Set peeraddr
establishedSet = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers
    bigLedgerSet :: Set peeraddr
bigLedgerSet   = PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers PublicRootPeers extraPeers peeraddr
publicRootPeers
    availableToConnectSet :: Set peeraddr
availableToConnectSet = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.availableToConnect KnownPeers peeraddr
knownPeers

    -- root peers
    rootPeersSet :: Set peeraddr
rootPeersSet   = (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet extraPeers -> Set peeraddr
extraPeersToSet PublicRootPeers extraPeers peeraddr
publicRootPeers
                  Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
localRootSet

    -- non big ledger peers
    knownPeersSet :: Set peeraddr
knownPeersSet       = Set peeraddr
knownSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
bigLedgerSet
    establishedPeersSet :: Set peeraddr
establishedPeersSet = Set peeraddr
establishedSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
establishedBigLedgerPeersSet
    activePeersSet :: Set peeraddr
activePeersSet      = Set peeraddr
activePeers Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
activeBigLedgerPeersSet

    -- big ledger peers
    establishedBigLedgerPeersSet :: Set peeraddr
establishedBigLedgerPeersSet = Set peeraddr
establishedSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bigLedgerSet
    activeBigLedgerPeersSet :: Set peeraddr
activeBigLedgerPeersSet      = Set peeraddr
establishedBigLedgerPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
activePeers

    -- local roots
    localRootSet :: Set peeraddr
localRootSet                  = LocalRootPeers extraFlags peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags peeraddr
localRootPeers
    -- local roots and big ledger peers are disjoint, hence we can use
    -- `knownPeersSet`, `establishedPeersSet` and `activePeersSet` below.
    knownLocalRootPeersSet :: Set peeraddr
knownLocalRootPeersSet        = Set peeraddr
localRootSet
    establishedLocalRootsPeersSet :: Set peeraddr
establishedLocalRootsPeersSet = Set peeraddr
establishedPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
localRootSet
    activeLocalRootsPeersSet :: Set peeraddr
activeLocalRootsPeersSet      = Set peeraddr
activePeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
localRootSet

    -- shared peers
    -- shared peers are not big ledger peers, hence we can use `knownPeersSet`,
    -- `establishedPeersSet` and `activePeersSet` below.
    knownNonRootPeersSet :: Set peeraddr
knownNonRootPeersSet        = Set peeraddr
knownPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
rootPeersSet
    establishedNonRootPeersSet :: Set peeraddr
establishedNonRootPeersSet  = Set peeraddr
establishedPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
rootPeersSet
    activeNonRootPeersSet :: Set peeraddr
activeNonRootPeersSet       = Set peeraddr
activePeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
rootPeersSet


peerSelectionStateToCounters
  :: Ord peeraddr
  => (extraPeers -> Set peeraddr) -- ^ This function comes from 'PublicExtraPeersAPI'
                                -- It is needed to compute the set of all
                                -- extraPeers and use that information to
                                -- compute the counters.
  -> (PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn -> extraCounters)
  -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
  -> PeerSelectionCounters extraCounters
peerSelectionStateToCounters :: forall peeraddr extraPeers extraState extraFlags peerconn
       extraCounters.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraCounters)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionCounters extraCounters
peerSelectionStateToCounters extraPeers -> Set peeraddr
extraPeersToSet PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters =
    ((Set peeraddr, Int) -> Int)
-> PeerSelectionView extraCounters (Set peeraddr, Int)
-> PeerSelectionView extraCounters Int
forall a b.
(a -> b)
-> PeerSelectionView extraCounters a
-> PeerSelectionView extraCounters b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set peeraddr, Int) -> Int
forall a b. (a, b) -> b
snd
  (PeerSelectionView extraCounters (Set peeraddr, Int)
 -> PeerSelectionView extraCounters Int)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> PeerSelectionView extraCounters (Set peeraddr, Int))
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionView extraCounters Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraCounters)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionView extraCounters (Set peeraddr, Int)
forall peeraddr extraPeers extraState extraFlags peerconn
       extraViews.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraViews)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionSetsWithSizes extraViews peeraddr
peerSelectionStateToView extraPeers -> Set peeraddr
extraPeersToSet
                             PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters

assertPeerSelectionState :: Ord peeraddr
                         => (extraPeers -> Set peeraddr)
                           -- ^ This function comes from 'PublicExtraPeersAPI'
                           -- It is needed to compute the set of all
                           -- extraPeers and use that information to
                           -- compute the invariant.
                         -> (extraPeers -> Bool)
                           -- ^ This function comes from 'PublicExtraPeersAPI'
                           -- It is needed to compute the invariant of the
                           -- extraPeers data type.
                         -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                         -> a -> a
assertPeerSelectionState :: forall peeraddr extraPeers extraState extraFlags peerconn a.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> a
-> a
assertPeerSelectionState extraPeers -> Set peeraddr
extraPeersToSet extraPeers -> Bool
invariantExtraPeers PeerSelectionState{extraState
Bool
Int
Maybe LedgerPeerSnapshot
StdGen
Set peeraddr
Time
EstablishedPeers peeraddr peerconn
KnownPeers peeraddr
LocalRootPeers extraFlags peeraddr
PublicRootPeers extraPeers peeraddr
PeerSelectionTargets
extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
establishedPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
activePeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
publicRootBackoffs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
publicRootRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
inProgressPublicRootsReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
bigLedgerPeerBackoffs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
bigLedgerPeerRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
inProgressBigLedgerPeersReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressPeerShareReqs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
inProgressPromoteCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteHot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteToCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
stdGen :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> StdGen
inboundPeersRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
ledgerPeerSnapshot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Maybe LedgerPeerSnapshot
targets :: PeerSelectionTargets
localRootPeers :: LocalRootPeers extraFlags peeraddr
publicRootPeers :: PublicRootPeers extraPeers peeraddr
knownPeers :: KnownPeers peeraddr
establishedPeers :: EstablishedPeers peeraddr peerconn
activePeers :: Set peeraddr
publicRootBackoffs :: Int
publicRootRetryTime :: Time
inProgressPublicRootsReq :: Bool
bigLedgerPeerBackoffs :: Int
bigLedgerPeerRetryTime :: Time
inProgressBigLedgerPeersReq :: Bool
inProgressPeerShareReqs :: Int
inProgressPromoteCold :: Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteToCold :: Set peeraddr
stdGen :: StdGen
inboundPeersRetryTime :: Time
ledgerPeerSnapshot :: Maybe LedgerPeerSnapshot
extraState :: extraState
..} =
    Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (KnownPeers peeraddr -> Bool
forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Bool
KnownPeers.invariant KnownPeers peeraddr
knownPeers)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (EstablishedPeers peeraddr peerconn -> Bool
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Bool
EstablishedPeers.invariant EstablishedPeers peeraddr peerconn
establishedPeers)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LocalRootPeers extraFlags peeraddr -> Bool
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.invariant LocalRootPeers extraFlags peeraddr
localRootPeers)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((extraPeers -> Bool)
-> (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> Bool
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Bool)
-> (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> Bool
PublicRootPeers.invariant extraPeers -> Bool
invariantExtraPeers
                                      extraPeers -> Set peeraddr
extraPeersToSet
                                      PublicRootPeers extraPeers peeraddr
publicRootPeers)

    -- The activePeers is a subset of the establishedPeers
    -- which is a subset of the known peers
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
activePeersSet Set peeraddr
establishedReadySet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
establishedPeersSet Set peeraddr
knownPeersSet)

   -- The localRootPeers and publicRootPeers must not overlap.
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
localRootPeersSet Set peeraddr
publicRootPeersSet))

    -- The localRootPeers are a subset of the knownPeers,
    -- and with correct source info in the knownPeers (either
    -- 'PeerSourcePublicRoot' or 'PeerSourceLocalRoot', as local and public
    -- root peers might overlap).
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
localRootPeersSet Set peeraddr
knownPeersSet)

    -- The publicRootPeers are a subset of the knownPeers,
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
publicRootPeersSet Set peeraddr
knownPeersSet)

    -- The targets should respect the containment relationships of the root,
    -- known, established and active peers
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PeerSelectionTargets -> Bool
sanePeerSelectionTargets PeerSelectionTargets
targets)

    -- All the local root peers are always a subset of the known peers. The
    -- target for known peers is a target from both below and above. Thus the
    -- number of local root peers must be less than or equal to the known peers
    -- target, otherwise we could get stuck.
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LocalRootPeers extraFlags peeraddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size LocalRootPeers extraFlags peeraddr
localRootPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
targets)

    -- Interestingly, although the local root peers are also a subset of the
    -- root peers, the equivalent constraint does not apply to the target
    -- number of root peers. The reason is that the root peers target is only
    -- a target from below, not from above. It is ok to have more than the
    -- target number of root peers.
    --
    --That is, we do /not/ need or want this invariant:
    --    LocalRootPeers.size   localRootPeers <= targetNumberOfRootPeers
    --
    -- It is also not necessary for all the targets to be achievable. It is
    -- just necessary that we do not get stuck. So although we have an implicit
    -- target that all local root peers become established, and a certain
    -- number of them become active, these targets do not need to be achievable.
    --
    --That is, we do /not/ need or want this invariant:
    --    LocalRootPeers.size   localRootPeers <= targetNumberOfEstablishedPeers
    --    LocalRootPeers.target localRootPeers <= targetNumberOfActivePeers
    --

    -- All currently established peers are in the availableToConnect set since
    -- the alternative is a record of failure, but these are not (yet) failed.
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
establishedPeersSet (KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.availableToConnect KnownPeers peeraddr
knownPeers))

    -- The following aren't hard invariants but rather eventually consistent
    -- invariants that are checked via testing:

    -- 1. If node is not in sensitive state then it can't have only BootstrapPeers
    --
    -- 2. If hasOnlyBootstrapPeers is true and bootstrap peers are enabled then known
    -- peers set is a subset of the bootstrap peers + trusted local roots.
    -- Unless the TargetKnownRootPeers is 0, in that case there can be a delay
    -- where the node forgets the local roots.

    -- No constraint for publicRootBackoffs, publicRootRetryTime
    -- or inProgressPublicRootsReq

  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
inProgressPeerShareReqs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
inProgressPromoteCold Set peeraddr
coldPeersSet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
inProgressPromoteWarm Set peeraddr
warmPeersSet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
inProgressDemoteWarm  Set peeraddr
warmPeersSet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
inProgressDemoteHot   Set peeraddr
hotPeersSet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
inProgressPromoteWarm Set peeraddr
inProgressDemoteWarm))

  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
inProgressDemoteToCold Set peeraddr
establishedPeersSet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
inProgressDemoteToCold Set peeraddr
inProgressPromoteWarm))
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
inProgressDemoteToCold Set peeraddr
inProgressPromoteCold))
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
inProgressDemoteToCold Set peeraddr
inProgressDemoteHot))
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
inProgressDemoteToCold Set peeraddr
inProgressDemoteWarm))

    -- `bigLedgerPeers` is a subset of known peers (and also public root peers)
    -- and disjoint local root peers.
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
bigLedgerPeers Set peeraddr
knownPeersSet)
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
bigLedgerPeers Set peeraddr
localRootPeersSet))

    -- Only peer which has support peersharing should be possible to issue
    -- peersharing requests to.
  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set peeraddr
establishedShareSet
      (Set peeraddr -> KnownPeers peeraddr -> Set peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> Set peeraddr
KnownPeers.getPeerSharingRequestPeers Set peeraddr
knownPeersSet KnownPeers peeraddr
knownPeers))
  where
    knownPeersSet :: Set peeraddr
knownPeersSet       = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers
    localRootPeersSet :: Set peeraddr
localRootPeersSet   = LocalRootPeers extraFlags peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags peeraddr
localRootPeers
    publicRootPeersSet :: Set peeraddr
publicRootPeersSet  = (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet extraPeers -> Set peeraddr
extraPeersToSet PublicRootPeers extraPeers peeraddr
publicRootPeers
    bigLedgerPeers :: Set peeraddr
bigLedgerPeers      = PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers PublicRootPeers extraPeers peeraddr
publicRootPeers
    establishedPeersSet :: Set peeraddr
establishedPeersSet = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet      EstablishedPeers peeraddr peerconn
establishedPeers
    establishedReadySet :: Set peeraddr
establishedReadySet = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.readyPeers EstablishedPeers peeraddr peerconn
establishedPeers
    establishedShareSet :: Set peeraddr
establishedShareSet = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.availableForPeerShare EstablishedPeers peeraddr peerconn
establishedPeers Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<>
                            [peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList (OrdPSQ peeraddr Time () -> [peeraddr]
forall k p v. OrdPSQ k p v -> [k]
PSQ.keys (EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
EstablishedPeers.nextPeerShareTimes
                                                    EstablishedPeers peeraddr peerconn
establishedPeers))
    activePeersSet :: Set peeraddr
activePeersSet      = Set peeraddr
activePeers
    coldPeersSet :: Set peeraddr
coldPeersSet        = Set peeraddr
knownPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
establishedPeersSet
    warmPeersSet :: Set peeraddr
warmPeersSet        = Set peeraddr
establishedPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
activePeersSet
    hotPeersSet :: Set peeraddr
hotPeersSet         = Set peeraddr
activePeersSet


--------------------------------
-- PickPolicy wrapper function
--

-- | Check pre-conditions and post-conditions on the pick policies,
-- and supply additional peer attributes from the current state.
--
pickPeers' :: (Ord peeraddr, Functor m, HasCallStack)
           => (Int -> Set peeraddr -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn -> Bool)
           -- ^ precondition
           -> (peeraddr -> extraPeers -> Bool)
           -- ^ This function comes from 'PublicExtraPeersAPI'
           --
           -- It is needed to compute membership of the
           -- extraPeers data type.
           -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
           -> PickPolicy peeraddr m
           -> Set peeraddr -> Int -> m (Set peeraddr)
pickPeers' :: forall peeraddr (m :: * -> *) extraState extraFlags extraPeers
       peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(Int
 -> Set peeraddr
 -> PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
 -> Bool)
-> (peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers' Int
-> Set peeraddr
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Bool
precondition peeraddr -> extraPeers -> Bool
memberExtraPeers st :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st@PeerSelectionState{LocalRootPeers extraFlags peeraddr
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers :: LocalRootPeers extraFlags peeraddr
localRootPeers, PublicRootPeers extraPeers peeraddr
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers :: PublicRootPeers extraPeers peeraddr
publicRootPeers, KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers}
          PickPolicy peeraddr m
pick Set peeraddr
available Int
num =
    Bool -> m (Set peeraddr) -> m (Set peeraddr)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
-> Set peeraddr
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Bool
precondition Int
num Set peeraddr
available PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st) (m (Set peeraddr) -> m (Set peeraddr))
-> m (Set peeraddr) -> m (Set peeraddr)
forall a b. (a -> b) -> a -> b
$
    (Set peeraddr -> Set peeraddr)
-> m (Set peeraddr) -> m (Set peeraddr)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Set peeraddr
picked -> Bool -> Set peeraddr -> Set peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Bool
postcondition Set peeraddr
picked) Set peeraddr
picked)
         (PickPolicy peeraddr m
pick peeraddr -> PeerSource
peerSource peeraddr -> Int
peerConnectFailCount peeraddr -> Bool
peerTepidFlag
               Set peeraddr
available Int
numClamped)
  where
    postcondition :: Set peeraddr -> Bool
postcondition Set peeraddr
picked = Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
picked)
                        Bool -> Bool -> Bool
&& Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
picked Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
numClamped
                        Bool -> Bool -> Bool
&& Set peeraddr
picked Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set peeraddr
available
    numClamped :: Int
numClamped           = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
num (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
available)

    peerSource :: peeraddr -> PeerSource
peerSource peeraddr
p
      | peeraddr
-> (peeraddr -> extraPeers -> Bool)
-> PublicRootPeers extraPeers peeraddr
-> Bool
forall peeraddr extraPeers.
Ord peeraddr =>
peeraddr
-> (peeraddr -> extraPeers -> Bool)
-> PublicRootPeers extraPeers peeraddr
-> Bool
PublicRootPeers.member
          peeraddr
p peeraddr -> extraPeers -> Bool
memberExtraPeers PublicRootPeers extraPeers peeraddr
publicRootPeers   = PeerSource
PeerSourcePublicRoot
      | peeraddr -> LocalRootPeers extraFlags peeraddr -> Bool
forall peeraddr extraFlags.
Ord peeraddr =>
peeraddr -> LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.member peeraddr
p LocalRootPeers extraFlags peeraddr
localRootPeers = PeerSource
PeerSourceLocalRoot
      | peeraddr -> KnownPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
KnownPeers.member peeraddr
p KnownPeers peeraddr
knownPeers         = PeerSource
PeerSourcePeerShare
      | Bool
otherwise                              = PeerSource
forall {a}. a
errorUnavailable

    peerConnectFailCount :: peeraddr -> Int
peerConnectFailCount peeraddr
p =
        Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall {a}. a
errorUnavailable (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
          peeraddr -> KnownPeers peeraddr -> Maybe Int
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Maybe Int
KnownPeers.lookupFailCount peeraddr
p KnownPeers peeraddr
knownPeers

    peerTepidFlag :: peeraddr -> Bool
peerTepidFlag peeraddr
p  =
        Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
forall {a}. a
errorUnavailable (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
          peeraddr -> KnownPeers peeraddr -> Maybe Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Maybe Bool
KnownPeers.lookupTepidFlag peeraddr
p KnownPeers peeraddr
knownPeers

    -- This error can trigger if `available` is not a subset of `knownPeers`. In
    -- practice, values supplied by callers as `available` tend to be
    -- constructed from the `PeerSelectionState` passed here, and `knownPeers`
    -- represents a superset of the peers in the state. We also check this
    -- relationship in this function's precondition.
    errorUnavailable :: a
errorUnavailable =
        String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"A pick policy requested an attribute for peer address "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which is outside of the set given to pick from"


-- | Pick some known peers.
--
pickPeers :: (Ord peeraddr, Functor m, HasCallStack)
          => (peeraddr -> extraPeers -> Bool)
          -- ^ This function comes from 'PublicExtraPeersAPI'
          --
          -- It is needed to compute membership of the
          -- extraPeers data type.
          -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
          -> PickPolicy peeraddr m
          -> Set peeraddr -> Int -> m (Set peeraddr)
{-# INLINE pickPeers #-}
pickPeers :: forall peeraddr (m :: * -> *) extraPeers extraState extraFlags
       peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers peeraddr -> extraPeers -> Bool
memberExtraPeers =
  (Int
 -> Set peeraddr
 -> PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
 -> Bool)
-> (peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
forall peeraddr (m :: * -> *) extraState extraFlags extraPeers
       peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(Int
 -> Set peeraddr
 -> PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
 -> Bool)
-> (peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers' (\Int
num Set peeraddr
available PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers } ->
       Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
available) Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    Bool -> Bool -> Bool
&& Set peeraddr
available Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers)
             peeraddr -> extraPeers -> Bool
memberExtraPeers

-- | Pick some unknown peers.
--
pickUnknownPeers :: (Ord peeraddr, Functor m, HasCallStack)
                 => (peeraddr -> extraPeers -> Bool)
                 -- ^ This function comes from 'PublicExtraPeersAPI'
                 --
                 -- It is needed to compute membership of the
                 -- extraPeers data type.
                 -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                 -> PickPolicy peeraddr m
                 -> Set peeraddr -> Int -> m (Set peeraddr)
{-# INLINE pickUnknownPeers #-}
pickUnknownPeers :: forall peeraddr (m :: * -> *) extraPeers extraState extraFlags
       peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickUnknownPeers peeraddr -> extraPeers -> Bool
memberExtraPeers =
  (Int
 -> Set peeraddr
 -> PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
 -> Bool)
-> (peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
forall peeraddr (m :: * -> *) extraState extraFlags extraPeers
       peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(Int
 -> Set peeraddr
 -> PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
 -> Bool)
-> (peeraddr -> extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers' (\Int
num Set peeraddr
available PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers } ->
       Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
available) Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    Bool -> Bool -> Bool
&& Bool -> Bool
not (Set peeraddr
available Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers))
             peeraddr -> extraPeers -> Bool
memberExtraPeers

---------------------------
-- Peer Selection Decisions
--


-- | The governor is using @Guarded m (Decision m peeraddr peerconn)@ where 'm'
-- is an 'STM' monad, to drive its progress.
--
data Guarded m a =
    -- | `GuardedSkip'` is used to instruct that there is no action to be made
    -- by the governor. See 'GuardedSkip'.
    --
    GuardedSkip' !(Maybe (Min Time))

    -- | `Guarded'` is used to provide an action through 'FirstToFinish'
    -- synchronisation, possibly with a timeout, to the governor main loop. See
    -- 'Guarded'.
    --
  | Guarded'     !(Maybe (Min Time)) !(FirstToFinish m a)


-- | 'Guarded' is used to provide an action possibly with a timeout, to the
-- governor main loop.
--
-- 'Guarded' is a pattern which which  hides the use of 'FirstToFinish' and
-- 'Min' newtype wrappers.
--
pattern Guarded :: Maybe Time -> m a -> Guarded m a
pattern $bGuarded :: forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
$mGuarded :: forall {r} {m :: * -> *} {a}.
Guarded m a -> (Maybe Time -> m a -> r) -> ((# #) -> r) -> r
Guarded a b <- Guarded' !(fmap getMin -> a) (FirstToFinish !b)
  where
    Guarded !Maybe Time
a !m a
b = Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
forall (m :: * -> *) a.
Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
Guarded' (Time -> Min Time
forall a. a -> Min a
Min (Time -> Min Time) -> Maybe Time -> Maybe (Min Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
a) (m a -> FirstToFinish m a
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish m a
b)

-- | 'GuardedSkip' is used to instruct that there is no action to be made
-- by the governor. See 'GuardedSkip'.
--
-- 'GuardedSkip' is a pattern which hides the usage of `Min` newtype wrapper in
-- `GuardedSkip'` constructor (private).
--
-- Let us note that the combined value which is computed by @guardedDecisions@
-- term in 'Ouroboros.Network.PeerSelection.Governor.peerSelectionGovernorLoop'
-- will never return it: this is because there are monitoring decisions which
-- never return this constructor, e.g.  'Monitor.targetPeers', 'Monitor.jobs',
-- 'Monitor.connections', and thus the governor has always something to do.
--
pattern GuardedSkip :: Maybe Time -> Guarded m a
pattern $bGuardedSkip :: forall (m :: * -> *) a. Maybe Time -> Guarded m a
$mGuardedSkip :: forall {r} {m :: * -> *} {a}.
Guarded m a -> (Maybe Time -> r) -> ((# #) -> r) -> r
GuardedSkip a <- GuardedSkip' !(fmap getMin -> a)
  where
    GuardedSkip !Maybe Time
a = Maybe (Min Time) -> Guarded m a
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip' (Time -> Min Time
forall a. a -> Min a
Min (Time -> Min Time) -> Maybe Time -> Maybe (Min Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
a)

{-# COMPLETE GuardedSkip, Guarded #-}

-- | 'Guarded' constructor is absorbing in the sense that
--
-- > Guarded x y <> a = Guarded x' y'
-- > a <> Guarded x y = Guarded x' y'
--
-- In the algebraic sense, @'Guarded' (Just minBound) (return x)@ is a left
-- absorbing element when "m ~ STM m'@ for some monad @m'@.  There is no right
-- absorbing element since there is no right absorbing element in @STM m'@.
--
-- Ref. [absorbing element](https://en.wikipedia.org/wiki/Absorbing_element)
--
instance Alternative m => Semigroup (Guarded m a) where
  Guarded'     Maybe (Min Time)
ta FirstToFinish m a
a <> :: Guarded m a -> Guarded m a -> Guarded m a
<> Guarded'     Maybe (Min Time)
tb FirstToFinish m a
b = Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
forall (m :: * -> *) a.
Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
Guarded'     (Maybe (Min Time)
ta Maybe (Min Time) -> Maybe (Min Time) -> Maybe (Min Time)
forall a. Semigroup a => a -> a -> a
<> Maybe (Min Time)
tb) (FirstToFinish m a
a FirstToFinish m a -> FirstToFinish m a -> FirstToFinish m a
forall a. Semigroup a => a -> a -> a
<> FirstToFinish m a
b)
  Guarded'     Maybe (Min Time)
ta FirstToFinish m a
a <> GuardedSkip' Maybe (Min Time)
tb   = Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
forall (m :: * -> *) a.
Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
Guarded'     (Maybe (Min Time)
ta Maybe (Min Time) -> Maybe (Min Time) -> Maybe (Min Time)
forall a. Semigroup a => a -> a -> a
<> Maybe (Min Time)
tb)  FirstToFinish m a
a
  GuardedSkip' Maybe (Min Time)
ta   <> Guarded'     Maybe (Min Time)
tb FirstToFinish m a
b = Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
forall (m :: * -> *) a.
Maybe (Min Time) -> FirstToFinish m a -> Guarded m a
Guarded'     (Maybe (Min Time)
ta Maybe (Min Time) -> Maybe (Min Time) -> Maybe (Min Time)
forall a. Semigroup a => a -> a -> a
<> Maybe (Min Time)
tb)  FirstToFinish m a
b
  GuardedSkip' Maybe (Min Time)
ta   <> GuardedSkip' Maybe (Min Time)
tb   = Maybe (Min Time) -> Guarded m a
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip' (Maybe (Min Time)
ta Maybe (Min Time) -> Maybe (Min Time) -> Maybe (Min Time)
forall a. Semigroup a => a -> a -> a
<> Maybe (Min Time)
tb)

instance Alternative m => Monoid (Guarded m a) where
  mempty :: Guarded m a
mempty = Maybe (Min Time) -> Guarded m a
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip' Maybe (Min Time)
forall a. Monoid a => a
mempty
  mappend :: Guarded m a -> Guarded m a -> Guarded m a
mappend = Guarded m a -> Guarded m a -> Guarded m a
forall a. Semigroup a => a -> a -> a
(<>)


data Decision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn = Decision {
         -- | A trace event to classify the decision and action
       forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
Decision
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> [TracePeerSelection
      extraDebugState extraFlags extraPeers peeraddr]
decisionTrace :: [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr],

         -- | An updated state to use immediately
       forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
Decision
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
decisionState :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn,

       -- | An optional 'Job' to execute asynchronously. This job leads to
       -- a further 'Decision'. This gives a state update to apply upon
       -- completion, but also allows chaining further job actions.
       --
       forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
Decision
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> [Job
      ()
      m
      (Completion
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn)]
decisionJobs  :: [Job () m (Completion m extraState extraDebugState extraFlags extraPeers peeraddr peerconn)]
     }

-- | Decision which has access to the current time, rather than the time when
-- the governor's loop blocked to make a decision.
--
type TimedDecision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn =
  Time -> Decision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn

-- | Type alias for function types which are used to create governor decisions.
-- Almost all decisions are following this pattern.
--
type MkGuardedDecision extraState extraDebugState extraFlags extraPeers peeraddr peerconn m
     = PeerSelectionPolicy peeraddr m
    -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
    -> Guarded (STM m) (TimedDecision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn)


newtype Completion m extraState extraDebugState extraFlags extraPeers peeraddr peerconn =
        Completion (PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                 -> Time -> Decision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn)

data TracePeerSelection extraDebugState extraFlags extraPeers peeraddr =
       TraceLocalRootPeersChanged (LocalRootPeers extraFlags peeraddr)
                                  (LocalRootPeers extraFlags peeraddr)
     --
     -- Churn
     --

     -- | Peer selection targets changed: old targets, new targets.
     | TraceTargetsChanged     PeerSelectionTargets PeerSelectionTargets

     --
     -- Ledger Peers
     --

     | TracePublicRootsRequest Int Int
     | TracePublicRootsResults (PublicRootPeers extraPeers peeraddr) Int DiffTime
     | TracePublicRootsFailure SomeException Int DiffTime

     -- | target known peers, actual known peers, selected peers
     | TraceForgetColdPeers    Int Int (Set peeraddr)

     | TraceBigLedgerPeersRequest Int Int
     | TraceBigLedgerPeersResults (Set peeraddr) Int DiffTime
     | TraceBigLedgerPeersFailure SomeException Int DiffTime
     -- | target known big ledger peers, actual known big ledger peers, selected
     -- peers
     | TraceForgetBigLedgerPeers Int Int (Set peeraddr)

     --
     -- Peer Sharing
     --

     -- | target known peers, actual known peers, number of peers to request,
     -- peers available for peer sharing, peers selected for peer sharing
     | TracePeerShareRequests     Int Int PeerSharingAmount (Set peeraddr) (Set peeraddr)
     | TracePeerShareResults         [(peeraddr, Either SomeException (PeerSharingResult peeraddr))] --TODO: classify failures
     | TracePeerShareResultsFiltered [peeraddr]
     -- | target known peers, actual known peers, selected inbound peers, available peers
     | TracePickInboundPeers Int Int (Map peeraddr PeerSharing) (Set peeraddr)

     --
     -- Promote Cold Peers
     --

     -- | target established, actual established, selected peers
     | TracePromoteColdPeers   Int Int (Set peeraddr)
     -- | target local established, actual local established, selected peers
     | TracePromoteColdLocalPeers [(WarmValency, Int)] (Set peeraddr)
     -- promotion, reason
     | TracePromoteColdFailed  Int Int peeraddr DiffTime SomeException
     -- | target established, actual established, peer
     | TracePromoteColdDone    Int Int peeraddr

     -- | target established big ledger peers, actual established big ledger
     -- peers, selected peers
     | TracePromoteColdBigLedgerPeers   Int Int (Set peeraddr)
     -- | target established big ledger peers, actual established big ledger
     -- peers, peer, delay until next promotion, reason
     | TracePromoteColdBigLedgerPeerFailed  Int Int peeraddr DiffTime SomeException
     -- | target established big ledger peers, actual established big ledger
     -- peers, peer
     | TracePromoteColdBigLedgerPeerDone    Int Int peeraddr

     --
     -- Promote Warm Peers
     --

     -- | target active, actual active, selected peers
     | TracePromoteWarmPeers   Int Int (Set peeraddr)
     -- | Promote local peers to warm
     | TracePromoteWarmLocalPeers
         [(HotValency, Int)]
         -- ^ local per-group `(target active, actual active)`,
         -- only limited to groups which are below their target.
         (Set peeraddr) -- ^ selected peers
     -- | target active, actual active, peer, reason
     | TracePromoteWarmFailed  Int Int peeraddr SomeException
     -- | target active, actual active, peer
     | TracePromoteWarmDone    Int Int peeraddr
     -- | aborted promotion of a warm peer; likely it was asynchronously
     -- demoted in the meantime.
     --
     -- target active, actual active, peer
     | TracePromoteWarmAborted Int Int peeraddr

     -- | target active big ledger peers, actual active big ledger peers,
     -- selected peers
     | TracePromoteWarmBigLedgerPeers   Int Int (Set peeraddr)
     -- | target active big ledger peers, actual active big ledger peers, peer,
     -- reason
     | TracePromoteWarmBigLedgerPeerFailed  Int Int peeraddr SomeException
     -- | target active big ledger peers, actual active big ledger peers, peer
     | TracePromoteWarmBigLedgerPeerDone    Int Int peeraddr
     -- | aborted promotion of a warm big ledger peer; likely it was
     -- asynchronously demoted in the meantime.
     --
     -- target active, actual active, peer
     | TracePromoteWarmBigLedgerPeerAborted Int Int peeraddr

     --
     -- Demote Warm Peers
     --

     -- | target established, actual established, selected peers
     | TraceDemoteWarmPeers    Int Int (Set peeraddr)
     -- | target established, actual established, peer, reason
     | TraceDemoteWarmFailed   Int Int peeraddr SomeException
     -- | target established, actual established, peer
     | TraceDemoteWarmDone     Int Int peeraddr

     -- | target established big ledger peers, actual established big ledger
     -- peers, selected peers
     | TraceDemoteWarmBigLedgerPeers    Int Int (Set peeraddr)
     -- | target established big ledger peers, actual established big ledger
     -- peers, peer, reason
     | TraceDemoteWarmBigLedgerPeerFailed   Int Int peeraddr SomeException
     -- | target established big ledger peers, actual established big ledger
     -- peers, peer
     | TraceDemoteWarmBigLedgerPeerDone     Int Int peeraddr

     --
     -- Demote Hot Peers
     --

     -- | target active, actual active, selected peers
     | TraceDemoteHotPeers     Int Int (Set peeraddr)
     -- | local per-group (target active, actual active), selected peers
     | TraceDemoteLocalHotPeers [(HotValency, Int)] (Set peeraddr)
     -- | target active, actual active, peer, reason
     | TraceDemoteHotFailed    Int Int peeraddr SomeException
     -- | target active, actual active, peer
     | TraceDemoteHotDone      Int Int peeraddr

     -- | target active big ledger peers, actual active big ledger peers,
     -- selected peers
     | TraceDemoteHotBigLedgerPeers      Int Int (Set peeraddr)
     -- | target active big ledger peers, actual active big ledger peers, peer,
     -- reason
     | TraceDemoteHotBigLedgerPeerFailed Int Int peeraddr SomeException
     -- | target active big ledger peers, actual active big ledger peers, peer
     | TraceDemoteHotBigLedgerPeerDone   Int Int peeraddr

     --
     -- Async Demotions
     --

     | TraceDemoteAsynchronous      (Map peeraddr (PeerStatus, Maybe RepromoteDelay))
     | TraceDemoteLocalAsynchronous (Map peeraddr (PeerStatus, Maybe RepromoteDelay))
     | TraceDemoteBigLedgerPeersAsynchronous
                                    (Map peeraddr (PeerStatus, Maybe RepromoteDelay))

     | TraceGovernorWakeup

     --
     -- Churn Trace
     --

     | TraceChurnWait          DiffTime
     | TraceChurnMode          ChurnMode
     | TraceChurnAction
         DiffTime    -- ^ duration of the churn action
         ChurnAction -- ^ churn action type
         Int         -- ^ how many peers were removed or added within the
                     --   duration of the action.
     | TraceChurnTimeout
         DiffTime    -- ^ duration of the churn action
         ChurnAction -- ^ churn action type
         Int         -- ^ how many peers were removed or added within the
                     --   duration of the action; note that if the action
                     --   timeouts the governor will still look to remove or
                     --   add peers as required.

     | TraceLedgerStateJudgementChanged LedgerStateJudgement
     | TraceOnlyBootstrapPeers
     | TraceBootstrapPeersFlagChangedWhilstInSensitiveState
     | TraceUseBootstrapPeersChanged UseBootstrapPeers
     | TraceVerifyPeerSnapshot Bool

     --
     -- Critical Failures
     --
     | TraceOutboundGovernorCriticalFailure SomeException

     --
     -- Debug Tracer
     --

     | TraceDebugState Time (DebugPeerSelectionState extraDebugState extraFlags extraPeers peeraddr)
  deriving Int
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
-> ShowS
[TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
-> ShowS
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
-> String
(Int
 -> TracePeerSelection
      extraDebugState extraFlags extraPeers peeraddr
 -> ShowS)
-> (TracePeerSelection
      extraDebugState extraFlags extraPeers peeraddr
    -> String)
-> ([TracePeerSelection
       extraDebugState extraFlags extraPeers peeraddr]
    -> ShowS)
-> Show
     (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extraDebugState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show extraPeers, Show peeraddr,
 Show extraDebugState) =>
Int
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
-> ShowS
forall extraDebugState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show extraPeers, Show peeraddr,
 Show extraDebugState) =>
[TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
-> ShowS
forall extraDebugState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show extraPeers, Show peeraddr,
 Show extraDebugState) =>
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
-> String
$cshowsPrec :: forall extraDebugState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show extraPeers, Show peeraddr,
 Show extraDebugState) =>
Int
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
-> ShowS
showsPrec :: Int
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
-> ShowS
$cshow :: forall extraDebugState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show extraPeers, Show peeraddr,
 Show extraDebugState) =>
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
-> String
show :: TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
-> String
$cshowList :: forall extraDebugState extraFlags extraPeers peeraddr.
(Ord peeraddr, Show extraFlags, Show extraPeers, Show peeraddr,
 Show extraDebugState) =>
[TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
-> ShowS
showList :: [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
-> ShowS
Show


data ChurnAction = DecreasedActivePeers
                 | IncreasedActivePeers
                 | DecreasedActiveBigLedgerPeers
                 | IncreasedActiveBigLedgerPeers
                 | DecreasedEstablishedPeers
                 | IncreasedEstablishedPeers
                 | IncreasedEstablishedBigLedgerPeers
                 | DecreasedEstablishedBigLedgerPeers
                 | DecreasedKnownPeers
                 | IncreasedKnownPeers
                 | DecreasedKnownBigLedgerPeers
                 | IncreasedKnownBigLedgerPeers
  deriving (ChurnAction -> ChurnAction -> Bool
(ChurnAction -> ChurnAction -> Bool)
-> (ChurnAction -> ChurnAction -> Bool) -> Eq ChurnAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChurnAction -> ChurnAction -> Bool
== :: ChurnAction -> ChurnAction -> Bool
$c/= :: ChurnAction -> ChurnAction -> Bool
/= :: ChurnAction -> ChurnAction -> Bool
Eq, Int -> ChurnAction -> ShowS
[ChurnAction] -> ShowS
ChurnAction -> String
(Int -> ChurnAction -> ShowS)
-> (ChurnAction -> String)
-> ([ChurnAction] -> ShowS)
-> Show ChurnAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChurnAction -> ShowS
showsPrec :: Int -> ChurnAction -> ShowS
$cshow :: ChurnAction -> String
show :: ChurnAction -> String
$cshowList :: [ChurnAction] -> ShowS
showList :: [ChurnAction] -> ShowS
Show)


data BootstrapPeersCriticalTimeoutError =
  BootstrapPeersCriticalTimeoutError
  deriving (BootstrapPeersCriticalTimeoutError
-> BootstrapPeersCriticalTimeoutError -> Bool
(BootstrapPeersCriticalTimeoutError
 -> BootstrapPeersCriticalTimeoutError -> Bool)
-> (BootstrapPeersCriticalTimeoutError
    -> BootstrapPeersCriticalTimeoutError -> Bool)
-> Eq BootstrapPeersCriticalTimeoutError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BootstrapPeersCriticalTimeoutError
-> BootstrapPeersCriticalTimeoutError -> Bool
== :: BootstrapPeersCriticalTimeoutError
-> BootstrapPeersCriticalTimeoutError -> Bool
$c/= :: BootstrapPeersCriticalTimeoutError
-> BootstrapPeersCriticalTimeoutError -> Bool
/= :: BootstrapPeersCriticalTimeoutError
-> BootstrapPeersCriticalTimeoutError -> Bool
Eq, Int -> BootstrapPeersCriticalTimeoutError -> ShowS
[BootstrapPeersCriticalTimeoutError] -> ShowS
BootstrapPeersCriticalTimeoutError -> String
(Int -> BootstrapPeersCriticalTimeoutError -> ShowS)
-> (BootstrapPeersCriticalTimeoutError -> String)
-> ([BootstrapPeersCriticalTimeoutError] -> ShowS)
-> Show BootstrapPeersCriticalTimeoutError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BootstrapPeersCriticalTimeoutError -> ShowS
showsPrec :: Int -> BootstrapPeersCriticalTimeoutError -> ShowS
$cshow :: BootstrapPeersCriticalTimeoutError -> String
show :: BootstrapPeersCriticalTimeoutError -> String
$cshowList :: [BootstrapPeersCriticalTimeoutError] -> ShowS
showList :: [BootstrapPeersCriticalTimeoutError] -> ShowS
Show)

instance Exception BootstrapPeersCriticalTimeoutError where
   displayException :: BootstrapPeersCriticalTimeoutError -> String
displayException BootstrapPeersCriticalTimeoutError
BootstrapPeersCriticalTimeoutError =
     String
"The peer selection did not converged to a clean state in 15 minutes. Something is wrong!"

data DebugPeerSelection extraState extraFlags extraPeers peeraddr where
  TraceGovernorState :: forall extraState extraFlags extraPeers peeraddr peerconn.
                        Show peerconn
                     => Time            -- blocked time
                     -> Maybe DiffTime  -- wait time
                     -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                     -> DebugPeerSelection extraState extraFlags extraPeers peeraddr

deriving instance ( Show extraState
                  , Show extraFlags
                  , Show extraPeers
                  , Ord peeraddr
                  , Show peeraddr
                  ) => Show (DebugPeerSelection extraState extraFlags extraPeers peeraddr)