{-# 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
  , pickPeers
  , pickUnknownPeers
    -- * P2P governor low level API
    -- These records are needed to run the peer selection.
  , PeerStateActions (..)
  , PeerSelectionActions (..)
  , PeerSelectionInterfaces (..)
  , ChurnMode (..)
    -- * 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,

        numberOfKnownBootstrapPeers,
        numberOfColdBootstrapPeersPromotions,
        numberOfEstablishedBootstrapPeers,
        numberOfWarmBootstrapPeersDemotions,
        numberOfWarmBootstrapPeersPromotions,
        numberOfActiveBootstrapPeers,
        numberOfActiveBootstrapPeersDemotions,

        PeerSelectionCountersHWC,
        numberOfColdPeers,
        numberOfWarmPeers,
        numberOfHotPeers,

        numberOfColdBigLedgerPeers,
        numberOfWarmBigLedgerPeers,
        numberOfHotBigLedgerPeers,

        numberOfColdLocalRootPeers,
        numberOfWarmLocalRootPeers,
        numberOfHotLocalRootPeers
      )
  , PeerSelectionCounters
  , PeerSelectionSetsWithSizes
  , emptyPeerSelectionCounters
  , 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.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer,
           LedgerPeersKind)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerStateJudgement (..), UseLedgerPeers (..))
import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
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))
import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount,
           PeerSharingResult (..))


-- | 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.  This includes ledger,
       -- 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, ledger peers and big
       -- ledger peers.
       --
       PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers          :: !Int,
       -- | The target number of active peers (does not include big ledger
       -- peers).
       --
       -- The
       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
--     targetChurnIntervalKnownPeers       = 0,
--     targetChurnIntervalEstablishedPeers = 0,
--     targetChurnIntervalActivePeers      = 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 peeraddr peerconn m = PeerSelectionActions {

       forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> STM m PeerSelectionTargets
readPeerSelectionTargets :: STM m PeerSelectionTargets,

       -- | 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 peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m -> STM m (Config peeraddr)
readLocalRootPeers       :: STM m (LocalRootPeers.Config peeraddr),

       -- | Read inbound peers which negotiated duplex connection.
       --
       forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions 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 peeraddr peerconn (m :: * -> *).
PeerSelectionActions 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 peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m -> peerconn -> PeerSharing
peerConnToPeerSharing :: peerconn -> PeerSharing,

       -- | 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 peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> LedgerPeersKind -> Int -> m (PublicRootPeers peeraddr, DiffTime)
requestPublicRootPeers   :: LedgerPeersKind -> Int -> m (PublicRootPeers peeraddr, DiffTime),

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

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

       -- | Read the current bootstrap peers flag
       forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m -> STM m UseBootstrapPeers
readUseBootstrapPeers :: STM m UseBootstrapPeers,

       -- | Read the current ledger state judgement
       --
       forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> STM m LedgerStateJudgement
readLedgerStateJudgement :: STM m LedgerStateJudgement,

       -- | Callback provided by consensus to inform it if the node is
       -- connected to only local roots or also some external peers.
       --
       -- This is useful in order for the Bootstrap State Machine to
       -- simply refuse to transition from TooOld to YoungEnough while
       -- it only has local peers.
       --
       forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> OutboundConnectionsState -> STM m ()
updateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()

     }

-- | 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 peeraddr peerconn m = PeerSelectionInterfaces {
      -- | PeerSelectionCounters are shared with churn through a `StrictTVar`.
      --
      forall peeraddr peerconn (m :: * -> *).
PeerSelectionInterfaces peeraddr peerconn m
-> StrictTVar m PeerSelectionCounters
countersVar                   :: StrictTVar m PeerSelectionCounters,

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

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

      -- | `UseLedgerPeers` used by `peerSelectionGovernor` to support
      -- `HiddenRelayOrBP`
      --
      forall peeraddr peerconn (m :: * -> *).
PeerSelectionInterfaces 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 -> peeraddr -> m peerconn
establishPeerConnection  :: IsBigLedgerPeer
                             -> 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 ()
  }

-----------------------
-- 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 peeraddr peerconn = PeerSelectionState {

       forall peeraddr peerconn.
PeerSelectionState 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 peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers              :: !(LocalRootPeers peeraddr),

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

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

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

       -- | Active peers.
       --
       forall peeraddr peerconn.
PeerSelectionState 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 peeraddr peerconn.
PeerSelectionState 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 peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
publicRootRetryTime         :: !Time,

       -- | Whether a request for more public root peers is in progress.
       --
       forall peeraddr peerconn.
PeerSelectionState 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 peeraddr peerconn.
PeerSelectionState 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 peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
bigLedgerPeerRetryTime      :: !Time,

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

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

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

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

       -- | Current ledger state judgement
       --
       forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
ledgerStateJudgement        :: !LedgerStateJudgement,

       -- | Current value of 'UseBootstrapPeers'.
       --
       forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
bootstrapPeersFlag          :: !UseBootstrapPeers,

       -- | Has the governor fully reset its state
       --
       forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
hasOnlyBootstrapPeers       :: !Bool,

       -- | Has the governor fully reset its state
       --
       forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Maybe Time
bootstrapPeersTimeout       :: !(Maybe Time),

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


--     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 peeraddr peerconn -> ShowS
[PeerSelectionState peeraddr peerconn] -> ShowS
PeerSelectionState peeraddr peerconn -> String
(Int -> PeerSelectionState peeraddr peerconn -> ShowS)
-> (PeerSelectionState peeraddr peerconn -> String)
-> ([PeerSelectionState peeraddr peerconn] -> ShowS)
-> Show (PeerSelectionState peeraddr peerconn)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peeraddr peerconn.
(Ord peeraddr, Show peeraddr, Show peerconn) =>
Int -> PeerSelectionState peeraddr peerconn -> ShowS
forall peeraddr peerconn.
(Ord peeraddr, Show peeraddr, Show peerconn) =>
[PeerSelectionState peeraddr peerconn] -> ShowS
forall peeraddr peerconn.
(Ord peeraddr, Show peeraddr, Show peerconn) =>
PeerSelectionState peeraddr peerconn -> String
$cshowsPrec :: forall peeraddr peerconn.
(Ord peeraddr, Show peeraddr, Show peerconn) =>
Int -> PeerSelectionState peeraddr peerconn -> ShowS
showsPrec :: Int -> PeerSelectionState peeraddr peerconn -> ShowS
$cshow :: forall peeraddr peerconn.
(Ord peeraddr, Show peeraddr, Show peerconn) =>
PeerSelectionState peeraddr peerconn -> String
show :: PeerSelectionState peeraddr peerconn -> String
$cshowList :: forall peeraddr peerconn.
(Ord peeraddr, Show peeraddr, Show peerconn) =>
[PeerSelectionState peeraddr peerconn] -> ShowS
showList :: [PeerSelectionState 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 peeraddr = DebugPeerSelectionState {
       forall peeraddr.
DebugPeerSelectionState peeraddr -> PeerSelectionTargets
dpssTargets                     :: !PeerSelectionTargets,
       forall peeraddr.
DebugPeerSelectionState peeraddr -> LocalRootPeers peeraddr
dpssLocalRootPeers              :: !(LocalRootPeers peeraddr),
       forall peeraddr.
DebugPeerSelectionState peeraddr -> PublicRootPeers peeraddr
dpssPublicRootPeers             :: !(PublicRootPeers peeraddr),
       forall peeraddr.
DebugPeerSelectionState peeraddr -> KnownPeers peeraddr
dpssKnownPeers                  :: !(KnownPeers peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssEstablishedPeers            :: !(Set peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssActivePeers                 :: !(Set peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Int
dpssPublicRootBackoffs          :: !Int,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Time
dpssPublicRootRetryTime         :: !Time,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Bool
dpssInProgressPublicRootsReq    :: !Bool,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Int
dpssBigLedgerPeerBackoffs       :: !Int,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Time
dpssBigLedgerPeerRetryTime      :: !Time,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Bool
dpssInProgressBigLedgerPeersReq :: !Bool,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Int
dpssInProgressPeerShareReqs     :: !Int,
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssInProgressPromoteCold       :: !(Set peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssInProgressPromoteWarm       :: !(Set peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssInProgressDemoteWarm        :: !(Set peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssInProgressDemoteHot         :: !(Set peeraddr),
       forall peeraddr. DebugPeerSelectionState peeraddr -> Set peeraddr
dpssInProgressDemoteToCold      :: !(Set peeraddr),
       forall peeraddr.
DebugPeerSelectionState peeraddr -> Map peeraddr Int
dpssUpstreamyness               :: !(Map peeraddr Int),
       forall peeraddr.
DebugPeerSelectionState peeraddr -> Map peeraddr Int
dpssFetchynessBlocks            :: !(Map peeraddr Int),
       forall peeraddr.
DebugPeerSelectionState peeraddr -> LedgerStateJudgement
dpssLedgerStateJudgement        :: !LedgerStateJudgement,
       forall peeraddr.
DebugPeerSelectionState peeraddr -> AssociationMode
dpssAssociationMode             :: !AssociationMode
} deriving Int -> DebugPeerSelectionState peeraddr -> ShowS
[DebugPeerSelectionState peeraddr] -> ShowS
DebugPeerSelectionState peeraddr -> String
(Int -> DebugPeerSelectionState peeraddr -> ShowS)
-> (DebugPeerSelectionState peeraddr -> String)
-> ([DebugPeerSelectionState peeraddr] -> ShowS)
-> Show (DebugPeerSelectionState peeraddr)
forall peeraddr.
(Show peeraddr, Ord peeraddr) =>
Int -> DebugPeerSelectionState peeraddr -> ShowS
forall peeraddr.
(Show peeraddr, Ord peeraddr) =>
[DebugPeerSelectionState peeraddr] -> ShowS
forall peeraddr.
(Show peeraddr, Ord peeraddr) =>
DebugPeerSelectionState peeraddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr.
(Show peeraddr, Ord peeraddr) =>
Int -> DebugPeerSelectionState peeraddr -> ShowS
showsPrec :: Int -> DebugPeerSelectionState peeraddr -> ShowS
$cshow :: forall peeraddr.
(Show peeraddr, Ord peeraddr) =>
DebugPeerSelectionState peeraddr -> String
show :: DebugPeerSelectionState peeraddr -> String
$cshowList :: forall peeraddr.
(Show peeraddr, Ord peeraddr) =>
[DebugPeerSelectionState peeraddr] -> ShowS
showList :: [DebugPeerSelectionState peeraddr] -> ShowS
Show

makeDebugPeerSelectionState :: PeerSelectionState peeraddr peerconn
                            -> Map peeraddr Int
                            -> Map peeraddr Int
                            -> LedgerStateJudgement
                            -> AssociationMode
                            -> DebugPeerSelectionState peeraddr
makeDebugPeerSelectionState :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> Map peeraddr Int
-> Map peeraddr Int
-> LedgerStateJudgement
-> AssociationMode
-> DebugPeerSelectionState peeraddr
makeDebugPeerSelectionState PeerSelectionState {Bool
Int
Maybe Time
StdGen
Set peeraddr
Time
LedgerStateJudgement
UseBootstrapPeers
PublicRootPeers peeraddr
EstablishedPeers peeraddr peerconn
KnownPeers peeraddr
LocalRootPeers peeraddr
PeerSelectionTargets
targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
publicRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
publicRootBackoffs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
publicRootRetryTime :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
inProgressPublicRootsReq :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
bigLedgerPeerBackoffs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
bigLedgerPeerRetryTime :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
inProgressBigLedgerPeersReq :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
inProgressPeerShareReqs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressPromoteCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteHot :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteToCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
stdGen :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> StdGen
ledgerStateJudgement :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
bootstrapPeersFlag :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
hasOnlyBootstrapPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
bootstrapPeersTimeout :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Maybe Time
inboundPeersRetryTime :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
targets :: PeerSelectionTargets
localRootPeers :: LocalRootPeers peeraddr
publicRootPeers :: PublicRootPeers 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
ledgerStateJudgement :: LedgerStateJudgement
bootstrapPeersFlag :: UseBootstrapPeers
hasOnlyBootstrapPeers :: Bool
bootstrapPeersTimeout :: Maybe Time
inboundPeersRetryTime :: Time
..} Map peeraddr Int
up Map peeraddr Int
bp LedgerStateJudgement
lsj AssociationMode
am =
  DebugPeerSelectionState {
      dpssTargets :: PeerSelectionTargets
dpssTargets                     = PeerSelectionTargets
targets
    , dpssLocalRootPeers :: LocalRootPeers peeraddr
dpssLocalRootPeers              = LocalRootPeers peeraddr
localRootPeers
    , dpssPublicRootPeers :: PublicRootPeers peeraddr
dpssPublicRootPeers             = PublicRootPeers 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
    , dpssLedgerStateJudgement :: LedgerStateJudgement
dpssLedgerStateJudgement        = LedgerStateJudgement
lsj
    , dpssAssociationMode :: AssociationMode
dpssAssociationMode             = AssociationMode
am
    }

-- | 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 peeraddr peerconn
              -> PublicPeerSelectionState peeraddr
toPublicState :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> PublicPeerSelectionState peeraddr
toPublicState PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState 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 a = PeerSelectionView {
      forall a. PeerSelectionView a -> a
viewRootPeers                        :: a,

      --
      -- Non Big Ledger Peers
      --

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

      --
      -- Big Ledger Peers
      --

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

      --
      -- Local Roots
      --

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

      --
      -- Non-Root Peers
      -- 

      forall a. PeerSelectionView 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 a. PeerSelectionView a -> a
viewColdNonRootPeersPromotions        :: a,
      forall a. PeerSelectionView a -> a
viewEstablishedNonRootPeers           :: a,
      forall a. PeerSelectionView a -> a
viewWarmNonRootPeersDemotions         :: a,
      forall a. PeerSelectionView a -> a
viewWarmNonRootPeersPromotions        :: a,
      forall a. PeerSelectionView a -> a
viewActiveNonRootPeers                :: a,
      forall a. PeerSelectionView a -> a
viewActiveNonRootPeersDemotions       :: a,

      --
      -- Bootstrap Peers
      --

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


type PeerSelectionCounters = PeerSelectionView 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
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int
          -> PeerSelectionCounters
pattern $mPeerSelectionCounters :: forall {r}.
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
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> Int
    -> r)
-> ((# #) -> r)
-> r
$bPeerSelectionCounters :: 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
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> PeerSelectionCounters
PeerSelectionCounters {
      PeerSelectionCounters -> Int
numberOfRootPeers,

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

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

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

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

      PeerSelectionCounters -> Int
numberOfKnownBootstrapPeers,
      PeerSelectionCounters -> Int
numberOfColdBootstrapPeersPromotions,
      PeerSelectionCounters -> Int
numberOfEstablishedBootstrapPeers,
      PeerSelectionCounters -> Int
numberOfWarmBootstrapPeersDemotions,
      PeerSelectionCounters -> Int
numberOfWarmBootstrapPeersPromotions,
      PeerSelectionCounters -> Int
numberOfActiveBootstrapPeers,
      PeerSelectionCounters -> Int
numberOfActiveBootstrapPeersDemotions
    }
  =
  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,

      viewKnownBootstrapPeers              = numberOfKnownBootstrapPeers,
      viewColdBootstrapPeersPromotions     = numberOfColdBootstrapPeersPromotions,
      viewEstablishedBootstrapPeers        = numberOfEstablishedBootstrapPeers,
      viewWarmBootstrapPeersDemotions      = numberOfWarmBootstrapPeersDemotions,
      viewWarmBootstrapPeersPromotions     = numberOfWarmBootstrapPeersPromotions,
      viewActiveBootstrapPeers             = numberOfActiveBootstrapPeers,
      viewActiveBootstrapPeersDemotions    = numberOfActiveBootstrapPeersDemotions
    }

{-# COMPLETE PeerSelectionCounters #-}

type PeerSelectionSetsWithSizes peeraddr = PeerSelectionView (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
pattern $mPeerSelectionCountersHWC :: forall {r}.
PeerSelectionCounters
-> (Int
    -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> r)
-> ((# #) -> r)
-> r
PeerSelectionCountersHWC { PeerSelectionCounters -> Int
numberOfColdPeers,
                                   PeerSelectionCounters -> Int
numberOfWarmPeers,
                                   PeerSelectionCounters -> Int
numberOfHotPeers,

                                   PeerSelectionCounters -> Int
numberOfColdBigLedgerPeers,
                                   PeerSelectionCounters -> Int
numberOfWarmBigLedgerPeers,
                                   PeerSelectionCounters -> Int
numberOfHotBigLedgerPeers,

                                   PeerSelectionCounters -> Int
numberOfColdLocalRootPeers,
                                   PeerSelectionCounters -> Int
numberOfWarmLocalRootPeers,
                                   PeerSelectionCounters -> 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 -> PeerSelectionCounters
peerSelectionCountersHWC :: PeerSelectionCounters -> PeerSelectionCounters
peerSelectionCountersHWC PeerSelectionCounters {Int
numberOfRootPeers :: PeerSelectionCounters -> Int
numberOfKnownPeers :: PeerSelectionCounters -> Int
numberOfAvailableToConnectPeers :: PeerSelectionCounters -> Int
numberOfColdPeersPromotions :: PeerSelectionCounters -> Int
numberOfEstablishedPeers :: PeerSelectionCounters -> Int
numberOfWarmPeersDemotions :: PeerSelectionCounters -> Int
numberOfWarmPeersPromotions :: PeerSelectionCounters -> Int
numberOfActivePeers :: PeerSelectionCounters -> Int
numberOfActivePeersDemotions :: PeerSelectionCounters -> Int
numberOfKnownBigLedgerPeers :: PeerSelectionCounters -> Int
numberOfAvailableToConnectBigLedgerPeers :: PeerSelectionCounters -> Int
numberOfColdBigLedgerPeersPromotions :: PeerSelectionCounters -> Int
numberOfEstablishedBigLedgerPeers :: PeerSelectionCounters -> Int
numberOfWarmBigLedgerPeersDemotions :: PeerSelectionCounters -> Int
numberOfWarmBigLedgerPeersPromotions :: PeerSelectionCounters -> Int
numberOfActiveBigLedgerPeers :: PeerSelectionCounters -> Int
numberOfActiveBigLedgerPeersDemotions :: PeerSelectionCounters -> Int
numberOfKnownLocalRootPeers :: PeerSelectionCounters -> Int
numberOfAvailableToConnectLocalRootPeers :: PeerSelectionCounters -> Int
numberOfColdLocalRootPeersPromotions :: PeerSelectionCounters -> Int
numberOfEstablishedLocalRootPeers :: PeerSelectionCounters -> Int
numberOfWarmLocalRootPeersPromotions :: PeerSelectionCounters -> Int
numberOfActiveLocalRootPeers :: PeerSelectionCounters -> Int
numberOfActiveLocalRootPeersDemotions :: PeerSelectionCounters -> Int
numberOfKnownNonRootPeers :: PeerSelectionCounters -> Int
numberOfColdNonRootPeersPromotions :: PeerSelectionCounters -> Int
numberOfEstablishedNonRootPeers :: PeerSelectionCounters -> Int
numberOfWarmNonRootPeersDemotions :: PeerSelectionCounters -> Int
numberOfWarmNonRootPeersPromotions :: PeerSelectionCounters -> Int
numberOfActiveNonRootPeers :: PeerSelectionCounters -> Int
numberOfActiveNonRootPeersDemotions :: PeerSelectionCounters -> Int
numberOfKnownBootstrapPeers :: PeerSelectionCounters -> Int
numberOfColdBootstrapPeersPromotions :: PeerSelectionCounters -> Int
numberOfEstablishedBootstrapPeers :: PeerSelectionCounters -> Int
numberOfWarmBootstrapPeersDemotions :: PeerSelectionCounters -> Int
numberOfWarmBootstrapPeersPromotions :: PeerSelectionCounters -> Int
numberOfActiveBootstrapPeers :: PeerSelectionCounters -> Int
numberOfActiveBootstrapPeersDemotions :: PeerSelectionCounters -> Int
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
numberOfKnownBootstrapPeers :: Int
numberOfColdBootstrapPeersPromotions :: Int
numberOfEstablishedBootstrapPeers :: Int
numberOfWarmBootstrapPeersDemotions :: Int
numberOfWarmBootstrapPeersPromotions :: Int
numberOfActiveBootstrapPeers :: Int
numberOfActiveBootstrapPeersDemotions :: Int
..} =
    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,

      numberOfKnownBootstrapPeers :: Int
numberOfKnownBootstrapPeers                = Int
numberOfKnownBootstrapPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfEstablishedBootstrapPeers,
      Int
numberOfColdBootstrapPeersPromotions :: Int
numberOfColdBootstrapPeersPromotions :: Int
numberOfColdBootstrapPeersPromotions,
      numberOfEstablishedBootstrapPeers :: Int
numberOfEstablishedBootstrapPeers          = Int
numberOfEstablishedBootstrapPeers
                                                 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numberOfActiveBootstrapPeers,
      Int
numberOfWarmBootstrapPeersDemotions :: Int
numberOfWarmBootstrapPeersDemotions :: Int
numberOfWarmBootstrapPeersDemotions,
      Int
numberOfWarmBootstrapPeersPromotions :: Int
numberOfWarmBootstrapPeersPromotions :: Int
numberOfWarmBootstrapPeersPromotions,
      Int
numberOfActiveBootstrapPeers :: Int
numberOfActiveBootstrapPeers :: Int
numberOfActiveBootstrapPeers,
      Int
numberOfActiveBootstrapPeersDemotions :: Int
numberOfActiveBootstrapPeersDemotions :: Int
numberOfActiveBootstrapPeersDemotions
    }


-- | 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
  => PeerSelectionState peeraddr peerconn
  -> PeerSelectionSetsWithSizes peeraddr
peerSelectionStateToView :: forall peeraddr peerconn.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn
-> PeerSelectionSetsWithSizes peeraddr
peerSelectionStateToView
    PeerSelectionState {
        KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers,
        EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers,
        Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers :: Set peeraddr
activePeers,
        PublicRootPeers peeraddr
publicRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
publicRootPeers :: PublicRootPeers peeraddr
publicRootPeers,
        LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers,
        Set peeraddr
inProgressPromoteCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold,
        Set peeraddr
inProgressPromoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm,
        Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm,
        Set peeraddr
inProgressDemoteHot :: forall peeraddr peerconn.
PeerSelectionState 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,


      viewKnownBootstrapPeers :: (Set peeraddr, Int)
viewKnownBootstrapPeers                = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
knownBootstrapPeersSet,
      viewColdBootstrapPeersPromotions :: (Set peeraddr, Int)
viewColdBootstrapPeersPromotions       = 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
knownBootstrapPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteCold,
      viewEstablishedBootstrapPeers :: (Set peeraddr, Int)
viewEstablishedBootstrapPeers          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
establishedBootstrapPeersSet,
      viewWarmBootstrapPeersDemotions :: (Set peeraddr, Int)
viewWarmBootstrapPeersDemotions        = 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
establishedBootstrapPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteWarm,
      viewWarmBootstrapPeersPromotions :: (Set peeraddr, Int)
viewWarmBootstrapPeersPromotions       = 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
establishedBootstrapPeersSet
                                                      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteWarm,
      viewActiveBootstrapPeers :: (Set peeraddr, Int)
viewActiveBootstrapPeers               = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size   Set peeraddr
activeBootstrapPeersSet,
      viewActiveBootstrapPeersDemotions :: (Set peeraddr, Int)
viewActiveBootstrapPeersDemotions      = 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
activeBootstrapPeersSet
                                                      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
    }
  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 peeraddr -> Set peeraddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers PublicRootPeers 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   = PublicRootPeers peeraddr -> Set peeraddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet PublicRootPeers 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 peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers 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

    -- bootstrap peers
    bootstrapSet :: Set peeraddr
bootstrapSet                 = PublicRootPeers peeraddr -> Set peeraddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers peeraddr
publicRootPeers
    -- bootstrap peers and big ledger peers are disjoint, hence we can use
    -- `knownPeersSet`, `establishedPeersSet` and `activePeersSet` below.
    knownBootstrapPeersSet :: Set peeraddr
knownBootstrapPeersSet       = Set peeraddr
bootstrapSet
    establishedBootstrapPeersSet :: Set peeraddr
establishedBootstrapPeersSet = Set peeraddr
establishedPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bootstrapSet
    activeBootstrapPeersSet :: Set peeraddr
activeBootstrapPeersSet      = Set peeraddr
activePeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bootstrapSet

    -- 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
  => PeerSelectionState peeraddr peerconn
  -> PeerSelectionCounters
peerSelectionStateToCounters :: forall peeraddr peerconn.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn -> PeerSelectionCounters
peerSelectionStateToCounters = ((Set peeraddr, Int) -> Int)
-> PeerSelectionView (Set peeraddr, Int) -> PeerSelectionCounters
forall a b. (a -> b) -> PeerSelectionView a -> PeerSelectionView 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 (Set peeraddr, Int) -> PeerSelectionCounters)
-> (PeerSelectionState peeraddr peerconn
    -> PeerSelectionView (Set peeraddr, Int))
-> PeerSelectionState peeraddr peerconn
-> PeerSelectionCounters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState peeraddr peerconn
-> PeerSelectionView (Set peeraddr, Int)
forall peeraddr peerconn.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn
-> PeerSelectionSetsWithSizes peeraddr
peerSelectionStateToView


emptyPeerSelectionCounters :: PeerSelectionCounters
emptyPeerSelectionCounters :: PeerSelectionCounters
emptyPeerSelectionCounters =
  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,

    numberOfKnownBootstrapPeers :: Int
numberOfKnownBootstrapPeers              = Int
0,
    numberOfColdBootstrapPeersPromotions :: Int
numberOfColdBootstrapPeersPromotions     = Int
0,
    numberOfEstablishedBootstrapPeers :: Int
numberOfEstablishedBootstrapPeers        = Int
0,
    numberOfWarmBootstrapPeersDemotions :: Int
numberOfWarmBootstrapPeersDemotions      = Int
0,
    numberOfWarmBootstrapPeersPromotions :: Int
numberOfWarmBootstrapPeersPromotions     = Int
0,
    numberOfActiveBootstrapPeers :: Int
numberOfActiveBootstrapPeers             = Int
0,
    numberOfActiveBootstrapPeersDemotions :: Int
numberOfActiveBootstrapPeersDemotions    = 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
  }

emptyPeerSelectionState :: StdGen
                        -> PeerSelectionState peeraddr peerconn
emptyPeerSelectionState :: forall peeraddr peerconn.
StdGen -> PeerSelectionState peeraddr peerconn
emptyPeerSelectionState StdGen
rng =
    PeerSelectionState {
      targets :: PeerSelectionTargets
targets                     = PeerSelectionTargets
nullPeerSelectionTargets,
      localRootPeers :: LocalRootPeers peeraddr
localRootPeers              = LocalRootPeers peeraddr
forall peeraddr. LocalRootPeers peeraddr
LocalRootPeers.empty,
      publicRootPeers :: PublicRootPeers peeraddr
publicRootPeers             = PublicRootPeers peeraddr
forall peeraddr. PublicRootPeers peeraddr
PublicRootPeers.empty,
      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,
      ledgerStateJudgement :: LedgerStateJudgement
ledgerStateJudgement        = LedgerStateJudgement
TooOld,
      bootstrapPeersFlag :: UseBootstrapPeers
bootstrapPeersFlag          = UseBootstrapPeers
DontUseBootstrapPeers,
      hasOnlyBootstrapPeers :: Bool
hasOnlyBootstrapPeers       = Bool
False,
      bootstrapPeersTimeout :: Maybe Time
bootstrapPeersTimeout       = Maybe Time
forall a. Maybe a
Nothing,
      inboundPeersRetryTime :: Time
inboundPeersRetryTime       = DiffTime -> Time
Time DiffTime
0
    }


assertPeerSelectionState :: Ord peeraddr
                         => PeerSelectionState peeraddr peerconn
                         -> a -> a
assertPeerSelectionState :: forall peeraddr peerconn a.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn -> a -> a
assertPeerSelectionState PeerSelectionState{Bool
Int
Maybe Time
StdGen
Set peeraddr
Time
LedgerStateJudgement
UseBootstrapPeers
PublicRootPeers peeraddr
EstablishedPeers peeraddr peerconn
KnownPeers peeraddr
LocalRootPeers peeraddr
PeerSelectionTargets
targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
publicRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
publicRootBackoffs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
publicRootRetryTime :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
inProgressPublicRootsReq :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
bigLedgerPeerBackoffs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
bigLedgerPeerRetryTime :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
inProgressBigLedgerPeersReq :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
inProgressPeerShareReqs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressPromoteCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteHot :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteToCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
stdGen :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> StdGen
ledgerStateJudgement :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
bootstrapPeersFlag :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
hasOnlyBootstrapPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
bootstrapPeersTimeout :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Maybe Time
inboundPeersRetryTime :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Time
targets :: PeerSelectionTargets
localRootPeers :: LocalRootPeers peeraddr
publicRootPeers :: PublicRootPeers 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
ledgerStateJudgement :: LedgerStateJudgement
bootstrapPeersFlag :: UseBootstrapPeers
hasOnlyBootstrapPeers :: Bool
bootstrapPeersTimeout :: Maybe Time
inboundPeersRetryTime :: Time
..} =
    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 peeraddr -> Bool
forall peeraddr. Ord peeraddr => LocalRootPeers peeraddr -> Bool
LocalRootPeers.invariant LocalRootPeers 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 (PublicRootPeers peeraddr -> Bool
forall peeraddr. Ord peeraddr => PublicRootPeers peeraddr -> Bool
PublicRootPeers.invariant PublicRootPeers 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 peeraddr -> Int
forall peeraddr. LocalRootPeers peeraddr -> Int
LocalRootPeers.size LocalRootPeers 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 peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
    publicRootPeersSet :: Set peeraddr
publicRootPeersSet  = PublicRootPeers peeraddr -> Set peeraddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet PublicRootPeers peeraddr
publicRootPeers
    bigLedgerPeers :: Set peeraddr
bigLedgerPeers      = PublicRootPeers peeraddr -> Set peeraddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers PublicRootPeers 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


-- | A view of the status of each established peer, for testing and debugging.
--
establishedPeersStatus :: Ord peeraddr
                       => PeerSelectionState peeraddr peerconn
                       -> Map peeraddr PeerStatus
establishedPeersStatus :: forall peeraddr peerconn.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn -> Map peeraddr PeerStatus
establishedPeersStatus PeerSelectionState{EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers, Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState 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)


--------------------------------
-- 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 peeraddr peerconn -> Bool)
           -- ^ precondition
           -> PeerSelectionState peeraddr peerconn
           -> PickPolicy peeraddr m
           -> Set peeraddr -> Int -> m (Set peeraddr)
pickPeers' :: forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(Int
 -> Set peeraddr -> PeerSelectionState peeraddr peerconn -> Bool)
-> PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers' Int -> Set peeraddr -> PeerSelectionState peeraddr peerconn -> Bool
precondition st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState{LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers, PublicRootPeers peeraddr
publicRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
publicRootPeers :: PublicRootPeers peeraddr
publicRootPeers, KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState 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 peeraddr peerconn -> Bool
precondition Int
num Set peeraddr
available PeerSelectionState 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 -> LocalRootPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> LocalRootPeers peeraddr -> Bool
LocalRootPeers.member peeraddr
p LocalRootPeers peeraddr
localRootPeers   = PeerSource
PeerSourceLocalRoot
      | peeraddr -> PublicRootPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> PublicRootPeers peeraddr -> Bool
PublicRootPeers.member peeraddr
p PublicRootPeers peeraddr
publicRootPeers = PeerSource
PeerSourcePublicRoot
      | 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)
          => PeerSelectionState peeraddr peerconn
          -> PickPolicy peeraddr m
          -> Set peeraddr -> Int -> m (Set peeraddr)
{-# INLINE pickPeers #-}
pickPeers :: forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m -> Set peeraddr -> Int -> m (Set peeraddr)
pickPeers = (Int
 -> Set peeraddr -> PeerSelectionState peeraddr peerconn -> Bool)
-> PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(Int
 -> Set peeraddr -> PeerSelectionState peeraddr peerconn -> Bool)
-> PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers' (\Int
num Set peeraddr
available PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState 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
                       )

-- | Pick some unknown peers.
--
pickUnknownPeers :: (Ord peeraddr, Functor m, HasCallStack)
                 => PeerSelectionState peeraddr peerconn
                 -> PickPolicy peeraddr m
                 -> Set peeraddr -> Int -> m (Set peeraddr)
{-# INLINE pickUnknownPeers #-}
pickUnknownPeers :: forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m -> Set peeraddr -> Int -> m (Set peeraddr)
pickUnknownPeers = (Int
 -> Set peeraddr -> PeerSelectionState peeraddr peerconn -> Bool)
-> PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m, ?callStack::CallStack) =>
(Int
 -> Set peeraddr -> PeerSelectionState peeraddr peerconn -> Bool)
-> PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers' (\Int
num Set peeraddr
available PeerSelectionState { KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState 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)
                              )

---------------------------
-- 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 $mGuarded :: forall {r} {m :: * -> *} {a}.
Guarded m a -> (Maybe Time -> m a -> r) -> ((# #) -> r) -> r
$bGuarded :: forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
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 $mGuardedSkip :: forall {r} {m :: * -> *} {a}.
Guarded m a -> (Maybe Time -> r) -> ((# #) -> r) -> r
$bGuardedSkip :: forall (m :: * -> *) a. Maybe Time -> Guarded m a
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)


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

         -- | An updated state to use immediately
       forall (m :: * -> *) peeraddr peerconn.
Decision m peeraddr peerconn
-> PeerSelectionState peeraddr peerconn
decisionState :: PeerSelectionState 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 :: * -> *) peeraddr peerconn.
Decision m peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
decisionJobs  :: [Job () m (Completion m 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 peeraddr peerconn = Time -> Decision m peeraddr peerconn

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


newtype Completion m peeraddr peerconn =
        Completion (PeerSelectionState peeraddr peerconn
                 -> Time -> Decision m peeraddr peerconn)

data TracePeerSelection peeraddr =
       TraceLocalRootPeersChanged (LocalRootPeers peeraddr)
                                  (LocalRootPeers peeraddr)
     --
     -- Churn
     --

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

     --
     -- Ledger Peers
     --

     | TracePublicRootsRequest Int Int
     | TracePublicRootsResults (PublicRootPeers 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

     --
     -- Critical Failures
     --
     | TraceOutboundGovernorCriticalFailure SomeException

     --
     -- Debug Tracer
     --

     | TraceDebugState Time (DebugPeerSelectionState peeraddr)
  deriving Int -> TracePeerSelection peeraddr -> ShowS
[TracePeerSelection peeraddr] -> ShowS
TracePeerSelection peeraddr -> String
(Int -> TracePeerSelection peeraddr -> ShowS)
-> (TracePeerSelection peeraddr -> String)
-> ([TracePeerSelection peeraddr] -> ShowS)
-> Show (TracePeerSelection peeraddr)
forall peeraddr.
(Ord peeraddr, Show peeraddr) =>
Int -> TracePeerSelection peeraddr -> ShowS
forall peeraddr.
(Ord peeraddr, Show peeraddr) =>
[TracePeerSelection peeraddr] -> ShowS
forall peeraddr.
(Ord peeraddr, Show peeraddr) =>
TracePeerSelection peeraddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr.
(Ord peeraddr, Show peeraddr) =>
Int -> TracePeerSelection peeraddr -> ShowS
showsPrec :: Int -> TracePeerSelection peeraddr -> ShowS
$cshow :: forall peeraddr.
(Ord peeraddr, Show peeraddr) =>
TracePeerSelection peeraddr -> String
show :: TracePeerSelection peeraddr -> String
$cshowList :: forall peeraddr.
(Ord peeraddr, Show peeraddr) =>
[TracePeerSelection peeraddr] -> ShowS
showList :: [TracePeerSelection 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 peeraddr where
  TraceGovernorState :: forall peeraddr peerconn.
                        Show peerconn
                     => Time            -- blocked time
                     -> Maybe DiffTime  -- wait time
                     -> PeerSelectionState peeraddr peerconn
                     -> DebugPeerSelection peeraddr

deriving instance (Ord peeraddr, Show peeraddr)
               => Show (DebugPeerSelection peeraddr)

data ChurnMode = ChurnModeBulkSync
               | ChurnModeNormal deriving Int -> ChurnMode -> ShowS
[ChurnMode] -> ShowS
ChurnMode -> String
(Int -> ChurnMode -> ShowS)
-> (ChurnMode -> String)
-> ([ChurnMode] -> ShowS)
-> Show ChurnMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChurnMode -> ShowS
showsPrec :: Int -> ChurnMode -> ShowS
$cshow :: ChurnMode -> String
show :: ChurnMode -> String
$cshowList :: [ChurnMode] -> ShowS
showList :: [ChurnMode] -> ShowS
Show