{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE ScopedTypeVariables   #-}

#if __GLASGOW_HASKELL__ < 904
{-# OPTIONS_GHC -Wno-name-shadowing #-}
#endif

-- | This subsystem manages the discovery and selection of /upstream/ peers.
--
module Ouroboros.Network.PeerSelection.Governor
  ( -- * Design overview
    -- $overview
    -- * Peer selection governor
    -- $peer-selection-governor
    PeerSelectionPolicy (..)
  , PeerSelectionTargets (..)
  , PeerSelectionActions (..)
  , PeerSelectionInterfaces (..)
  , PeerStateActions (..)
  , TracePeerSelection (..)
  , ChurnAction (..)
  , DebugPeerSelection (..)
  , AssociationMode (..)
  , readAssociationMode
  , DebugPeerSelectionState (..)
  , peerSelectionGovernor
    -- * Internals exported for testing
  , assertPeerSelectionState
  , sanePeerSelectionTargets
  , establishedPeersStatus
  , PeerSelectionState (..)
  , PublicPeerSelectionState (..)
  , makePublicPeerSelectionStateVar
  , PeerSelectionView (..)
  , PeerSelectionCounters
  , PeerSelectionSetsWithSizes
  , peerSelectionStateToCounters
  , emptyPeerSelectionCounters
  , nullPeerSelectionTargets
  , emptyPeerSelectionState
  , peerSelectionStateToView
  ) where

import Data.Foldable (traverse_)
import Data.Hashable
import Data.Map.Strict (Map)
import Data.Void (Void)

import Control.Applicative (Alternative ((<|>)))
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Concurrent.JobPool (JobPool)
import Control.Concurrent.JobPool qualified as JobPool
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Tracer (Tracer (..), traceWith)
import System.Random

import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Ouroboros.Network.PeerSelection.Governor.ActivePeers qualified as ActivePeers
import Ouroboros.Network.PeerSelection.Governor.BigLedgerPeers qualified as BigLedgerPeers
import Ouroboros.Network.PeerSelection.Governor.EstablishedPeers qualified as EstablishedPeers
import Ouroboros.Network.PeerSelection.Governor.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.Governor.Monitor qualified as Monitor
import Ouroboros.Network.PeerSelection.Governor.RootPeers qualified as RootPeers
import Ouroboros.Network.PeerSelection.Governor.Types
import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.Types (PublicExtraPeersAPI (..))

{- $overview

We have a number of requirements for constructing our connectivity graphs:

 * We must do it in a decentralised way, using only local information;
 * It should avoid and recover from accidental or deliberate partitions or
   eclipse attacks;
 * The graph should give us good performance for block diffusion. This means
   we need the combination of low hop counts, and minimising the hop lengths.
   We want one slot leader to be able to send to the next within the deadline
   in at least 95% of cases.

[\"Small world" graph theory](https://press.princeton.edu/books/paperback/9780691117041/small-worlds)
tells us that we can use random graph construction to make graphs with a low
characteristic path length (i.e. hop count). We can build random graphs with
peer sharing techniques. This deals with our requirement for decentralisation
and our goal of low hop counts.

The remaining significant issues are:

 * the goal of short hop lengths, and
 * avoiding and recovering from partitions and eclipse attacks.

Our design is to augment random peer sharing with two /governors/ (control loops) to
address these two issues. The design is relatively simple, and has the virtue
that the policy for the governors can be adjusted with relatively few
compatibility impacts. This should enable the policy to be optimised based on
real-world feedback, and feedback from simulations of scale or scenarios that
are hard (or undesirable) to test in a real deployment.

Each node maintains three sets of known peer nodes:

 [cold peers]: are peers that are known of but where there is no established
               network connection;

 [warm peers]: are peers where a bearer connection is established but it is used
               only for network measurements and is not used for any application
               level consensus protocols;

 [hot peers]: are peers where the bearer connection is actively used for the
              application level consensus protocols.

Limited information is maintained for these peers, based on previous direct
interactions. For cold nodes this will often be absent as there may have been
no previous direct interactions. This information is comparable with
\"reputation\" in other systems, but it should be emphasised that it is purely
local and not shared with any other node. It is not shared because it is not
necessary and because establishing trust in such information is difficult and
would add additional complexity. The information about peers is kept
persistently across node restarts, but it is always safe to re-bootstrap – as
new nodes must do.

For an individual node to join the network, the bootstrapping phase starts by
contacting root nodes and requesting sets of other peers. Newly discovered
peers are added to the cold peer set. It proceeds iteratively by randomly
selecting other peers to contact to request more known peers. This peer sharing
process is controlled by a governor that has a target to find and maintain a
certain number of cold peers. Bootstrapping is not a special mode, rather it is
just a phase for the governor following starting with a cold peers set
consisting only of the root nodes. This peer sharing aspect is closely analogous
to the first stage of Kademlia, but with random selection rather than selection
directed towards finding peers in an artificial metric space.

The root nodes used in the bootstrapping phase are the stakepool relays
published in the blockchain as part of the stakepool registration process.
See the [Shelley delegation design specification, Sections 3.4.4 and 4.2](https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/delegationDesignSpec/latest/download-by-type/doc-pdf/delegation_design_spec).
As with Bitcoin, a recent snapshot of this root set must be distributed with
the software.

The peer selection governor engages in the following activities:

 * the random peer share used to discover more cold peers;
 * promotion of cold peers to be warm peers;
 * demotion of warm peers to cold peers;
 * promotion of warm peers to hot peers; and
 * demotion of hot peers to warm peers.

The peer selection governor has these goals to establish and maintain:

 * a target number of cold peers (e.g. 1000)
 * a target number of hot peers (e.g. order of 2–20)
 * a target number of warm peers (e.g. order of 10–50)
 * a set of warm peers that are sufficiently diverse in terms of hop distance
 * a target churn frequency for hot\/warm changes
 * a target churn frequency for warm\/cold changes
 * a target churn frequency for cold\/unknown changes

The target churn values are adjusted by the /peer churn governor/, which we
will discuss below.

Local static configuration can also be used to specify that certain known nodes
should be selected as hot or warm peers. This allows for fixed relationships
between nodes controlled by a single organisation, such as a stake pool with
several relays. It also enables private peering relationships between stake
pool operators and other likely deployment scenarios.

Using 5–20 hot peers is not as expensive as it might sound. Keep in mind that
only block headers are sent for each peer. The block body is typically only
requested once. It is also worth noting that the block body will tend to follow
the shortest paths through the connectivity graph formed by the hot peer links.
This is because nodes will typically request the block body from the first node
that sends the block header.

While the purpose of cold and hot peers is clear, the purpose of warm peers
requires further explanation. The primary purpose is to address the challenge
of avoiding too many long hops in the graph. The random peer share is oblivious to
hop distance. By actually connecting to a selection of peers and measuring the
round trip delays we can start to establish which peers are near or far. The
policy for selecting which warm peers to promote to hot peers will take into
account this network hop distance. The purpose of a degree of churn between
cold and warm peers is, in part, to discover the network distance for more
peers and enable further optimisation or adjust to changing conditions. The
purpose of a degree of churn between warm and hot peers is to allow potentially
better warm peers to take over from existing hot peers.

The purpose in maintaining a diversity in hop distances is to assist in
recovery from network events that may disrupt established short paths, such as
internet routing changes, partial loss of connectivity, or accidental formation
of cliques. For example, when a physical infrastructure failure causes the
short paths to a clique of nodes to be lost, if some or all of the nodes in
that clique maintain other longer distance warm links then they can quickly
promote them to hot links and recover. The time to promote from warm to hot
need be no more than one network round trip.

Overall, this approach follows a common pattern for probabilistic search or
optimisation that uses a balance of local optimisation with some elements of
higher order disruption to avoid becoming trapped in some poor local optimum.

The local peer reputation information is also updated when peer connections
fail. The implementation classifies the exceptions that cause connections to
fail into three classes:

 * internal node exceptions e.g. local disk corruption;
 * network failures e.g. dropped TCP connections; and
 * adversarial behaviour, e.g. a protocol violation detected by the
   typed-protocols layer or by the consensus layer.

In the case of adversarial behaviour the peer can be immediately demoted out of
the hot, warm and cold sets. We choose not to maintain negative peer
information for extended periods of time; to bound resources and due to the
simplicity of Sybil attacks.

The peer churn governor deals with the problem of partition and eclipse –
whether malicious or accidental. It adjusts the behaviour of the peer
selection governor over longer time scales. The outer peer churn governor's
actions are:

 * to adjust the target churn frequencies of the peer selection governor for
   promotion\/demotion between the cold\/warm\/hot states
 * partial or total re-bootstrapping under certain circumstances

The peer churn governor monitors the chain growth quality, comparing it with
the stake distribution. The probability of being in a disconnected clique or
being eclipsed is calculated. As this rises the governor increases the target
frequencies for the churn between the hot, warm, cold, and unknown states. In
the worst case it can re-bootstrap the peer discovery entirely by resetting
the set of known peers.
-}

{-

TODO: need to think about managing established connections with upstream/downstream peers in a more symmetric way.

Can we separate that connection management from policy of upstream/downstream selection?

Upstream peers are ones where we choose to talk to them, and we follow their
chain and submit transactions to them. There is a separate subsystem to manage
/downstream/ peers that initiate connections to us.

There is a distinction between which peer chooses to talk to which, and which
peer actually initiates the TCP connection. This is due to the fact that we
reuse TCP connections to run mini-protocols in both directions. So we can
choose to talk to another peer and find that they already initiated a TCP
connection to us, and so we reuse that. For example we can have cases like this:

 1. They initiate the connection to have our node as one of their upstream peers
 2. We decide to reuse the connection to have them as one of our upstream peers
 3. They decide to stop using us as an upstream peer

This is now more or less equivalent to our node having initiated the connection
in the first place because we chose to have them as an upstream peer.


-}


{- $peer-selection-governor

![A 19th century steam governor](https://upload.wikimedia.org/wikipedia/commons/c/c3/Centrifugal_governor_and_balanced_steam_valve_%28New_Catechism_of_the_Steam_Engine%2C_1904%29.jpg)

The 'peerSelectionGovernor' manages the discovery and selection of /upstream/
peers.

We classify (potential or actual) upstream peers in three nested categories:

@
                                                      ▲
                                               forget │
  ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┿━┿━━━━━━━━━━━━┓
  ┃                                                     │ discover   ┃
  ┃  Known peers: the set of all known peers.           ▼            ┃
  ┃  Consists of cold, warm and hot peers.                           ┃
  ┃  Expect ~1000                              demote ▲              ┃
  ┃                                            to cold│              ┃
  ┃ ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┿━┿━━━━━━━━━━┓ ┃
  ┃ ┃                                                   │ promote  ┃ ┃
  ┃ ┃  Established peers: with established bearer.      ▼ to warm  ┃ ┃
  ┃ ┃  Consists of warm and hot peers.                             ┃ ┃
  ┃ ┃  Expect ~10-50                           demote ▲            ┃ ┃
  ┃ ┃                                          to warm│            ┃ ┃
  ┃ ┃ ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┿━┿━━━━━━━━┓ ┃ ┃
  ┃ ┃ ┃                                                 │ promote┃ ┃ ┃
  ┃ ┃ ┃  Active peers: running consensus protocols.     ▼ to hot ┃ ┃ ┃
  ┃ ┃ ┃  Consists of hot peers.                                  ┃ ┃ ┃
  ┃ ┃ ┃  Expect ~2-20                                            ┃ ┃ ┃
  ┃ ┃ ┃                                                          ┃ ┃ ┃
  ┃ ┃ ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛ ┃ ┃
  ┃ ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛ ┃
  ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
@

We define the terms /known/, /established/ and /active/ to be nested sets.
We define the terms /cold/, /warm/ and /hot/ to be disjoint sets. Both
collections of terms are useful. For example there is information we wish to
track for all known peers, irrespective of whether they are cold, warm or hot.

So we have six transitions to consider:

 * discover a cold peer
 * promote a cold peer to warm
 * promote a warm peer to hot
 * demote a hot peer to warm
 * demote a warm peer to cold
 * forget a cold peer

(Excluding the transitions in which any peer determined to be adversarial is
forgotten.)

We want a design that separates the policy from the mechanism. We must
consider what kinds of policy we might like to express and make sure that
information that the policy needs can be made available.

We will consider each case.

== Discovering cold peers

There are two main mechanisms by which we discover cold peers:

 * Externally supplied peer root set
 * Peer Share

=== Externally supplied peer root set

There are a few potential sources for root sets:

 * Simulation environment
 * IP address lists from static or dynamic configuration
 * DNS names from static or dynamic configuration
 * IP addresses or DNS names for stake pools registered in the blockchain

Note that none of these sources are fully static except for IP addresses from
static configuration. DNS name to IP address mappings are potentially dynamic.
DNS names can refer to both IPv4 and IPv6 addresses, and to pools of addresses.

In some cases we wish to advertise these root peers to others, and sometimes
we want to keep them private. In particular the deployment for stake pools may
involve keeping the stake pool node itself private, and only advertising
relays.

For an externally supplied peer root set, we divide the problem in two with an
interface where a root set provider is responsible for managing a time-varying
set of addresses, and the peer selection governor observes the time-varying
value. This allows multiple implementations of the root set provider, which
deal with the various sources.

=== Peer Share

We can ask peers to give us a sample of their set of known peers.

For cold peers we can establish a one-shot connection to ask. For warm peers
we can also ask. We should not ask from the same peer too often. Peers are
expected to return the same set of answers over quite long periods of time.
(This helps peers to distinguish abusive behaviour and reduce the speed with
which the whole network can be mapped.)

So factors we might wish to base our decision on:

 * if we are below the target number of known peers
 * if there are any known peers we have not asked (or attempted to ask)
 * how long since we last asked (so we do not ask too frequently)
 * the known distance of the peer from the root set

This last factor is interesting. Consider what happens if we do a bootstrap
from one root peer. We'll ask it for some more peers and it will give us a
selection. Suppose we pick one of these to get more peers from and it gives us
a similar number of replies. If we now pick the next one randomly from our
combined set we'll have a roughly 50:50 chance of picking from either set.
This approach could quickly lead us into a mostly-depth first exploration of
the graph. But we probably want a more balanced approach between breadth first
and depth first. The traditional ways to do a breadth first or depth first is
to keep a queue or a stack of nodes that have not yet been asked.

Here's another danger: suppose we ask several nodes in parallel but suppose
one gets back to us quicker than all the others. If we are too quick to choose
again then we are giving an advantage to fast peers, and adversaries could
dedicate resources to exploit this to their advantage to get nodes to pick up
more peers from the set supplied by the adversary.

So this suggests that we should not give undue advantage to peers that respond
very quickly, and we should go mostly breadth first, but with a degree of
randomisation.


== Promoting a cold peer to warm

Promoting a cold peer to warm involves establishing a bearer connection. This
is initiated asynchronously and it is either successful or fails after a
timeout.

Once established, we track the connection for the established peer. The
established connection is used later to promote to hot, or to demote back to
cold. It is also used to be notified if the connection fails for any reason.

== Promoting a warm peer to hot

Promoting a warm peer to hot involves sending messages on the established
bearer to switch mode from the network protocol used with warm peers, to the
full set of consensus protocols used for hot peers.

== Demoting a hot peer to warm

If we have more hot peers than our target number (or target range) then we
want to pick one to demote. One policy is to pick randomly. It is likely to be
better to to pick the peer that is in some sense least useful.

One plausible measure of a peer being least useful is based on the following:
for blocks we adopt into our chain, look at which peer(s) received that header
first. A peer that is never first (or very rarely) is one that is likely to be
downstream from us and hence not useful as a choice of upstream peer. A peer
that is normally behind all others, but sometimes (even rarely) is first is
still useful, since it shows it's an upstream connection to some part of the
network where there are active block producers. Consider the case of a relay
in Europe with one connection to Australia: sometimes blocks will be produced
in Australia and so that connection may be first in those cases.

Tracking the necessary information for this policy would require a separate
component that observes the current chain and the peer candidate chains. Using
this information would need access to that shared state. So we should conclude
that the policy should not be pure as it may need access to such changing state.

== Demoting a warm peer to cold


== Forgetting cold peers

We will always forget known peers when the connection is terminated due to
detected adversarial behaviour. The remaining policy decision is which peers
to forget when we have more than our target number of known peers. We will
only select from the known peers that are cold. Warm or hot known peers have
to first be demoted to cold before we consider them to be forgotten.

We want to pick the least useful cold peers to forget. Factors we may wish to
base our decision on include:

 * Number of unsuccessful connection attempts since last successful connection
 * Pseudo-random selection: some degree of randomness can help mitigate
   accidental systematic correlations or some degree of adversarial behaviour.

-}

-- |
--
peerSelectionGovernor :: ( Alternative (STM m)
                         , MonadAsync m
                         , MonadDelay m
                         , MonadLabelledSTM m
                         , MonadMask m
                         , MonadTimer m
                         , Ord peeraddr
                         , Show peerconn
                         , Hashable peeraddr
                         , Exception exception
                         , Eq extraCounters
                         , Semigroup extraPeers
                         , Eq extraFlags
                         )
                      => Tracer m (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
                      -> Tracer m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
                      -> Tracer m (PeerSelectionCounters extraCounters)
                      -> PeerSelectionGovernorArgs
                          extraState extraDebugState extraFlags extraPeers extraAPI extraCounters
                          peeraddr peerconn exception m
                      -> StdGen
                      -> extraState
                      -> extraPeers
                      -> PeerSelectionActions
                          extraState extraFlags extraPeers extraAPI extraCounters
                          peeraddr peerconn m
                      -> PeerSelectionPolicy  peeraddr m
                      -> PeerSelectionInterfaces
                           extraState extraFlags extraPeers extraCounters
                           peeraddr peerconn m
                      -> m Void
peerSelectionGovernor :: forall (m :: * -> *) peeraddr peerconn exception extraCounters
       extraPeers extraFlags extraDebugState extraState extraAPI.
(Alternative (STM m), MonadAsync m, MonadDelay m,
 MonadLabelledSTM m, MonadMask m, MonadTimer m, Ord peeraddr,
 Show peerconn, Hashable peeraddr, Exception exception,
 Eq extraCounters, Semigroup extraPeers, Eq extraFlags) =>
Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     exception
     m
-> StdGen
-> extraState
-> extraPeers
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> m Void
peerSelectionGovernor Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
tracer Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
debugTracer Tracer m (PeerSelectionCounters extraCounters)
countersTracer PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
peerSelectionArgs StdGen
fuzzRng
                      extraState
extraState extraPeers
extraPeers PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionPolicy peeraddr m
policy PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
interfaces =
    (JobPool
   ()
   m
   (Completion
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)
 -> m Void)
-> m Void
forall group (m :: * -> *) a b.
(MonadAsync m, MonadThrow m, MonadLabelledSTM m) =>
(JobPool group m a -> m b) -> m b
JobPool.withJobPool ((JobPool
    ()
    m
    (Completion
       m
       extraState
       extraDebugState
       extraFlags
       extraPeers
       peeraddr
       peerconn)
  -> m Void)
 -> m Void)
-> (JobPool
      ()
      m
      (Completion
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn)
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \JobPool
  ()
  m
  (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
jobPool ->
      Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     exception
     m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> JobPool
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> m Void
forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers extraAPI extraCounters exception peeraddr peerconn.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadMask m,
 MonadTimer m, Ord peeraddr, Show peerconn, Hashable peeraddr,
 Exception exception, Eq extraCounters, Semigroup extraPeers,
 Eq extraFlags) =>
Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     exception
     m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> JobPool
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> m Void
peerSelectionGovernorLoop
        Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
tracer
        Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
debugTracer
        Tracer m (PeerSelectionCounters extraCounters)
countersTracer
        PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
peerSelectionArgs
        PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions
        PeerSelectionPolicy peeraddr m
policy
        PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
interfaces
        JobPool
  ()
  m
  (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
jobPool
        (StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
forall extraState extraPeers extraFlags peeraddr peerconn.
StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
emptyPeerSelectionState StdGen
fuzzRng extraState
extraState extraPeers
extraPeers)

-- | Our pattern here is a loop with two sets of guarded actions:
--
-- * Actions guarded on predicates on the current immutable state, e.g.
--   * below known peer targets & below in-progress limit
--
-- * Actions guarded by blocking and waiting for state changes, e.g.
--   * root peer set changed
--   * churn timeout
--   * async action completed
--   * established connection failed
--
-- We check the internal actions first, and otherwise the blocking actions.
-- In each case we trace the action, update the state and execute the
-- action asynchronously.
--
peerSelectionGovernorLoop :: forall m extraState extraDebugState extraFlags extraPeers extraAPI extraCounters exception peeraddr peerconn.
                             ( Alternative (STM m)
                             , MonadAsync m
                             , MonadDelay m
                             , MonadMask m
                             , MonadTimer m
                             , Ord peeraddr
                             , Show peerconn
                             , Hashable peeraddr
                             , Exception exception
                             , Eq extraCounters
                             , Semigroup extraPeers
                             , Eq extraFlags
                             )
                          => Tracer m (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
                          -> Tracer m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
                          -> Tracer m (PeerSelectionCounters extraCounters)
                          -> PeerSelectionGovernorArgs
                              extraState extraDebugState extraFlags extraPeers extraAPI extraCounters
                              peeraddr peerconn exception m
                          -> PeerSelectionActions
                              extraState extraFlags extraPeers extraAPI extraCounters
                              peeraddr peerconn m
                          -> PeerSelectionPolicy peeraddr m
                          -> PeerSelectionInterfaces
                              extraState extraFlags extraPeers extraCounters
                              peeraddr peerconn m
                          -> JobPool () m (Completion m extraState extraDebugState extraFlags extraPeers peeraddr peerconn)
                          -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                          -> m Void
peerSelectionGovernorLoop :: forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers extraAPI extraCounters exception peeraddr peerconn.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadMask m,
 MonadTimer m, Ord peeraddr, Show peerconn, Hashable peeraddr,
 Exception exception, Eq extraCounters, Semigroup extraPeers,
 Eq extraFlags) =>
Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     exception
     m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> JobPool
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> m Void
peerSelectionGovernorLoop Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
tracer
                          Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
debugTracer
                          Tracer m (PeerSelectionView extraCounters Int)
countersTracer
                          PeerSelectionGovernorArgs {
                            Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Maybe exception
abortGovernor :: Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Maybe exception
abortGovernor :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn exception (m :: * -> *).
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Maybe exception
abortGovernor
                          , PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionSetsWithSizes extraCounters peeraddr
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> STM m ()
updateWithState :: PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionSetsWithSizes extraCounters peeraddr
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> STM m ()
updateWithState :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn exception (m :: * -> *).
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionSetsWithSizes extraCounters peeraddr
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> STM m ()
updateWithState
                          , extraDecisions :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn exception (m :: * -> *).
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  exception
  m
-> ExtraGuardedDecisions
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
extraDecisions = ExtraGuardedDecisions {
                              MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
preBlocking :: MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
preBlocking :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
preBlocking
                            , MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
postBlocking :: MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
postBlocking :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
postBlocking
                            , MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
postNonBlocking :: MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
postNonBlocking :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
postNonBlocking
                            , Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
customTargetsAction :: Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
customTargetsAction :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Maybe
     (MonitoringAction
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraAPI
        extraCounters
        peeraddr
        peerconn
        m)
customTargetsAction
                            , Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
customLocalRootsAction :: Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
customLocalRootsAction :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Maybe
     (MonitoringAction
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraAPI
        extraCounters
        peeraddr
        peerconn
        m)
customLocalRootsAction
                            , extraState -> Bool
enableProgressMakingActions :: extraState -> Bool
enableProgressMakingActions :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> extraState -> Bool
enableProgressMakingActions
                            , extraState -> extraState
ledgerPeerSnapshotExtraStateChange :: extraState -> extraState
ledgerPeerSnapshotExtraStateChange :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
ExtraGuardedDecisions
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> extraState -> extraState
ledgerPeerSnapshotExtraStateChange
                            }
                          }
                          actions :: PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions@PeerSelectionActions {
                            extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI = PublicExtraPeersAPI {
                              extraPeers -> Set peeraddr
extraPeersToSet :: extraPeers -> Set peeraddr
extraPeersToSet :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr
extraPeersToSet
                            , extraPeers -> Bool
invariantExtraPeers :: extraPeers -> Bool
invariantExtraPeers :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr -> extraPeers -> Bool
invariantExtraPeers
                            }
                          , PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters
                          }

                          PeerSelectionPolicy peeraddr m
policy
                          interfaces :: PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
interfaces@PeerSelectionInterfaces {
                            StrictTVar m (PeerSelectionView extraCounters Int)
countersVar :: StrictTVar m (PeerSelectionView extraCounters Int)
countersVar :: forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> StrictTVar m (PeerSelectionCounters extraCounters)
countersVar,
                            StrictTVar m (PublicPeerSelectionState peeraddr)
publicStateVar :: StrictTVar m (PublicPeerSelectionState peeraddr)
publicStateVar :: forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> StrictTVar m (PublicPeerSelectionState peeraddr)
publicStateVar,
                            StrictTVar
  m
  (PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn)
debugStateVar :: StrictTVar
  m
  (PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn)
debugStateVar :: forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> StrictTVar
     m
     (PeerSelectionState
        extraState extraFlags extraPeers peeraddr peerconn)
debugStateVar
                          }
                          JobPool
  ()
  m
  (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
jobPool
                          PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
pst = do
    PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time -> m Void
loop PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
pst (DiffTime -> Time
Time DiffTime
0) m Void -> (SomeException -> m Void) -> m Void
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\SomeException
e -> Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
tracer (SomeException
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
SomeException
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TraceOutboundGovernorCriticalFailure SomeException
e) m () -> m Void -> m Void
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m Void
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e)
  where
    loop :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
         -> Time
         -> m Void
    loop :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time -> m Void
loop !PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st !Time
dbgUpdateAt = (extraPeers -> Set peeraddr)
-> (extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> m Void
-> m Void
forall peeraddr extraPeers extraState extraFlags peerconn a.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> a
-> a
assertPeerSelectionState extraPeers -> Set peeraddr
extraPeersToSet extraPeers -> Bool
invariantExtraPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st (m Void -> m Void) -> m Void -> m Void
forall a b. (a -> b) -> a -> b
$ do
      -- Update public state using 'toPublicState' to compute available peers
      -- to share for peer sharing
      STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar m (PublicPeerSelectionState peeraddr)
-> PublicPeerSelectionState peeraddr -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m (PublicPeerSelectionState peeraddr)
publicStateVar (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicPeerSelectionState peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicPeerSelectionState peeraddr
toPublicState PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)

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

      -- | If there's something utterly wrong with the PeerSelectionState such
      -- that the abortion of the Governor is required.
      case abortGovernor blockedAt st of
        Maybe exception
Nothing        -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just exception
exception -> exception -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO exception
exception

      dbgUpdateAt' <- if dbgUpdateAt <= blockedAt
                         then do
                           atomically $ writeTVar debugStateVar st
                           return $ 83 `addTime` blockedAt
                         else return dbgUpdateAt
      let knownPeers'       = Time -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Time -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.setCurrentTime Time
blockedAt (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)
          establishedPeers' = Time
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peerconn.
Ord peeraddr =>
Time
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
EstablishedPeers.setCurrentTime Time
blockedAt (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)
          st'               = PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st { knownPeers       = knownPeers',
                                   establishedPeers = establishedPeers' }

      timedDecision <- evalGuardedDecisions blockedAt st'

      -- get the current time after the governor returned from the blocking
      -- 'evalGuardedDecisions' call.
      now <- getMonotonicTime

      let Decision { decisionTrace, decisionJobs, decisionState = st'' } =
            timedDecision now

      mbCounters <- atomically $ do
        let peerSelectionView =
              (extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraCounters)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionSetsWithSizes extraCounters peeraddr
forall peeraddr extraPeers extraState extraFlags peerconn
       extraViews.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraViews)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionSetsWithSizes extraViews peeraddr
peerSelectionStateToView extraPeers -> Set peeraddr
extraPeersToSet PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st''

        -- Custom STM actions
        updateWithState interfaces actions peerSelectionView st''

        -- Update counters
        counters <- readTVar countersVar
        let !counters' = (Set peeraddr, Int) -> Int
forall a b. (a, b) -> b
snd ((Set peeraddr, Int) -> Int)
-> PeerSelectionSetsWithSizes extraCounters peeraddr
-> PeerSelectionView extraCounters Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerSelectionSetsWithSizes extraCounters peeraddr
peerSelectionView
        if counters' /= counters
          then writeTVar countersVar counters'
            >> return (Just counters')
          else return Nothing

      -- Trace counters
      traverse_ (traceWith countersTracer) mbCounters
      -- Trace peer selection
      traverse_ (traceWith tracer) decisionTrace

      mapM_ (JobPool.forkJob jobPool) decisionJobs
      loop st'' dbgUpdateAt'

    evalGuardedDecisions :: Time
                         -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                         -> m (TimedDecision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn)
    evalGuardedDecisions :: Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> m (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
evalGuardedDecisions Time
blockedAt PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st = do
      inboundPeers <- PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> m (Map peeraddr PeerSharing)
forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> m (Map peeraddr PeerSharing)
readInboundPeers PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions
      case guardedDecisions blockedAt st inboundPeers of
        GuardedSkip Maybe Time
_ ->
          -- impossible since guardedDecisions always has something to wait for
          [Char]
-> m (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. HasCallStack => [Char] -> a
error [Char]
"peerSelectionGovernorLoop: impossible: nothing to do"

        Guarded Maybe Time
Nothing STM
  m
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
decisionAction -> do
          Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
debugTracer (Time
-> Maybe DiffTime
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
Show peerconn =>
Time
-> Maybe DiffTime
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
TraceGovernorState Time
blockedAt Maybe DiffTime
forall a. Maybe a
Nothing PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)
          STM
  m
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> m (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM
  m
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
decisionAction

        Guarded (Just Time
wakeupAt) STM
  m
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
decisionAction -> do
          let wakeupIn :: DiffTime
wakeupIn = Time -> Time -> DiffTime
diffTime Time
wakeupAt Time
blockedAt
          Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
debugTracer (Time
-> Maybe DiffTime
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
Show peerconn =>
Time
-> Maybe DiffTime
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
TraceGovernorState Time
blockedAt (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
wakeupIn) PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)
          (readTimeout, cancelTimeout) <- DiffTime -> m (STM m TimeoutState, m ())
forall (m :: * -> *).
MonadTimer m =>
DiffTime -> m (STM m TimeoutState, m ())
registerDelayCancellable DiffTime
wakeupIn
          let wakeup = STM m TimeoutState
readTimeout STM m TimeoutState
-> (TimeoutState
    -> STM
         m
         (TimedDecision
            m
            extraState
            extraDebugState
            extraFlags
            extraPeers
            peeraddr
            peerconn))
-> STM
     m
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\case TimeoutState
TimeoutPending -> STM
  m
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
                                              TimeoutState
_              -> TimedDecision
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> STM
     m
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
forall extraState extraFlags extraPeers peeraddr peerconn
       (m :: * -> *) extraDebugState.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
wakeupDecision PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st))
          timedDecision <- atomically (decisionAction <|> wakeup)
          cancelTimeout
          return timedDecision

    guardedDecisions :: Time
                     -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
                     -> Map peeraddr PeerSharing
                     -> Guarded (STM m) (TimedDecision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn)
    guardedDecisions :: Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Map peeraddr PeerSharing
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
guardedDecisions Time
blockedAt PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st Map peeraddr PeerSharing
inboundPeers =
      -- All the alternative potentially-blocking decisions.

        -- Make sure preBlocking set is in the right place
        MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
preBlocking PeerSelectionPolicy peeraddr m
policy PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr peerconn.
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
Monitor.connections          PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> JobPool
  ()
  m
  (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
MonadSTM m =>
JobPool
  ()
  m
  (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
Monitor.jobs                 JobPool
  ()
  m
  (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
jobPool PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
      -- This job monitors for changes in big ledger peer snapshot file (eg. reload)
      -- and copies it into the governor's private state. When a change is detected,
      -- it also makes a constant extraState change.
      -- If the verification job detects a discrepancy vs. big peers on the ledger,
      -- it throws and the node is shut down.
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> (extraState -> extraState)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) extraState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn extraDebugState.
MonadSTM m =>
(extraState -> extraState)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
Monitor.ledgerPeerSnapshotChange extraState -> extraState
ledgerPeerSnapshotExtraStateChange PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> case Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
customTargetsAction of
          Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
Nothing             -> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) peeraddr extraState extraFlags extraPeers
       extraAPI extraCounters peerconn extraDebugState.
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
Monitor.targetPeers PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
          Just MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
targetsActions -> MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
targetsActions PeerSelectionPolicy peeraddr m
policy PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> case Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
customLocalRootsAction of
          Maybe
  (MonitoringAction
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m)
Nothing                -> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
(MonadSTM m, Ord peeraddr, Eq extraFlags) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
Monitor.localRoots PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
          Just MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
localRootsActions -> MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
localRootsActions PeerSelectionPolicy peeraddr m
policy PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

         -- Make sure postBlocking set is in the right place
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
postBlocking PeerSelectionPolicy peeraddr m
policy PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

        -- The non-blocking decisions regarding (known) big ledger peers
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> (extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) peeraddr extraPeers extraState extraFlags
       extraAPI extraCounters peerconn extraDebugState.
(MonadSTM m, Ord peeraddr, Semigroup extraPeers) =>
(extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
BigLedgerPeers.belowTarget extraState -> Bool
enableProgressMakingActions
                                    PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions Time
blockedAt PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall (m :: * -> *) extraState extraDebugState extraFlags extraAPI
       extraPeers extraCounters peeraddr peerconn.
(Alternative (STM m), MonadSTM m, Ord peeraddr, HasCallStack) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
BigLedgerPeers.aboveTarget  PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      -- All the alternative non-blocking internal decisions.
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) peeraddr extraPeers extraState extraFlags
       extraAPI extraCounters peerconn extraDebugState.
(MonadSTM m, Ord peeraddr, Semigroup extraPeers) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
RootPeers.belowTarget   PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions Time
blockedAt PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> (extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> Time
-> Map peeraddr PeerSharing
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall (m :: * -> *) peeraddr extraState extraFlags extraPeers
       extraAPI extraCounters peerconn extraDebugState.
(MonadAsync m, MonadTimer m, Ord peeraddr, Hashable peeraddr) =>
(extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> Time
-> Map peeraddr PeerSharing
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
KnownPeers.belowTarget  extraState -> Bool
enableProgressMakingActions
                                 PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions Time
blockedAt Map peeraddr PeerSharing
inboundPeers PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall (m :: * -> *) peeraddr extraState extraFlags extraPeers
       extraAPI extraCounters peerconn extraDebugState.
(MonadSTM m, Ord peeraddr, HasCallStack) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
KnownPeers.aboveTarget  PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions                        PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> (extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
(Alternative (STM m), MonadSTM m, Ord peeraddr) =>
(extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
EstablishedPeers.belowTarget extraState -> Bool
enableProgressMakingActions
                                      PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
(Alternative (STM m), MonadSTM m, Ord peeraddr) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
EstablishedPeers.aboveTarget PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> (extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
(Alternative (STM m), MonadDelay m, MonadSTM m, Ord peeraddr,
 HasCallStack) =>
(extraState -> Bool)
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
ActivePeers.belowTarget extraState -> Bool
enableProgressMakingActions
                                 PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraCounters peeraddr peerconn (m :: * -> *).
(Alternative (STM m), MonadSTM m, Ord peeraddr, HasCallStack) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> MkGuardedDecision
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
     m
ActivePeers.aboveTarget PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionPolicy peeraddr m
policy PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

         -- Make sure postNonBlocking set is in the right place
      Guarded
  (STM m)
  (TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. Semigroup a => a -> a -> a
<> MonitoringAction
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
postNonBlocking PeerSelectionPolicy peeraddr m
policy PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

      -- There is no rootPeersAboveTarget since the roots target is one sided.

      -- The changedTargets needs to come before the changedLocalRootPeers in
      -- the list of alternates above because our invariant requires that
      -- the number of root nodes be less than our target for known peers,
      -- but at startup our initial targets are 0, so we need to read and set
      -- the targets before we set the root peer set. Otherwise we violate our
      -- invariant (and if we ignored that, we'd try to immediately forget
      -- roots peers because we'd be above target for known peers).


wakeupDecision :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
               -> TimedDecision m extraState extraDebugState extraFlags extraPeers peeraddr peerconn
wakeupDecision :: forall extraState extraFlags extraPeers peeraddr peerconn
       (m :: * -> *) extraDebugState.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
wakeupDecision PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st Time
_now =
  Decision {
    decisionTrace :: [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
decisionTrace = [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
TraceGovernorWakeup],
    decisionState :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
decisionState = PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st { stdGen = fst (split (stdGen st)) } ,
    decisionJobs :: [Job
   ()
   m
   (Completion
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)]
decisionJobs  = []
  }


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