{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE KindSignatures           #-}
{-# LANGUAGE NamedFieldPuns           #-}
{-# LANGUAGE RankNTypes               #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE TypeOperators            #-}

#if !defined(mingw32_HOST_OS)
#define POSIX
#endif

-- | This module is expected to be imported qualified (it will clash
-- with the "Ouroboros.Network.Diffusion.NonP2P").
--
module Ouroboros.Network.Diffusion.P2P
  ( TracersExtra (..)
  , nullTracers
  , ArgumentsExtra (..)
  , AcceptedConnectionsLimit (..)
  , ApplicationsExtra (..)
  , run
  , Interfaces (..)
  , runM
  , NodeToNodePeerConnectionHandle
    -- * Re-exports
  , AbstractTransitionTrace
  , RemoteTransitionTrace
  ) where


import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadMVar (MonadMVar)
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadAsync (Async, MonadAsync)
import Control.Monad.Class.MonadAsync qualified as Async
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Monad.Fix (MonadFix)
import Control.Tracer (Tracer, contramap, nullTracer, traceWith)
import Data.ByteString.Lazy (ByteString)
import Data.Foldable (asum)
import Data.Hashable (Hashable)
import Data.IP (IP)
import Data.IP qualified as IP
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, maybeToList)
import Data.Typeable (Typeable)
import Data.Void (Void)
import GHC.IO.Exception (IOException (..), IOErrorType (..))
import System.Exit (ExitCode)
import System.Random (StdGen, newStdGen, split)
#ifdef POSIX
import System.Posix.Signals qualified as Signals
#endif

import Network.Socket (Socket)
import Network.Socket qualified as Socket

import Network.Mux qualified as Mx

import Ouroboros.Network.Snocket (FileDescriptor, LocalAddress,
           LocalSocket (..), Snocket, localSocketFileDescriptor,
           makeLocalBearer, makeSocketBearer)
import Ouroboros.Network.Snocket qualified as Snocket

import Ouroboros.Network.BlockFetch
import Ouroboros.Network.ConnectionId
import Ouroboros.Network.Context (ExpandedInitiatorContext, ResponderContext)
import Ouroboros.Network.Protocol.Handshake
import Ouroboros.Network.Protocol.Handshake.Codec
import Ouroboros.Network.Protocol.Handshake.Version
import Ouroboros.Network.Socket (configureSocket, configureSystemdSocket)

import Ouroboros.Network.ConnectionHandler
import Ouroboros.Network.ConnectionManager.Core qualified as CM
import Ouroboros.Network.ConnectionManager.InformationChannel
           (newInformationChannel)
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.Diffusion.Common hiding (nullTracers)
import Ouroboros.Network.Diffusion.Policies qualified as Diffusion.Policies
import Ouroboros.Network.Diffusion.Utils
import Ouroboros.Network.ExitPolicy
import Ouroboros.Network.InboundGovernor (RemoteTransitionTrace)
import Ouroboros.Network.InboundGovernor qualified as InboundGovernor
import Ouroboros.Network.IOManager
import Ouroboros.Network.Mux hiding (MiniProtocol (..))
import Ouroboros.Network.MuxMode
import Ouroboros.Network.NodeToClient (NodeToClientVersion (..),
           NodeToClientVersionData)
import Ouroboros.Network.NodeToClient qualified as NodeToClient
import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..),
           DiffusionMode (..), NodeToNodeVersion (..),
           NodeToNodeVersionData (..), RemoteAddress)
import Ouroboros.Network.NodeToNode qualified as NodeToNode
import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
import Ouroboros.Network.PeerSelection.Churn (PeerChurnArgs (..))
import Ouroboros.Network.PeerSelection.Governor qualified as Governor
import Ouroboros.Network.PeerSelection.Governor.Types
           (ChurnMode (ChurnModeNormal), ConsensusModePeerTargets (..),
           DebugPeerSelection (..), PeerSelectionActions, PeerSelectionCounters,
           PeerSelectionInterfaces (..), PeerSelectionPolicy (..),
           PeerSelectionState, TracePeerSelection (..),
           emptyPeerSelectionCounters, emptyPeerSelectionState)
#ifdef POSIX
import Ouroboros.Network.PeerSelection.Governor.Types
           (makeDebugPeerSelectionState)
#endif
import Ouroboros.Network.PeerSelection.LedgerPeers (TraceLedgerPeers,
           WithLedgerPeersArgs (..))
#ifdef POSIX
import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot,
           LedgerPeersConsensusInterface (..), MinBigLedgerPeersForTrustedState,
           UseLedgerPeers)
import Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics,
           fetchynessBlocks, upstreamyness)
#else
import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot,
           MinBigLedgerPeersForTrustedState, UseLedgerPeers)
import Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics)
#endif
import Ouroboros.Network.ConsensusMode
import Ouroboros.Network.PeerSelection.PeerSelectionActions
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.PeerSelection.PeerStateActions (PeerConnectionHandle,
           PeerSelectionActionsTrace (..), PeerStateActionsArguments (..),
           pchPeerSharing, withPeerStateActions)
import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint)
import Ouroboros.Network.PeerSelection.RootPeersDNS
import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSActions,
           DNSLookupType (..), ioDNSActions)
import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers
           (TraceLocalRootPeers)
import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers
           (TracePublicRootPeers)
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSharing (PeerSharingRegistry (..))
import Ouroboros.Network.RethrowPolicy
import Ouroboros.Network.Server2 qualified as Server

-- | P2P DiffusionTracers Extras
--
data TracersExtra ntnAddr ntnVersion ntnVersionData
                  ntcAddr ntcVersion ntcVersionData
                  resolverError m =
    TracersExtra {
      forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer
        :: Tracer m (TraceLocalRootPeers ntnAddr resolverError)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
        :: Tracer m TracePublicRootPeers

      -- | Ledger Peers tracer
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer
        :: Tracer m TraceLedgerPeers

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
        :: Tracer m (TracePeerSelection ntnAddr)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorTracer
        :: Tracer m (DebugPeerSelection ntnAddr)

      -- TODO: can be unified with the previous one
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer
        :: Tracer m (DebugPeerSelection ntnAddr)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
        :: Tracer m PeerSelectionCounters

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m ChurnCounters
dtTraceChurnCounters
        :: Tracer m Governor.ChurnCounters

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer
        :: Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer
        :: Tracer m (CM.Trace
                      ntnAddr
                      (ConnectionHandlerTrace
                         ntnVersion
                         ntnVersionData))

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer
        :: Tracer m (AbstractTransitionTrace ntnAddr)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntnAddr)
dtServerTracer
        :: Tracer m (Server.Trace ntnAddr)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntnAddr)
dtInboundGovernorTracer
        :: Tracer m (InboundGovernor.Trace ntnAddr)

    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer
        :: Tracer m (RemoteTransitionTrace ntnAddr)

      --
      -- NodeToClient tracers
      --

      -- | Connection manager tracer for local clients
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer
        :: Tracer m (CM.Trace
                       ntcAddr
                       (ConnectionHandlerTrace
                          ntcVersion
                          ntcVersionData))

      -- | Server tracer for local clients
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntcAddr)
dtLocalServerTracer
        :: Tracer m (Server.Trace ntcAddr)

      -- | Inbound protocol governor tracer for local clients
    , forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer
        :: Tracer m (InboundGovernor.Trace ntcAddr)
    }

nullTracers :: Applicative m
            => TracersExtra ntnAddr ntnVersion ntnVersionData
                            ntcAddr ntcVersion ntcVersionData
                            resolverError m
nullTracers :: forall (m :: * -> *) ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData resolverError.
Applicative m =>
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
nullTracers =
    TracersExtra {
        dtTraceLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer                  = Tracer m (TraceLocalRootPeers ntnAddr resolverError)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTracePublicRootPeersTracer :: Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer                 = Tracer m TracePublicRootPeers
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTraceLedgerPeersTracer :: Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer                     = Tracer m TraceLedgerPeers
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTracePeerSelectionTracer :: Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer                   = Tracer m (TracePeerSelection ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTraceChurnCounters :: Tracer m ChurnCounters
dtTraceChurnCounters                         = Tracer m ChurnCounters
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtDebugPeerSelectionInitiatorTracer :: Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorTracer          = Tracer m (DebugPeerSelection ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtDebugPeerSelectionInitiatorResponderTracer :: Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer = Tracer m (DebugPeerSelection ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTracePeerSelectionCounters :: Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters                 = Tracer m PeerSelectionCounters
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtPeerSelectionActionsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer                 = Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtConnectionManagerTracer :: Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer                    = Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtConnectionManagerTransitionTracer :: Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer          = Tracer m (AbstractTransitionTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtServerTracer :: Tracer m (Trace ntnAddr)
dtServerTracer                               = Tracer m (Trace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtInboundGovernorTracer :: Tracer m (Trace ntnAddr)
dtInboundGovernorTracer                      = Tracer m (Trace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtInboundGovernorTransitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer            = Tracer m (RemoteTransitionTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalConnectionManagerTracer :: Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer               = Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalServerTracer :: Tracer m (Trace ntcAddr)
dtLocalServerTracer                          = Tracer m (Trace ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalInboundGovernorTracer :: Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer                 = Tracer m (Trace ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    }

-- | P2P Arguments Extras
--
data ArgumentsExtra m = ArgumentsExtra {
      -- | selection targets for the peer governor
      --
      forall (m :: * -> *). ArgumentsExtra m -> ConsensusModePeerTargets
daPeerTargets            :: ConsensusModePeerTargets

    , forall (m :: * -> *).
ArgumentsExtra m -> STM m (Config RelayAccessPoint)
daReadLocalRootPeers     :: STM m (LocalRootPeers.Config RelayAccessPoint)
    , forall (m :: * -> *).
ArgumentsExtra m -> STM m (Map RelayAccessPoint PeerAdvertise)
daReadPublicRootPeers    :: STM m (Map RelayAccessPoint PeerAdvertise)
    -- | When syncing up, ie. ledgerStateJudgement == TooOld,
    -- when this is True we will maintain connection with many big ledger peers
    -- to get a strong guarantee that when syncing up we will finish with a true
    -- ledger state. When false, we will fall back on the previous algorithms
    -- that leverage UseBootstrapPeers flag
    , forall (m :: * -> *). ArgumentsExtra m -> ConsensusMode
daConsensusMode                    :: ConsensusMode
    -- | For Genesis, this sets the floor for minimum number of
    --   active big ledger peers we must be connected to in order
    --   to be able to signal trusted state (OutboundConnectionsState)
    , forall (m :: * -> *).
ArgumentsExtra m -> MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState
    , forall (m :: * -> *). ArgumentsExtra m -> STM m UseBootstrapPeers
daReadUseBootstrapPeers            :: STM m UseBootstrapPeers
    -- | Depending on configuration, node may provide us with
    -- a snapshot of big ledger peers taken at some slot on the chain.
    -- These peers may be selected by ledgerPeersThread when requested
    -- by the peer selection governor when the node is syncing up.
    -- This is especially useful for Genesis consensus mode.
    , forall (m :: * -> *).
ArgumentsExtra m -> STM m (Maybe LedgerPeerSnapshot)
daReadLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)

    -- | Peer's own PeerSharing value.
    --
    -- This value comes from the node's configuration file and is static.
    , forall (m :: * -> *). ArgumentsExtra m -> PeerSharing
daOwnPeerSharing         :: PeerSharing
    , forall (m :: * -> *). ArgumentsExtra m -> STM m UseLedgerPeers
daReadUseLedgerPeers     :: STM m UseLedgerPeers

      -- | Timeout which starts once all responder protocols are idle. If the
      -- responders stay idle for duration of the timeout, the connection will
      -- be demoted, if it wasn't used by the p2p-governor it will be closed.
      --
      -- Applies to 'Unidirectional' as well as 'Duplex' /node-to-node/
      -- connections.
      --
      -- See 'serverProtocolIdleTimeout'.
      --
    , forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daProtocolIdleTimeout    :: DiffTime

      -- | Time for which /node-to-node/ connections are kept in
      -- 'TerminatingState', it should correspond to the OS configured @TCP@
      -- @TIME_WAIT@ timeout.
      --
      -- This timeout will apply to after a connection has been closed, its
      -- purpose is to be resilient for delayed packets in the same way @TCP@
      -- is using @TIME_WAIT@.
      --
    , forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daTimeWaitTimeout        :: DiffTime

      -- | Churn interval between churn events in deadline mode.  A small fuzz
      -- is added (max 10 minutes) so that not all nodes churn at the same time.
      --
      -- By default it is set to 3300 seconds.
      --
    , forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daDeadlineChurnInterval  :: DiffTime

      -- | Churn interval between churn events in bulk sync mode.  A small fuzz
      -- is added (max 1 minute) so that not all nodes churn at the same time.
      --
      -- By default it is set to 300 seconds.
      --
    , forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daBulkChurnInterval      :: DiffTime
    }

--
-- Constants
--

-- | Protocol inactivity timeout for local (e.g. /node-to-client/) connections.
--
local_PROTOCOL_IDLE_TIMEOUT :: DiffTime
local_PROTOCOL_IDLE_TIMEOUT :: DiffTime
local_PROTOCOL_IDLE_TIMEOUT = DiffTime
2 -- 2 seconds

-- | Used to set 'cmWaitTimeout' for local (e.g. /node-to-client/) connections.
--
local_TIME_WAIT_TIMEOUT :: DiffTime
local_TIME_WAIT_TIMEOUT :: DiffTime
local_TIME_WAIT_TIMEOUT = DiffTime
0


socketAddressType :: Socket.SockAddr -> Maybe AddressType
socketAddressType :: SockAddr -> Maybe AddressType
socketAddressType Socket.SockAddrInet {}  = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv4Address
socketAddressType Socket.SockAddrInet6 {} = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv6Address
socketAddressType Socket.SockAddrUnix {}  = Maybe AddressType
forall a. Maybe a
Nothing


-- | P2P Applications Extras
--
-- TODO: we need initiator only mode for Daedalus, there's no reason why it
-- should run a node-to-node server side.
--
data ApplicationsExtra ntnAddr m a =
    ApplicationsExtra {
    -- | /node-to-node/ rethrow policy
    --
      forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> RethrowPolicy
daRethrowPolicy       :: RethrowPolicy

    -- | /node-to-node/ return policy
    --
    , forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> ReturnPolicy a
daReturnPolicy        :: ReturnPolicy a

    -- | /node-to-client/ rethrow policy
    --
    , forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> RethrowPolicy
daLocalRethrowPolicy  :: RethrowPolicy

    -- | 'PeerMetrics' used by peer selection policy (see
    -- 'simplePeerSelectionPolicy')
    --
    , forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> PeerMetrics m ntnAddr
daPeerMetrics         :: PeerMetrics m ntnAddr

    -- | Used by churn-governor
    --
    , forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> STM m FetchMode
daBlockFetchMode      :: STM m FetchMode

    -- | Used for peer sharing protocol
    --
    , forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> PeerSharingRegistry ntnAddr m
daPeerSharingRegistry :: PeerSharingRegistry ntnAddr m
  }


--
-- Node-To-Client type aliases
--
-- Node-To-Client diffusion is only used in 'ResponderMode'.
--

type NodeToClientHandle ntcAddr versionData m =
    HandleWithMinimalCtx Mx.ResponderMode ntcAddr versionData ByteString m Void ()

type NodeToClientHandleError ntcVersion =
    HandleError Mx.ResponderMode ntcVersion

type NodeToClientConnectionHandler
      ntcFd ntcAddr ntcVersion ntcVersionData m =
    ConnectionHandler
      Mx.ResponderMode
      (ConnectionHandlerTrace ntcVersion ntcVersionData)
      ntcFd
      ntcAddr
      (NodeToClientHandle ntcAddr ntcVersionData m)
      (NodeToClientHandleError ntcVersion)
      (ntcVersion, ntcVersionData)
      m

type NodeToClientConnectionManagerArguments
      ntcFd ntcAddr ntcVersion ntcVersionData m =
    CM.Arguments
      (ConnectionHandlerTrace ntcVersion ntcVersionData)
      ntcFd
      ntcAddr
      (NodeToClientHandle ntcAddr ntcVersionData m)
      (NodeToClientHandleError ntcVersion)
      ntcVersion
      ntcVersionData
      m


--
-- Node-To-Node type aliases
--
-- Node-To-Node diffusion runs in either 'InitiatorMode' or 'InitiatorResponderMode'.
--

type NodeToNodeHandle
       (mode :: Mx.Mode)
       ntnAddr ntnVersionData m a b =
    HandleWithExpandedCtx mode ntnAddr ntnVersionData ByteString m a b

type NodeToNodeConnectionManager
       (mode :: Mx.Mode)
       ntnFd ntnAddr ntnVersionData ntnVersion m a b =
    ConnectionManager
      mode
      ntnFd
      ntnAddr
      (NodeToNodeHandle mode ntnAddr ntnVersionData m a b)
      (HandleError mode ntnVersion)
      m

--
-- Governor type aliases
--

type NodeToNodePeerConnectionHandle (mode :: Mx.Mode) ntnAddr ntnVersionData m a b =
    PeerConnectionHandle
      mode
      (ResponderContext ntnAddr)
      ntnAddr
      ntnVersionData
      ByteString
      m a b

type NodeToNodePeerSelectionActions (mode :: Mx.Mode) ntnAddr ntnVersionData m a b =
    PeerSelectionActions
      ntnAddr
      (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m a b)
      m

data Interfaces ntnFd ntnAddr ntnVersion ntnVersionData
                ntcFd ntcAddr ntcVersion ntcVersionData
                resolver resolverError
                m =
    Interfaces {
        -- | node-to-node snocket
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Snocket m ntnFd ntnAddr
diNtnSnocket
          :: Snocket m ntnFd ntnAddr,

        -- | node-to-node 'Mx.MakeBearer' callback
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> MakeBearer m ntnFd
diNtnBearer
          :: Mx.MakeBearer m ntnFd,

        -- | node-to-node socket configuration
        --
        -- It is used by both inbound and outbound connection.  The address is
        -- the local address that we can bind to if given (NOTE: for
        -- node-to-node connection `Just` is always given).
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket
          :: ntnFd -> Maybe ntnAddr -> m (),

        -- | node-to-node systemd socket configuration
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket
          :: ntnFd -> ntnAddr -> m (),

        -- | node-to-node handshake configuration
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments
          :: HandshakeArguments (ConnectionId ntnAddr) ntnVersion ntnVersionData m,

        -- | node-to-node address type
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnAddr -> Maybe AddressType
diNtnAddressType
          :: ntnAddr -> Maybe AddressType,

        -- | node-to-node data flow used by connection manager to classify
        -- negotiated connections
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnVersionData -> DataFlow
diNtnDataFlow
          :: ntnVersionData -> DataFlow,

        -- | remote side peer sharing information used by peer selection governor
        -- to decide which peers are available for performing peer sharing
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnVersionData -> PeerSharing
diNtnPeerSharing
          :: ntnVersionData -> PeerSharing,

        -- | node-to-node peer address
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
          :: IP -> Socket.PortNumber -> ntnAddr,

        -- | node-to-client snocket
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Snocket m ntcFd ntcAddr
diNtcSnocket
          :: Snocket m ntcFd ntcAddr,

        -- | node-to-client 'Mx.MakeBearer' callback
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> MakeBearer m ntcFd
diNtcBearer
          :: Mx.MakeBearer m ntcFd,

        -- | node-to-client handshake configuration
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments
          :: HandshakeArguments (ConnectionId ntcAddr) ntcVersion ntcVersionData m,

        -- | node-to-client file descriptor
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntcFd -> m FileDescriptor
diNtcGetFileDescriptor
          :: ntcFd -> m FileDescriptor,

        -- | diffusion pseudo random generator. It is split between various
        -- components that need randomness, e.g. inbound governor, peer
        -- selection, policies, etc.
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> StdGen
diRng
          :: StdGen,

        -- | callback which is used to register @SIGUSR1@ signal handler.
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> forall (mode :: Mode) x y.
   NodeToNodeConnectionManager
     mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
   -> StrictTVar
        m
        (PeerSelectionState
           ntnAddr
           (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
   -> PeerMetrics m ntnAddr
   -> m ()
diInstallSigUSR1Handler
          :: forall mode x y.
             NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersionData ntnVersion  m x y
          -> StrictTVar m (PeerSelectionState ntnAddr (NodeToNodePeerConnectionHandle
                               mode ntnAddr ntnVersionData m x y))
          -> PeerMetrics m ntnAddr
          -> m (),

        -- | diffusion dns actions
        --
        forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> DNSLookupType -> DNSActions resolver resolverError m
diDnsActions
          :: DNSLookupType -> DNSActions resolver resolverError m
      }

runM
    :: forall m ntnFd ntnAddr ntnVersion ntnVersionData
                ntcFd ntcAddr ntcVersion ntcVersionData
                resolver resolverError a.
       ( Alternative (STM m)
       , MonadAsync       m
       , MonadDelay       m
       , MonadEvaluate    m
       , MonadFix         m
       , MonadFork        m
       , MonadLabelledSTM m
       , MonadTraceSTM    m
       , MonadMask        m
       , MonadThrow  (STM m)
       , MonadTime        m
       , MonadTimer       m
       , MonadMVar        m
       , Typeable  ntnAddr
       , Ord       ntnAddr
       , Show      ntnAddr
       , Hashable  ntnAddr
       , Typeable  ntnVersion
       , Ord       ntnVersion
       , Show      ntnVersion
       , Show      ntnVersionData
       , Typeable  ntcAddr
       , Ord       ntcAddr
       , Show      ntcAddr
       , Ord       ntcVersion
       , Exception resolverError
       )
    => -- | interfaces
       Interfaces ntnFd ntnAddr ntnVersion ntnVersionData
                  ntcFd ntcAddr ntcVersion ntcVersionData
                  resolver resolverError
                  m
    -> -- | tracers
       Tracers ntnAddr ntnVersion
               ntcAddr ntcVersion
               m
    -> -- | p2p tracers
       TracersExtra ntnAddr ntnVersion ntnVersionData
                    ntcAddr ntcVersion ntcVersionData
                    resolverError m
    -> -- | configuration
       Arguments m ntnFd ntnAddr
                   ntcFd ntcAddr
    -> -- | p2p configuration
       ArgumentsExtra m

    -> -- | protocol handlers
       Applications ntnAddr ntnVersion ntnVersionData
                    ntcAddr ntcVersion ntcVersionData
                    m a
    -> -- | p2p protocol handlers
       ApplicationsExtra ntnAddr m a
    -> m Void
runM :: forall (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcFd
       ntcAddr ntcVersion ntcVersionData resolver resolverError a.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadEvaluate m,
 MonadFix m, MonadFork m, MonadLabelledSTM m, MonadTraceSTM m,
 MonadMask m, MonadThrow (STM m), MonadTime m, MonadTimer m,
 MonadMVar m, Typeable ntnAddr, Ord ntnAddr, Show ntnAddr,
 Hashable ntnAddr, Typeable ntnVersion, Ord ntnVersion,
 Show ntnVersion, Show ntnVersionData, Typeable ntcAddr,
 Ord ntcAddr, Show ntcAddr, Ord ntcVersion,
 Exception resolverError) =>
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> TracersExtra
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     resolverError
     m
-> Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> ArgumentsExtra m
-> Applications
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     m
     a
-> ApplicationsExtra ntnAddr m a
-> m Void
runM Interfaces
       { Snocket m ntnFd ntnAddr
diNtnSnocket :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Snocket m ntnFd ntnAddr
diNtnSnocket :: Snocket m ntnFd ntnAddr
diNtnSnocket
       , MakeBearer m ntnFd
diNtnBearer :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> MakeBearer m ntnFd
diNtnBearer :: MakeBearer m ntnFd
diNtnBearer
       , ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket :: ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket
       , ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket :: ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket
       , HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments
       , ntnAddr -> Maybe AddressType
diNtnAddressType :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnAddr -> Maybe AddressType
diNtnAddressType :: ntnAddr -> Maybe AddressType
diNtnAddressType
       , ntnVersionData -> DataFlow
diNtnDataFlow :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnVersionData -> DataFlow
diNtnDataFlow :: ntnVersionData -> DataFlow
diNtnDataFlow
       , ntnVersionData -> PeerSharing
diNtnPeerSharing :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnVersionData -> PeerSharing
diNtnPeerSharing :: ntnVersionData -> PeerSharing
diNtnPeerSharing
       , IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
       , Snocket m ntcFd ntcAddr
diNtcSnocket :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Snocket m ntcFd ntcAddr
diNtcSnocket :: Snocket m ntcFd ntcAddr
diNtcSnocket
       , MakeBearer m ntcFd
diNtcBearer :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> MakeBearer m ntcFd
diNtcBearer :: MakeBearer m ntcFd
diNtcBearer
       , HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments
       , ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: ntcFd -> m FileDescriptor
diNtcGetFileDescriptor
       , StdGen
diRng :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> StdGen
diRng :: StdGen
diRng
       , forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        ntnAddr
        (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
-> PeerMetrics m ntnAddr
-> m ()
diInstallSigUSR1Handler :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> forall (mode :: Mode) x y.
   NodeToNodeConnectionManager
     mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
   -> StrictTVar
        m
        (PeerSelectionState
           ntnAddr
           (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
   -> PeerMetrics m ntnAddr
   -> m ()
diInstallSigUSR1Handler :: forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        ntnAddr
        (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
-> PeerMetrics m ntnAddr
-> m ()
diInstallSigUSR1Handler
       , DNSLookupType -> DNSActions resolver resolverError m
diDnsActions :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> DNSLookupType -> DNSActions resolver resolverError m
diDnsActions :: DNSLookupType -> DNSActions resolver resolverError m
diDnsActions
       }
     Tracers
       { Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer
       , Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer
       , dtDiffusionTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer = Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer
       }
     TracersExtra
       { Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer :: Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
       , Tracer m ChurnCounters
dtTraceChurnCounters :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m ChurnCounters
dtTraceChurnCounters :: Tracer m ChurnCounters
dtTraceChurnCounters
       , Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorTracer :: Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorTracer
       , Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer :: Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer
       , Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters :: Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
       , Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer
       , Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer
       , Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
       , Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer :: Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer
       , Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer :: Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer
       , Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer :: Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer
       , Tracer m (Trace ntnAddr)
dtServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntnAddr)
dtServerTracer :: Tracer m (Trace ntnAddr)
dtServerTracer
       , Tracer m (Trace ntnAddr)
dtInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntnAddr)
dtInboundGovernorTracer :: Tracer m (Trace ntnAddr)
dtInboundGovernorTracer
       , Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer
       , Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer :: Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer
       , Tracer m (Trace ntcAddr)
dtLocalServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntcAddr)
dtLocalServerTracer :: Tracer m (Trace ntcAddr)
dtLocalServerTracer
       , Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer :: Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer
       }
     Arguments
       { Maybe (Either ntnFd ntnAddr)
daIPv4Address :: Maybe (Either ntnFd ntnAddr)
daIPv4Address :: forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv4Address
       , Maybe (Either ntnFd ntnAddr)
daIPv6Address :: Maybe (Either ntnFd ntnAddr)
daIPv6Address :: forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv6Address
       , Maybe (Either ntcFd ntcAddr)
daLocalAddress :: Maybe (Either ntcFd ntcAddr)
daLocalAddress :: forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntcFd ntcAddr)
daLocalAddress
       , AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr -> AcceptedConnectionsLimit
daAcceptedConnectionsLimit
       , daMode :: forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
daMode = DiffusionMode
diffusionMode
       , StrictTVar m (PublicPeerSelectionState ntnAddr)
daPublicPeerSelectionVar :: StrictTVar m (PublicPeerSelectionState ntnAddr)
daPublicPeerSelectionVar :: forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> StrictTVar m (PublicPeerSelectionState ntnAddr)
daPublicPeerSelectionVar
       }
     ArgumentsExtra
       { ConsensusModePeerTargets
daPeerTargets :: forall (m :: * -> *). ArgumentsExtra m -> ConsensusModePeerTargets
daPeerTargets :: ConsensusModePeerTargets
daPeerTargets
       , STM m (Config RelayAccessPoint)
daReadLocalRootPeers :: forall (m :: * -> *).
ArgumentsExtra m -> STM m (Config RelayAccessPoint)
daReadLocalRootPeers :: STM m (Config RelayAccessPoint)
daReadLocalRootPeers
       , STM m (Map RelayAccessPoint PeerAdvertise)
daReadPublicRootPeers :: forall (m :: * -> *).
ArgumentsExtra m -> STM m (Map RelayAccessPoint PeerAdvertise)
daReadPublicRootPeers :: STM m (Map RelayAccessPoint PeerAdvertise)
daReadPublicRootPeers
       , ConsensusMode
daConsensusMode :: forall (m :: * -> *). ArgumentsExtra m -> ConsensusMode
daConsensusMode :: ConsensusMode
daConsensusMode
       , MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState :: forall (m :: * -> *).
ArgumentsExtra m -> MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState
       , STM m UseBootstrapPeers
daReadUseBootstrapPeers :: forall (m :: * -> *). ArgumentsExtra m -> STM m UseBootstrapPeers
daReadUseBootstrapPeers :: STM m UseBootstrapPeers
daReadUseBootstrapPeers
       , PeerSharing
daOwnPeerSharing :: forall (m :: * -> *). ArgumentsExtra m -> PeerSharing
daOwnPeerSharing :: PeerSharing
daOwnPeerSharing
       , STM m UseLedgerPeers
daReadUseLedgerPeers :: forall (m :: * -> *). ArgumentsExtra m -> STM m UseLedgerPeers
daReadUseLedgerPeers :: STM m UseLedgerPeers
daReadUseLedgerPeers
       , DiffTime
daProtocolIdleTimeout :: forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daProtocolIdleTimeout :: DiffTime
daProtocolIdleTimeout
       , DiffTime
daTimeWaitTimeout :: forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daTimeWaitTimeout :: DiffTime
daTimeWaitTimeout
       , DiffTime
daDeadlineChurnInterval :: forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daDeadlineChurnInterval :: DiffTime
daDeadlineChurnInterval
       , DiffTime
daBulkChurnInterval :: forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daBulkChurnInterval :: DiffTime
daBulkChurnInterval
       , STM m (Maybe LedgerPeerSnapshot)
daReadLedgerPeerSnapshot :: forall (m :: * -> *).
ArgumentsExtra m -> STM m (Maybe LedgerPeerSnapshot)
daReadLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
daReadLedgerPeerSnapshot
       }
     Applications
       { Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
daApplicationInitiatorMode :: Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
daApplicationInitiatorMode :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode ntnAddr ByteString m a Void)
daApplicationInitiatorMode
       , Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ())
daApplicationInitiatorResponderMode :: Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ())
daApplicationInitiatorResponderMode :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode ntnAddr ByteString m a ())
daApplicationInitiatorResponderMode
       , Versions
  ntcVersion
  ntcVersionData
  (OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication :: Versions
  ntcVersion
  ntcVersionData
  (OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication
       , LedgerPeersConsensusInterface m
daLedgerPeersCtx :: LedgerPeersConsensusInterface m
daLedgerPeersCtx :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> LedgerPeersConsensusInterface m
daLedgerPeersCtx
       , OutboundConnectionsState -> STM m ()
daUpdateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
daUpdateOutboundConnectionsState :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> OutboundConnectionsState -> STM m ()
daUpdateOutboundConnectionsState
       }
     ApplicationsExtra
       { RethrowPolicy
daRethrowPolicy :: forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> RethrowPolicy
daRethrowPolicy :: RethrowPolicy
daRethrowPolicy
       , RethrowPolicy
daLocalRethrowPolicy :: forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> RethrowPolicy
daLocalRethrowPolicy :: RethrowPolicy
daLocalRethrowPolicy
       , ReturnPolicy a
daReturnPolicy :: forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> ReturnPolicy a
daReturnPolicy :: ReturnPolicy a
daReturnPolicy
       , PeerMetrics m ntnAddr
daPeerMetrics :: forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> PeerMetrics m ntnAddr
daPeerMetrics :: PeerMetrics m ntnAddr
daPeerMetrics
       , STM m FetchMode
daBlockFetchMode :: forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> STM m FetchMode
daBlockFetchMode :: STM m FetchMode
daBlockFetchMode
       , PeerSharingRegistry ntnAddr m
daPeerSharingRegistry :: forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> PeerSharingRegistry ntnAddr m
daPeerSharingRegistry :: PeerSharingRegistry ntnAddr m
daPeerSharingRegistry
       }
  = do
    -- Thread to which 'RethrowPolicy' will throw fatal exceptions.
    mainThreadId <- m (ThreadId m)
forall (m :: * -> *). MonadThread m => m (ThreadId m)
myThreadId

    Async.runConcurrently
      $ asum
      $ Async.Concurrently <$>
          ( mkRemoteThread mainThreadId
          : maybeToList (mkLocalThread mainThreadId <$> daLocalAddress)
          )

  where
    (StdGen
ledgerPeersRng, StdGen
rng1) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
diRng
    (StdGen
policyRng,      StdGen
rng2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng1
    (StdGen
churnRng,       StdGen
rng3) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng2
    (StdGen
fuzzRng,        StdGen
rng4) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng3
    (StdGen
cmLocalStdGen,  StdGen
rng5) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng4
    (StdGen
cmStdGen1, StdGen
cmStdGen2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng5


    mkInboundPeersMap :: InboundGovernor.PublicState ntnAddr ntnVersionData
                      -> Map ntnAddr PeerSharing
    mkInboundPeersMap :: PublicState ntnAddr ntnVersionData -> Map ntnAddr PeerSharing
mkInboundPeersMap
      InboundGovernor.PublicState { Map ntnAddr ntnVersionData
inboundDuplexPeers :: Map ntnAddr ntnVersionData
inboundDuplexPeers :: forall peerAddr versionData.
PublicState peerAddr versionData -> Map peerAddr versionData
InboundGovernor.inboundDuplexPeers }
      =
      (ntnVersionData -> PeerSharing)
-> Map ntnAddr ntnVersionData -> Map ntnAddr PeerSharing
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ntnVersionData -> PeerSharing
diNtnPeerSharing Map ntnAddr ntnVersionData
inboundDuplexPeers

    -- TODO: this policy should also be used in `PeerStateActions` and
    -- `InboundGovernor` (when creating or accepting connections)
    rethrowPolicy :: RethrowPolicy
rethrowPolicy =
      -- Only the 'IOManagerError's are fatal, all the other exceptions in the
      -- networking code will only shutdown the bearer (see 'ShutdownPeer' why
      -- this is so).
      (ErrorContext -> SomeException -> ErrorCommand) -> RethrowPolicy
RethrowPolicy (\ErrorContext
_ctx SomeException
err ->
        case SomeException -> Maybe Void
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err of
          Just (Void
_ :: IOManagerError) -> ErrorCommand
ShutdownNode
          Maybe Void
Nothing                    -> ErrorCommand
forall a. Monoid a => a
mempty)
      RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<>
      (ErrorContext -> SomeException -> ErrorCommand) -> RethrowPolicy
RethrowPolicy (\ErrorContext
_ctx SomeException
err ->
        case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err of
          -- if we are out of file descriptors (either because we exhausted
          -- process or system limit) we should shut down the node and let the
          -- operator investigate.
          --
          -- Refs:
          -- * https://hackage.haskell.org/package/ghc-internal-9.1001.0/docs/src/GHC.Internal.Foreign.C.Error.html#errnoToIOError
          -- * man socket.2
          -- * man connect.2
          -- * man accept.2
          -- NOTE: many `connect` and `accept` exceptions are classified as
          -- `OtherError`, here we only distinguish fatal IO errors (e.g.
          -- ones that propagate to the main thread).
          -- NOTE: we don't use the rethrow policy for `accept` calls, where
          -- all but `ECONNABORTED` are fatal exceptions.
          Just IOError { IOErrorType
ioe_type :: IOErrorType
ioe_type :: IOException -> IOErrorType
ioe_type } ->
            case IOErrorType
ioe_type of
              IOErrorType
ResourceExhausted    -> ErrorCommand
ShutdownNode
              -- EAGAIN            -- connect, accept
              -- EMFILE            -- socket, accept
              -- ENFILE            -- socket, accept
              -- ENOBUFS           -- socket, accept
              -- ENOMEM            -- socket, accept

              IOErrorType
UnsupportedOperation -> ErrorCommand
ShutdownNode
              -- EADDRNOTAVAIL     -- connect
              -- EAFNOSUPPRT       -- connect

              IOErrorType
InvalidArgument      -> ErrorCommand
ShutdownNode
              -- EINVAL            -- socket, accept
              -- ENOTSOCK          -- connect
              -- EBADF             -- connect, accept

              IOErrorType
ProtocolError        -> ErrorCommand
ShutdownNode
              -- EPROTONOSUPPOPRT  -- socket
              -- EPROTO            -- accept

              IOErrorType
_                    -> ErrorCommand
forall a. Monoid a => a
mempty
          Maybe IOException
Nothing -> ErrorCommand
forall a. Monoid a => a
mempty)
      RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<>
      (ErrorContext -> SomeException -> ErrorCommand) -> RethrowPolicy
RethrowPolicy (\ErrorContext
ctx SomeException
err -> case  (ErrorContext
ctx, SomeException -> Maybe Error
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err) of
                        -- mux unknown mini-protocol errors on the outbound
                        -- side are fatal, since this is misconfiguration of the
                        -- ouroboros-network stack.
                        (ErrorContext
OutboundError, Just Mx.UnknownMiniProtocol {})
                          -> ErrorCommand
ShutdownNode
                        (ErrorContext, Maybe Error)
_ -> ErrorCommand
forall a. Monoid a => a
mempty)


    -- | mkLocalThread - create local connection manager

    mkLocalThread :: ThreadId m -> Either ntcFd ntcAddr -> m Void
    mkLocalThread :: ThreadId m -> Either ntcFd ntcAddr -> m Void
mkLocalThread ThreadId m
mainThreadId Either ntcFd ntcAddr
localAddr =
      Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> (ntcFd -> m FileDescriptor)
-> Snocket m ntcFd ntcAddr
-> Either ntcFd ntcAddr
-> (ntcFd -> m Void)
-> m Void
forall ntnAddr ntcFd ntcAddr (m :: * -> *) a.
(MonadThrow m, Typeable ntnAddr, Show ntnAddr) =>
Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> (ntcFd -> m FileDescriptor)
-> Snocket m ntcFd ntcAddr
-> Either ntcFd ntcAddr
-> (ntcFd -> m a)
-> m a
withLocalSocket Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer ntcFd -> m FileDescriptor
diNtcGetFileDescriptor Snocket m ntcFd ntcAddr
diNtcSnocket Either ntcFd ntcAddr
localAddr
      ((ntcFd -> m Void) -> m Void) -> (ntcFd -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \ntcFd
localSocket -> do
        localInbInfoChannel <- m (InformationChannel
     (NewConnectionInfo
        ntcAddr (NodeToClientHandle ntcAddr ntcVersionData m))
     m)
forall a (m :: * -> *).
MonadLabelledSTM m =>
m (InformationChannel a m)
newInformationChannel

        let localConnectionLimits = Word32 -> Word32 -> DiffTime -> AcceptedConnectionsLimit
AcceptedConnectionsLimit Word32
forall a. Bounded a => a
maxBound Word32
forall a. Bounded a => a
maxBound DiffTime
0

            localConnectionHandler :: NodeToClientConnectionHandler
                                        ntcFd ntcAddr ntcVersion ntcVersionData m
            localConnectionHandler =
              Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
-> SingMuxMode 'ResponderMode
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosBundle
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ())
-> (ThreadId m, RethrowPolicy)
-> NodeToClientConnectionHandler
     ntcFd ntcAddr ntcVersion ntcVersionData m
forall initiatorCtx responderCtx peerAddr (muxMode :: Mode) socket
       versionNumber versionData (m :: * -> *) a b.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFork m,
 MonadLabelledSTM m, MonadThrow (STM m), MonadTimer m, MonadMask m,
 Ord versionNumber, Show peerAddr, Typeable peerAddr) =>
Tracer m (WithBearer (ConnectionId peerAddr) Trace)
-> SingMuxMode muxMode
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
makeConnectionHandler
                Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer
                SingMuxMode 'ResponderMode
SingResponderMode
                HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments
                ( ( \ (OuroborosApplication [MiniProtocol
   'ResponderMode
   (MinimalInitiatorContext ntcAddr)
   (ResponderContext ntcAddr)
   ByteString
   m
   Void
   ()]
apps)
                   -> WithProtocolTemperature
  'Hot
  [MiniProtocol
     'ResponderMode
     (MinimalInitiatorContext ntcAddr)
     (ResponderContext ntcAddr)
     ByteString
     m
     Void
     ()]
-> WithProtocolTemperature
     'Warm
     [MiniProtocol
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ()]
-> WithProtocolTemperature
     'Established
     [MiniProtocol
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ()]
-> OuroborosBundle
     'ResponderMode
     (MinimalInitiatorContext ntcAddr)
     (ResponderContext ntcAddr)
     ByteString
     m
     Void
     ()
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> TemperatureBundle a
TemperatureBundle
                        ([MiniProtocol
   'ResponderMode
   (MinimalInitiatorContext ntcAddr)
   (ResponderContext ntcAddr)
   ByteString
   m
   Void
   ()]
-> WithProtocolTemperature
     'Hot
     [MiniProtocol
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ()]
forall a. a -> WithProtocolTemperature 'Hot a
WithHot [MiniProtocol
   'ResponderMode
   (MinimalInitiatorContext ntcAddr)
   (ResponderContext ntcAddr)
   ByteString
   m
   Void
   ()]
apps)
                        ([MiniProtocol
   'ResponderMode
   (MinimalInitiatorContext ntcAddr)
   (ResponderContext ntcAddr)
   ByteString
   m
   Void
   ()]
-> WithProtocolTemperature
     'Warm
     [MiniProtocol
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ()]
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm [])
                        ([MiniProtocol
   'ResponderMode
   (MinimalInitiatorContext ntcAddr)
   (ResponderContext ntcAddr)
   ByteString
   m
   Void
   ()]
-> WithProtocolTemperature
     'Established
     [MiniProtocol
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ()]
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished [])
                  ) (OuroborosApplicationWithMinimalCtx
   'ResponderMode ntcAddr ByteString m Void ()
 -> OuroborosBundle
      'ResponderMode
      (MinimalInitiatorContext ntcAddr)
      (ResponderContext ntcAddr)
      ByteString
      m
      Void
      ())
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode ntcAddr ByteString m Void ())
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosBundle
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versions
  ntcVersion
  ntcVersionData
  (OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication )
                (ThreadId m
mainThreadId, RethrowPolicy
rethrowPolicy RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<> RethrowPolicy
daLocalRethrowPolicy)

            localConnectionManagerArguments
              :: NodeToClientConnectionManagerArguments
                   ntcFd ntcAddr ntcVersion ntcVersionData m
            localConnectionManagerArguments =
              CM.Arguments {
                  tracer :: Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
CM.tracer              = Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer,
                  trTracer :: Tracer
  m
  (TransitionTrace
     ntcAddr
     (ConnectionState
        ntcAddr
        (NodeToClientHandle ntcAddr ntcVersionData m)
        (NodeToClientHandleError ntcVersion)
        ntcVersion
        m))
CM.trTracer            = Tracer
  m
  (TransitionTrace
     ntcAddr
     (ConnectionState
        ntcAddr
        (NodeToClientHandle ntcAddr ntcVersionData m)
        (NodeToClientHandleError ntcVersion)
        ntcVersion
        m))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer, -- TODO: issue #3320
                  muxTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
CM.muxTracer           = Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer,
                  ipv4Address :: Maybe ntcAddr
CM.ipv4Address         = Maybe ntcAddr
forall a. Maybe a
Nothing,
                  ipv6Address :: Maybe ntcAddr
CM.ipv6Address         = Maybe ntcAddr
forall a. Maybe a
Nothing,
                  addressType :: ntcAddr -> Maybe AddressType
CM.addressType         = Maybe AddressType -> ntcAddr -> Maybe AddressType
forall a b. a -> b -> a
const Maybe AddressType
forall a. Maybe a
Nothing,
                  snocket :: Snocket m ntcFd ntcAddr
CM.snocket             = Snocket m ntcFd ntcAddr
diNtcSnocket,
                  makeBearer :: MakeBearer m ntcFd
CM.makeBearer          = MakeBearer m ntcFd
diNtcBearer,
                  configureSocket :: ntcFd -> Maybe ntcAddr -> m ()
CM.configureSocket     = \ntcFd
_ Maybe ntcAddr
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
                  timeWaitTimeout :: DiffTime
CM.timeWaitTimeout     = DiffTime
local_TIME_WAIT_TIMEOUT,
                  outboundIdleTimeout :: DiffTime
CM.outboundIdleTimeout = DiffTime
local_PROTOCOL_IDLE_TIMEOUT,
                  connectionDataFlow :: ntcVersionData -> DataFlow
CM.connectionDataFlow    = ntcVersionData -> DataFlow
forall ntcVersionData. ntcVersionData -> DataFlow
ntcDataFlow,
                  prunePolicy :: PrunePolicy ntcAddr
CM.prunePolicy         = PrunePolicy ntcAddr
forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
Diffusion.Policies.prunePolicy,
                  stdGen :: StdGen
CM.stdGen              = StdGen
cmLocalStdGen,
                  connectionsLimits :: AcceptedConnectionsLimit
CM.connectionsLimits   = AcceptedConnectionsLimit
localConnectionLimits
                }

        CM.with
          localConnectionManagerArguments
          localConnectionHandler
          classifyHandleError
          (InResponderMode localInbInfoChannel)
          $ \ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr ntcVersionData m)
  (NodeToClientHandleError ntcVersion)
  m
localConnectionManager-> do
            --
            -- node-to-client server
            --
            Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> DiffusionTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer (DiffusionTracer ntnAddr ntcAddr -> m ())
-> (ntcAddr -> DiffusionTracer ntnAddr ntcAddr) -> ntcAddr -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ntcAddr -> DiffusionTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr. ntcAddr -> DiffusionTracer ntnAddr ntcAddr
RunLocalServer
              (ntcAddr -> m ()) -> m ntcAddr -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Snocket m ntcFd ntcAddr -> ntcFd -> m ntcAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr Snocket m ntcFd ntcAddr
diNtcSnocket ntcFd
localSocket

            Arguments
  'ResponderMode
  ntcFd
  (MinimalInitiatorContext ntcAddr)
  ntcAddr
  ntcVersionData
  ntcVersion
  ByteString
  m
  Void
  ()
-> (Async m Void
    -> m (PublicState ntcAddr ntcVersionData) -> m Void)
-> m Void
forall (muxMode :: Mode) socket initiatorCtx peerAddr versionData
       versionNumber (m :: * -> *) a b x.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadCatch m,
 MonadEvaluate m, MonadLabelledSTM m, MonadMask m,
 MonadThrow (STM m), MonadTime m, MonadTimer m,
 HasResponder muxMode ~ 'True, Ord peerAddr, Show peerAddr) =>
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
-> (Async m Void -> m (PublicState peerAddr versionData) -> m x)
-> m x
Server.with
              Server.Arguments {
                  sockets :: NonEmpty ntcFd
Server.sockets               = ntcFd
localSocket ntcFd -> [ntcFd] -> NonEmpty ntcFd
forall a. a -> [a] -> NonEmpty a
:| [],
                  snocket :: Snocket m ntcFd ntcAddr
Server.snocket               = Snocket m ntcFd ntcAddr
diNtcSnocket,
                  tracer :: Tracer m (Trace ntcAddr)
Server.tracer                = Tracer m (Trace ntcAddr)
dtLocalServerTracer,
                  trTracer :: Tracer m (RemoteTransitionTrace ntcAddr)
Server.trTracer              = Tracer m (RemoteTransitionTrace ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer, -- TODO: issue #3320
                  debugInboundGovernor :: Tracer m (Debug ntcAddr ntcVersionData)
Server.debugInboundGovernor  = Tracer m (Debug ntcAddr ntcVersionData)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer,
                  inboundGovernorTracer :: Tracer m (Trace ntcAddr)
Server.inboundGovernorTracer = Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer,
                  inboundIdleTimeout :: Maybe DiffTime
Server.inboundIdleTimeout    = Maybe DiffTime
forall a. Maybe a
Nothing,
                  connectionLimits :: AcceptedConnectionsLimit
Server.connectionLimits      = AcceptedConnectionsLimit
localConnectionLimits,
                  connectionManager :: ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr ntcVersionData m)
  (NodeToClientHandleError ntcVersion)
  m
Server.connectionManager     = ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr ntcVersionData m)
  (NodeToClientHandleError ntcVersion)
  m
localConnectionManager,
                  connectionDataFlow :: ntcVersionData -> DataFlow
Server.connectionDataFlow    = ntcVersionData -> DataFlow
forall ntcVersionData. ntcVersionData -> DataFlow
ntcDataFlow,
                  inboundInfoChannel :: InformationChannel
  (NewConnectionInfo
     ntcAddr (NodeToClientHandle ntcAddr ntcVersionData m))
  m
Server.inboundInfoChannel    = InformationChannel
  (NewConnectionInfo
     ntcAddr (NodeToClientHandle ntcAddr ntcVersionData m))
  m
localInbInfoChannel
                }
              (\Async m Void
inboundGovernorThread m (PublicState ntcAddr ntcVersionData)
_ -> Async m Void -> m Void
forall a. Async m a -> m a
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
Async.wait Async m Void
inboundGovernorThread)


    -- | mkRemoteThread - create remote connection manager

    mkRemoteThread :: ThreadId m -> m Void
    mkRemoteThread :: ThreadId m -> m Void
mkRemoteThread ThreadId m
mainThreadId = do
      let
        exitPolicy :: ExitPolicy a
        exitPolicy :: ExitPolicy a
exitPolicy = ReturnPolicy a -> ExitPolicy a
forall a. ReturnPolicy a -> ExitPolicy a
stdExitPolicy ReturnPolicy a
daReturnPolicy

      ipv4Address
        <- (Either ntnFd ntnAddr -> m ntnAddr)
-> Maybe (Either ntnFd ntnAddr) -> m (Maybe ntnAddr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ntnFd -> m ntnAddr)
-> (ntnAddr -> m ntnAddr) -> Either ntnFd ntnAddr -> m ntnAddr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Snocket m ntnFd ntnAddr -> ntnFd -> m ntnAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr Snocket m ntnFd ntnAddr
diNtnSnocket) ntnAddr -> m ntnAddr
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
                    Maybe (Either ntnFd ntnAddr)
daIPv4Address
      case ipv4Address of
        Just ntnAddr
addr | Just AddressType
IPv4Address <- ntnAddr -> Maybe AddressType
diNtnAddressType ntnAddr
addr
                  -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  | Bool
otherwise
                  -> Failure -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ntnAddr -> Failure
forall ntnAddr.
(Show ntnAddr, Typeable ntnAddr) =>
ntnAddr -> Failure
UnexpectedIPv4Address ntnAddr
addr)
        Maybe ntnAddr
Nothing   -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      ipv6Address
        <- traverse (either (Snocket.getLocalAddr diNtnSnocket) pure)
                    daIPv6Address
      case ipv6Address of
        Just ntnAddr
addr | Just AddressType
IPv6Address <- ntnAddr -> Maybe AddressType
diNtnAddressType ntnAddr
addr
                  -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  | Bool
otherwise
                  -> Failure -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ntnAddr -> Failure
forall ntnAddr.
(Show ntnAddr, Typeable ntnAddr) =>
ntnAddr -> Failure
UnexpectedIPv6Address ntnAddr
addr)
        Maybe ntnAddr
Nothing   -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      lookupReqs <- case (ipv4Address, ipv6Address) of
                           (Just ntnAddr
_ , Maybe ntnAddr
Nothing) -> DNSLookupType -> m DNSLookupType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DNSLookupType
LookupReqAOnly
                           (Maybe ntnAddr
Nothing, Just ntnAddr
_ ) -> DNSLookupType -> m DNSLookupType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DNSLookupType
LookupReqAAAAOnly
                           (Just ntnAddr
_ , Just ntnAddr
_ ) -> DNSLookupType -> m DNSLookupType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DNSLookupType
LookupReqAAndAAAA
                           (Maybe ntnAddr
Nothing, Maybe ntnAddr
Nothing) -> Failure -> m DNSLookupType
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO Failure
NoSocket

      -- RNGs used for picking random peers from the ledger and for
      -- demoting/promoting peers.
      policyRngVar <- newTVarIO policyRng

      churnModeVar <- newTVarIO ChurnModeNormal

      localRootsVar <- newTVarIO mempty

      peerSelectionTargetsVar <- newTVarIO $
        case daConsensusMode of
          ConsensusMode
PraosMode   -> ConsensusModePeerTargets -> PeerSelectionTargets
deadlineTargets ConsensusModePeerTargets
daPeerTargets
          ConsensusMode
GenesisMode -> ConsensusModePeerTargets -> PeerSelectionTargets
syncTargets ConsensusModePeerTargets
daPeerTargets

      countersVar <- newTVarIO emptyPeerSelectionCounters

      -- Design notes:
      --  - We split the following code into two parts:
      --    - Part (a): plumb data flow (in particular arguments and tracersr)
      --      and define common functions as a sequence of 'let's in which we
      --      define needed 'withXXX' functions (and similar) which
      --       - are used in Part (b),
      --       - handle the plumbing of tracers, and
      --       - capture commonalities between the two cases.
      --
      --    - Part (b): capturing the major control-flow of runM:
      --      in particular, two different case alternatives in which is captured
      --      the monadic flow of the program stripped down to its essence:
      ---     ```
      --       <setup...>
      --       case diffusionMode of
      --         InitiatorOnlyDiffusionMode -> ...
      --         InitiatorAndResponderDiffusionMode -> ...
      --      ```

      --
      -- Part (a): plumb data flow and define common functions
      --

      let connectionManagerArguments'
            :: forall handle handleError.
               PrunePolicy ntnAddr
            -> StdGen
            -> CM.Arguments
                 (ConnectionHandlerTrace ntnVersion ntnVersionData)
                 ntnFd ntnAddr handle handleError ntnVersion ntnVersionData m
          connectionManagerArguments' PrunePolicy ntnAddr
prunePolicy StdGen
stdGen =
            CM.Arguments {
                tracer :: Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
CM.tracer              = Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer,
                trTracer :: Tracer
  m
  (TransitionTrace
     ntnAddr (ConnectionState ntnAddr handle handleError ntnVersion m))
CM.trTracer            =
                  (MaybeUnknown
   (ConnectionState ntnAddr handle handleError ntnVersion m)
 -> AbstractState)
-> TransitionTrace
     ntnAddr (ConnectionState ntnAddr handle handleError ntnVersion m)
-> AbstractTransitionTrace ntnAddr
forall a b.
(a -> b)
-> TransitionTrace' ntnAddr a -> TransitionTrace' ntnAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeUnknown
  (ConnectionState ntnAddr handle handleError ntnVersion m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
CM.abstractState
                  (TransitionTrace
   ntnAddr (ConnectionState ntnAddr handle handleError ntnVersion m)
 -> AbstractTransitionTrace ntnAddr)
-> Tracer m (AbstractTransitionTrace ntnAddr)
-> Tracer
     m
     (TransitionTrace
        ntnAddr (ConnectionState ntnAddr handle handleError ntnVersion m))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer,
                muxTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
CM.muxTracer           = Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer,
                Maybe ntnAddr
ipv4Address :: Maybe ntnAddr
ipv4Address :: Maybe ntnAddr
CM.ipv4Address,
                Maybe ntnAddr
ipv6Address :: Maybe ntnAddr
ipv6Address :: Maybe ntnAddr
CM.ipv6Address,
                addressType :: ntnAddr -> Maybe AddressType
CM.addressType         = ntnAddr -> Maybe AddressType
diNtnAddressType,
                snocket :: Snocket m ntnFd ntnAddr
CM.snocket             = Snocket m ntnFd ntnAddr
diNtnSnocket,
                makeBearer :: MakeBearer m ntnFd
CM.makeBearer          = MakeBearer m ntnFd
diNtnBearer,
                configureSocket :: ntnFd -> Maybe ntnAddr -> m ()
CM.configureSocket     = ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket,
                connectionDataFlow :: ntnVersionData -> DataFlow
CM.connectionDataFlow    = ntnVersionData -> DataFlow
diNtnDataFlow,
                prunePolicy :: PrunePolicy ntnAddr
CM.prunePolicy         = PrunePolicy ntnAddr
prunePolicy,
                StdGen
stdGen :: StdGen
stdGen :: StdGen
CM.stdGen,
                connectionsLimits :: AcceptedConnectionsLimit
CM.connectionsLimits   = AcceptedConnectionsLimit
daAcceptedConnectionsLimit,
                timeWaitTimeout :: DiffTime
CM.timeWaitTimeout     = DiffTime
daTimeWaitTimeout,
                outboundIdleTimeout :: DiffTime
CM.outboundIdleTimeout = DiffTime
daProtocolIdleTimeout
              }

      let peerSelectionPolicy = StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m ntnAddr
-> RepromoteDelay
-> PeerSelectionPolicy ntnAddr m
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m peerAddr
-> RepromoteDelay
-> PeerSelectionPolicy peerAddr m
Diffusion.Policies.simplePeerSelectionPolicy
                                  StrictTVar m StdGen
policyRngVar (StrictTVar m ChurnMode -> STM m ChurnMode
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m ChurnMode
churnModeVar)
                                  PeerMetrics m ntnAddr
daPeerMetrics (ExitPolicy a -> RepromoteDelay
forall a. ExitPolicy a -> RepromoteDelay
epErrorDelay ExitPolicy a
exitPolicy)

      let makeConnectionHandler'
            :: forall muxMode socket initiatorCtx responderCtx b c.
               SingMuxMode muxMode
            -> Versions ntnVersion ntnVersionData
                 (OuroborosBundle muxMode initiatorCtx responderCtx ByteString m b c)
            -> MuxConnectionHandler
                 muxMode socket initiatorCtx responderCtx ntnAddr
                 ntnVersion ntnVersionData ByteString m b c
          makeConnectionHandler' SingMuxMode muxMode
muxMode Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     muxMode initiatorCtx responderCtx ByteString m b c)
versions =
            Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
-> SingMuxMode muxMode
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m b c)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
forall initiatorCtx responderCtx peerAddr (muxMode :: Mode) socket
       versionNumber versionData (m :: * -> *) a b.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFork m,
 MonadLabelledSTM m, MonadThrow (STM m), MonadTimer m, MonadMask m,
 Ord versionNumber, Show peerAddr, Typeable peerAddr) =>
Tracer m (WithBearer (ConnectionId peerAddr) Trace)
-> SingMuxMode muxMode
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
makeConnectionHandler
              Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer
              SingMuxMode muxMode
muxMode
              HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments
              Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     muxMode initiatorCtx responderCtx ByteString m b c)
versions
              (ThreadId m
mainThreadId, RethrowPolicy
rethrowPolicy RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<> RethrowPolicy
daRethrowPolicy)

          -- | Capture the two variations (InitiatorMode,InitiatorResponderMode) of
          --   withConnectionManager:

          withConnectionManagerInitiatorOnlyMode =
            Arguments
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     Void)
  (HandleError 'InitiatorMode ntnVersion)
  ntnVersion
  ntnVersionData
  m
-> ConnectionHandler
     'InitiatorMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        Void)
     (HandleError 'InitiatorMode ntnVersion)
     (ntnVersion, ntnVersionData)
     m
-> (HandleError 'InitiatorMode ntnVersion -> HandleErrorType)
-> InResponderMode
     'InitiatorMode
     (InformationChannel
        (NewConnectionInfo
           ntnAddr
           (Handle
              'InitiatorMode
              (ExpandedInitiatorContext ntnAddr m)
              (ResponderContext ntnAddr)
              ntnVersionData
              ByteString
              m
              a
              Void))
        m)
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         Void)
      (HandleError 'InitiatorMode ntnVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: Mode) peerAddr socket handlerTrace handle
       handleError version versionData (m :: * -> *) a.
(Alternative (STM m), MonadLabelledSTM m, MonadTraceSTM m,
 MonadFork m, MonadAsync m, MonadDelay m, MonadEvaluate m,
 MonadFix m, MonadMask m, MonadThrow (STM m), MonadTimer m,
 Ord peerAddr, Show peerAddr, Typeable peerAddr) =>
Arguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  version
  versionData
  m
-> ConnectionHandler
     muxMode
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> (handleError -> HandleErrorType)
-> InResponderMode
     muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m a)
-> m a
CM.with
              (PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        Void)
     (HandleError 'InitiatorMode ntnVersion)
     ntnVersion
     ntnVersionData
     m
forall handle handleError.
PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     handle
     handleError
     ntnVersion
     ntnVersionData
     m
connectionManagerArguments' PrunePolicy ntnAddr
forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
simplePrunePolicy StdGen
cmStdGen1)
                 -- Server is not running, it will not be able to
                 -- advise which connections to prune.  It's also not
                 -- expected that the governor targets will be larger
                 -- than limits imposed by 'cmConnectionsLimits'.
              (SingMuxMode 'InitiatorMode
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode ntnAddr ByteString m a Void)
-> ConnectionHandler
     'InitiatorMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        Void)
     (HandleError 'InitiatorMode ntnVersion)
     (ntnVersion, ntnVersionData)
     m
forall (muxMode :: Mode) socket initiatorCtx responderCtx b c.
SingMuxMode muxMode
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m b c)
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
makeConnectionHandler'
                SingMuxMode 'InitiatorMode
SingInitiatorMode
                Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
daApplicationInitiatorMode)
              HandleError 'InitiatorMode ntnVersion -> HandleErrorType
forall (muxMode :: Mode) versionNumber.
HandleError muxMode versionNumber -> HandleErrorType
classifyHandleError
              InResponderMode
  'InitiatorMode
  (InformationChannel
     (NewConnectionInfo
        ntnAddr
        (Handle
           'InitiatorMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           Void))
     m)
forall (mode :: Mode) a. InResponderMode mode a
NotInResponderMode

          withConnectionManagerInitiatorAndResponderMode
            InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
inbndInfoChannel =
              Arguments
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  ntnVersion
  ntnVersionData
  m
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandleError 'InitiatorResponderMode ntnVersion)
     (ntnVersion, ntnVersionData)
     m
-> (HandleError 'InitiatorResponderMode ntnVersion
    -> HandleErrorType)
-> InResponderMode
     'InitiatorResponderMode
     (InformationChannel
        (NewConnectionInfo
           ntnAddr
           (Handle
              'InitiatorResponderMode
              (ExpandedInitiatorContext ntnAddr m)
              (ResponderContext ntnAddr)
              ntnVersionData
              ByteString
              m
              a
              ()))
        m)
-> (ConnectionManager
      'InitiatorResponderMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorResponderMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         ())
      (HandleError 'InitiatorResponderMode ntnVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: Mode) peerAddr socket handlerTrace handle
       handleError version versionData (m :: * -> *) a.
(Alternative (STM m), MonadLabelledSTM m, MonadTraceSTM m,
 MonadFork m, MonadAsync m, MonadDelay m, MonadEvaluate m,
 MonadFix m, MonadMask m, MonadThrow (STM m), MonadTimer m,
 Ord peerAddr, Show peerAddr, Typeable peerAddr) =>
Arguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  version
  versionData
  m
-> ConnectionHandler
     muxMode
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> (handleError -> HandleErrorType)
-> InResponderMode
     muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m a)
-> m a
CM.with
                (PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandleError 'InitiatorResponderMode ntnVersion)
     ntnVersion
     ntnVersionData
     m
forall handle handleError.
PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     handle
     handleError
     ntnVersion
     ntnVersionData
     m
connectionManagerArguments' PrunePolicy ntnAddr
forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
Diffusion.Policies.prunePolicy StdGen
cmStdGen2)
                (SingMuxMode 'InitiatorResponderMode
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode ntnAddr ByteString m a ())
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandleError 'InitiatorResponderMode ntnVersion)
     (ntnVersion, ntnVersionData)
     m
forall (muxMode :: Mode) socket initiatorCtx responderCtx b c.
SingMuxMode muxMode
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m b c)
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
makeConnectionHandler'
                   SingMuxMode 'InitiatorResponderMode
SingInitiatorResponderMode
                   Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ())
daApplicationInitiatorResponderMode)
                HandleError 'InitiatorResponderMode ntnVersion -> HandleErrorType
forall (muxMode :: Mode) versionNumber.
HandleError muxMode versionNumber -> HandleErrorType
classifyHandleError
                (InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
-> InResponderMode
     'InitiatorResponderMode
     (InformationChannel
        (NewConnectionInfo
           ntnAddr
           (Handle
              'InitiatorResponderMode
              (ExpandedInitiatorContext ntnAddr m)
              (ResponderContext ntnAddr)
              ntnVersionData
              ByteString
              m
              a
              ()))
        m)
forall (mode :: Mode) a.
(HasResponder mode ~ 'True) =>
a -> InResponderMode mode a
InResponderMode InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
inbndInfoChannel)

      --
      -- peer state actions
      --
      -- Peer state actions run a job pool in the background which
      -- tracks threads forked by 'PeerStateActions'
      --

      let -- | parameterized version of 'withPeerStateActions'
          withPeerStateActions'
            :: forall (muxMode :: Mx.Mode) responderCtx socket b c.
               HasInitiator muxMode ~ True
            => MuxConnectionManager
                 muxMode socket (ExpandedInitiatorContext ntnAddr m)
                 responderCtx ntnAddr ntnVersionData ntnVersion
                 ByteString m a b
            -> (Governor.PeerStateActions
                  ntnAddr
                  (PeerConnectionHandle muxMode responderCtx ntnAddr
                     ntnVersionData ByteString m a b)
                  m
                -> m c)
            -> m c
          withPeerStateActions' MuxConnectionManager
  muxMode
  socket
  (ExpandedInitiatorContext ntnAddr m)
  responderCtx
  ntnAddr
  ntnVersionData
  ntnVersion
  ByteString
  m
  a
  b
connectionManager =
            PeerStateActionsArguments
  muxMode socket responderCtx ntnAddr ntnVersionData ntnVersion m a b
-> (PeerStateActions
      ntnAddr
      (PeerConnectionHandle
         muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
      m
    -> m c)
-> m c
forall (muxMode :: Mode) socket responderCtx peerAddr versionData
       versionNumber (m :: * -> *) a b x.
(Alternative (STM m), MonadAsync m, MonadCatch m,
 MonadLabelledSTM m, MonadFork m, MonadMask m, MonadTimer m,
 MonadThrow (STM m), HasInitiator muxMode ~ 'True,
 Typeable versionNumber, Show versionNumber, Ord peerAddr,
 Typeable peerAddr, Show peerAddr) =>
PeerStateActionsArguments
  muxMode
  socket
  responderCtx
  peerAddr
  versionData
  versionNumber
  m
  a
  b
-> (PeerStateActions
      peerAddr
      (PeerConnectionHandle
         muxMode responderCtx peerAddr versionData ByteString m a b)
      m
    -> m x)
-> m x
withPeerStateActions
              PeerStateActionsArguments {
                    spsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
spsTracer = Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer,
                    spsDeactivateTimeout :: DiffTime
spsDeactivateTimeout = DiffTime
Diffusion.Policies.deactivateTimeout,
                    spsCloseConnectionTimeout :: DiffTime
spsCloseConnectionTimeout =
                      DiffTime
Diffusion.Policies.closeConnectionTimeout,
                    spsConnectionManager :: MuxConnectionManager
  muxMode
  socket
  (ExpandedInitiatorContext ntnAddr m)
  responderCtx
  ntnAddr
  ntnVersionData
  ntnVersion
  ByteString
  m
  a
  b
spsConnectionManager = MuxConnectionManager
  muxMode
  socket
  (ExpandedInitiatorContext ntnAddr m)
  responderCtx
  ntnAddr
  ntnVersionData
  ntnVersion
  ByteString
  m
  a
  b
connectionManager,
                    spsExitPolicy :: ExitPolicy a
spsExitPolicy = ExitPolicy a
exitPolicy,
                    spsRethrowPolicy :: RethrowPolicy
spsRethrowPolicy = RethrowPolicy
rethrowPolicy,
                    spsMainThreadId :: ThreadId m
spsMainThreadId = ThreadId m
mainThreadId
                  }

      dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore
      --
      -- Run peer selection (p2p governor)
      --
      let withPeerSelectionActions'
            :: forall muxMode responderCtx bytes a1 b c.
               m (Map ntnAddr PeerSharing)
            -> PeerSelectionActionsDiffusionMode ntnAddr (PeerConnectionHandle muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b) m
            -> (   (Async m Void, Async m Void)
                -> PeerSelectionActions
                     ntnAddr
                     (PeerConnectionHandle
                        muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
                      m
                -> m c)
            -- ^ continuation, receives a handle to the local roots peer provider thread
            -- (only if local root peers were non-empty).
            -> m c
          withPeerSelectionActions' m (Map ntnAddr PeerSharing)
readInboundPeers =
              StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (PeerAdvertise, PeerTrustable))]
-> PeerActionsDNS ntnAddr resolver resolverError m
-> PeerSelectionActionsArgs
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
     resolverError
     m
-> WithLedgerPeersArgs m
-> PeerSelectionActionsDiffusionMode
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
         m
    -> m c)
-> m c
forall peeraddr peerconn resolver exception (m :: * -> *) a.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadThrow m,
 MonadMVar m, Ord peeraddr, Exception exception) =>
StrictTVar m (Config peeraddr)
-> PeerActionsDNS peeraddr resolver exception m
-> PeerSelectionActionsArgs peeraddr peerconn exception m
-> WithLedgerPeersArgs m
-> PeerSelectionActionsDiffusionMode peeraddr peerconn m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions peeraddr peerconn m -> m a)
-> m a
withPeerSelectionActions StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (PeerAdvertise, PeerTrustable))]
localRootsVar PeerActionsDNS {
                                         paToPeerAddr :: IP -> PortNumber -> ntnAddr
paToPeerAddr = IP -> PortNumber -> ntnAddr
diNtnToPeerAddr,
                                         paDnsActions :: DNSActions resolver resolverError m
paDnsActions = DNSLookupType -> DNSActions resolver resolverError m
diDnsActions DNSLookupType
lookupReqs,
                                         paDnsSemaphore :: DNSSemaphore m
paDnsSemaphore = DNSSemaphore m
dnsSemaphore }
                                       PeerSelectionActionsArgs {
                                         psLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers ntnAddr resolverError)
psLocalRootPeersTracer = Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer,
                                         psPublicRootPeersTracer :: Tracer m TracePublicRootPeers
psPublicRootPeersTracer = Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer,
                                         psReadTargets :: STM m PeerSelectionTargets
psReadTargets = StrictTVar m PeerSelectionTargets -> STM m PeerSelectionTargets
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar,
                                         getLedgerStateCtx :: LedgerPeersConsensusInterface m
getLedgerStateCtx = LedgerPeersConsensusInterface m
daLedgerPeersCtx,
                                         psReadLocalRootPeers :: STM m (Config RelayAccessPoint)
psReadLocalRootPeers = STM m (Config RelayAccessPoint)
daReadLocalRootPeers,
                                         psReadPublicRootPeers :: STM m (Map RelayAccessPoint PeerAdvertise)
psReadPublicRootPeers = STM m (Map RelayAccessPoint PeerAdvertise)
daReadPublicRootPeers,
                                         psReadUseBootstrapPeers :: STM m UseBootstrapPeers
psReadUseBootstrapPeers = STM m UseBootstrapPeers
daReadUseBootstrapPeers,
                                         psPeerSharing :: PeerSharing
psPeerSharing = PeerSharing
daOwnPeerSharing,
                                         psPeerConnToPeerSharing :: PeerConnectionHandle
  muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b
-> PeerSharing
psPeerConnToPeerSharing = (ntnVersionData -> PeerSharing)
-> PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b
-> PeerSharing
forall versionData (muxMode :: Mode) responderCtx peerAddr bytes
       (m :: * -> *) a b.
(versionData -> PeerSharing)
-> PeerConnectionHandle
     muxMode responderCtx peerAddr versionData bytes m a b
-> PeerSharing
pchPeerSharing ntnVersionData -> PeerSharing
diNtnPeerSharing,
                                         psReadPeerSharingController :: STM m (Map ntnAddr (PeerSharingController ntnAddr m))
psReadPeerSharingController = StrictTVar m (Map ntnAddr (PeerSharingController ntnAddr m))
-> STM m (Map ntnAddr (PeerSharingController ntnAddr m))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar (PeerSharingRegistry ntnAddr m
-> StrictTVar m (Map ntnAddr (PeerSharingController ntnAddr m))
forall peer (m :: * -> *).
PeerSharingRegistry peer m
-> StrictTVar m (Map peer (PeerSharingController peer m))
getPeerSharingRegistry PeerSharingRegistry ntnAddr m
daPeerSharingRegistry),
                                         psReadInboundPeers :: m (Map ntnAddr PeerSharing)
psReadInboundPeers =
                                           case PeerSharing
daOwnPeerSharing of
                                             PeerSharing
PeerSharingDisabled -> Map ntnAddr PeerSharing -> m (Map ntnAddr PeerSharing)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ntnAddr PeerSharing
forall k a. Map k a
Map.empty
                                             PeerSharing
PeerSharingEnabled  -> m (Map ntnAddr PeerSharing)
readInboundPeers,
                                         psUpdateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
psUpdateOutboundConnectionsState = OutboundConnectionsState -> STM m ()
daUpdateOutboundConnectionsState,
                                         peerTargets :: ConsensusModePeerTargets
peerTargets = ConsensusModePeerTargets
daPeerTargets,
                                         readLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
readLedgerPeerSnapshot = STM m (Maybe LedgerPeerSnapshot)
daReadLedgerPeerSnapshot }
                                       WithLedgerPeersArgs {
                                         wlpRng :: StdGen
wlpRng = StdGen
ledgerPeersRng,
                                         wlpConsensusInterface :: LedgerPeersConsensusInterface m
wlpConsensusInterface = LedgerPeersConsensusInterface m
daLedgerPeersCtx,
                                         wlpTracer :: Tracer m TraceLedgerPeers
wlpTracer = Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer,
                                         wlpGetUseLedgerPeers :: STM m UseLedgerPeers
wlpGetUseLedgerPeers = STM m UseLedgerPeers
daReadUseLedgerPeers,
                                         wlpGetLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
wlpGetLedgerPeerSnapshot = STM m (Maybe LedgerPeerSnapshot)
daReadLedgerPeerSnapshot }

          peerSelectionGovernor'
            :: forall (muxMode :: Mx.Mode) b.
               Tracer m (DebugPeerSelection ntnAddr)
            -> StrictTVar m (PeerSelectionState ntnAddr
                              (NodeToNodePeerConnectionHandle
                               muxMode ntnAddr ntnVersionData m a b))
            -> NodeToNodePeerSelectionActions muxMode ntnAddr ntnVersionData m a b
            -> m Void
          peerSelectionGovernor' Tracer m (DebugPeerSelection ntnAddr)
peerSelectionTracer StrictTVar
  m
  (PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        muxMode ntnAddr ntnVersionData m a b))
dbgVar NodeToNodePeerSelectionActions muxMode ntnAddr ntnVersionData m a b
peerSelectionActions =
            Tracer m (TracePeerSelection ntnAddr)
-> Tracer m (DebugPeerSelection ntnAddr)
-> Tracer m PeerSelectionCounters
-> StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> NodeToNodePeerSelectionActions
     muxMode ntnAddr ntnVersionData m a b
-> PeerSelectionPolicy ntnAddr m
-> PeerSelectionInterfaces
     ntnAddr
     (NodeToNodePeerConnectionHandle
        muxMode ntnAddr ntnVersionData m a b)
     m
-> m Void
forall (m :: * -> *) peeraddr peerconn.
(Alternative (STM m), MonadAsync m, MonadDelay m,
 MonadLabelledSTM m, MonadMask m, MonadTimer m, Ord peeraddr,
 Show peerconn, Hashable peeraddr) =>
Tracer m (TracePeerSelection peeraddr)
-> Tracer m (DebugPeerSelection peeraddr)
-> Tracer m PeerSelectionCounters
-> StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces peeraddr peerconn m
-> m Void
Governor.peerSelectionGovernor
              Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
              Tracer m (DebugPeerSelection ntnAddr)
peerSelectionTracer
              Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
              StdGen
fuzzRng
              ConsensusMode
daConsensusMode
              MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState
              NodeToNodePeerSelectionActions muxMode ntnAddr ntnVersionData m a b
peerSelectionActions
              PeerSelectionPolicy ntnAddr m
peerSelectionPolicy
              PeerSelectionInterfaces {
                StrictTVar m PeerSelectionCounters
countersVar :: StrictTVar m PeerSelectionCounters
countersVar :: StrictTVar m PeerSelectionCounters
countersVar,
                publicStateVar :: StrictTVar m (PublicPeerSelectionState ntnAddr)
publicStateVar     = StrictTVar m (PublicPeerSelectionState ntnAddr)
daPublicPeerSelectionVar,
                debugStateVar :: StrictTVar
  m
  (PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        muxMode ntnAddr ntnVersionData m a b))
debugStateVar      = StrictTVar
  m
  (PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        muxMode ntnAddr ntnVersionData m a b))
dbgVar,
                readUseLedgerPeers :: STM m UseLedgerPeers
readUseLedgerPeers = STM m UseLedgerPeers
daReadUseLedgerPeers
              }


      --
      -- The peer churn governor:
      --
      let peerChurnGovernor' = PeerChurnArgs m ntnAddr -> m Void
forall (m :: * -> *) peeraddr.
(MonadDelay m, Alternative (STM m), MonadTimer m, MonadCatch m) =>
PeerChurnArgs m peeraddr -> m Void
Governor.peerChurnGovernor PeerChurnArgs {
                                 pcaPeerSelectionTracer :: Tracer m (TracePeerSelection ntnAddr)
pcaPeerSelectionTracer = Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer,
                                 pcaChurnTracer :: Tracer m ChurnCounters
pcaChurnTracer         = Tracer m ChurnCounters
dtTraceChurnCounters,
                                 pcaDeadlineInterval :: DiffTime
pcaDeadlineInterval    = DiffTime
daDeadlineChurnInterval,
                                 pcaBulkInterval :: DiffTime
pcaBulkInterval        = DiffTime
daBulkChurnInterval,
                                 pcaPeerRequestTimeout :: DiffTime
pcaPeerRequestTimeout  = PeerSelectionPolicy ntnAddr m -> DiffTime
forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPeerShareOverallTimeout
                                                            PeerSelectionPolicy ntnAddr m
peerSelectionPolicy,
                                 pcaMetrics :: PeerMetrics m ntnAddr
pcaMetrics             = PeerMetrics m ntnAddr
daPeerMetrics,
                                 pcaModeVar :: StrictTVar m ChurnMode
pcaModeVar             = StrictTVar m ChurnMode
churnModeVar,
                                 pcaRng :: StdGen
pcaRng                 = StdGen
churnRng,
                                 pcaReadFetchMode :: STM m FetchMode
pcaReadFetchMode       = STM m FetchMode
daBlockFetchMode,
                                 pcaPeerSelectionVar :: StrictTVar m PeerSelectionTargets
pcaPeerSelectionVar    = StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar,
                                 pcaReadCounters :: STM m PeerSelectionCounters
pcaReadCounters        = StrictTVar m PeerSelectionCounters -> STM m PeerSelectionCounters
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m PeerSelectionCounters
countersVar,
                                 peerTargets :: ConsensusModePeerTargets
peerTargets            = ConsensusModePeerTargets
daPeerTargets,
                                 pcaReadUseBootstrap :: STM m UseBootstrapPeers
pcaReadUseBootstrap    = STM m UseBootstrapPeers
daReadUseBootstrapPeers,
                                 pcaConsensusMode :: ConsensusMode
pcaConsensusMode       = ConsensusMode
daConsensusMode,
                                 getLedgerStateCtx :: LedgerPeersConsensusInterface m
getLedgerStateCtx      = LedgerPeersConsensusInterface m
daLedgerPeersCtx,
                                 getLocalRootHotTarget :: STM m HotValency
getLocalRootHotTarget  =
                                       LocalRootPeers ntnAddr -> HotValency
forall peeraddr. LocalRootPeers peeraddr -> HotValency
LocalRootPeers.hotTarget
                                     (LocalRootPeers ntnAddr -> HotValency)
-> ([(HotValency, WarmValency,
      Map ntnAddr (PeerAdvertise, PeerTrustable))]
    -> LocalRootPeers ntnAddr)
-> [(HotValency, WarmValency,
     Map ntnAddr (PeerAdvertise, PeerTrustable))]
-> HotValency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalRootPeers ntnAddr -> LocalRootPeers ntnAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable
                                     (LocalRootPeers ntnAddr -> LocalRootPeers ntnAddr)
-> ([(HotValency, WarmValency,
      Map ntnAddr (PeerAdvertise, PeerTrustable))]
    -> LocalRootPeers ntnAddr)
-> [(HotValency, WarmValency,
     Map ntnAddr (PeerAdvertise, PeerTrustable))]
-> LocalRootPeers ntnAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HotValency, WarmValency,
  Map ntnAddr (PeerAdvertise, PeerTrustable))]
-> LocalRootPeers ntnAddr
forall peeraddr.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (PeerAdvertise, PeerTrustable))]
-> LocalRootPeers peeraddr
LocalRootPeers.fromGroups
                                   ([(HotValency, WarmValency,
   Map ntnAddr (PeerAdvertise, PeerTrustable))]
 -> HotValency)
-> STM
     m
     [(HotValency, WarmValency,
       Map ntnAddr (PeerAdvertise, PeerTrustable))]
-> STM m HotValency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (PeerAdvertise, PeerTrustable))]
-> STM
     m
     [(HotValency, WarmValency,
       Map ntnAddr (PeerAdvertise, PeerTrustable))]
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (PeerAdvertise, PeerTrustable))]
localRootsVar }

      --
      -- Part (b): capturing the major control-flow of runM:
      --
      case diffusionMode of

        -- InitiatorOnly mode, run peer selection only:
        DiffusionMode
InitiatorOnlyDiffusionMode ->
          (ConnectionManager
   'InitiatorMode
   ntnFd
   ntnAddr
   (Handle
      'InitiatorMode
      (ExpandedInitiatorContext ntnAddr m)
      (ResponderContext ntnAddr)
      ntnVersionData
      ByteString
      m
      a
      Void)
   (HandleError 'InitiatorMode ntnVersion)
   m
 -> m Void)
-> m Void
withConnectionManagerInitiatorOnlyMode ((ConnectionManager
    'InitiatorMode
    ntnFd
    ntnAddr
    (Handle
       'InitiatorMode
       (ExpandedInitiatorContext ntnAddr m)
       (ResponderContext ntnAddr)
       ntnVersionData
       ByteString
       m
       a
       Void)
    (HandleError 'InitiatorMode ntnVersion)
    m
  -> m Void)
 -> m Void)
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         Void)
      (HandleError 'InitiatorMode ntnVersion)
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
connectionManager-> do
          debugStateVar <- PeerSelectionState
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
-> m (StrictTVar
        m
        (PeerSelectionState
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorMode ntnAddr ntnVersionData m a Void)))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (PeerSelectionState
   ntnAddr
   (NodeToNodePeerConnectionHandle
      'InitiatorMode ntnAddr ntnVersionData m a Void)
 -> m (StrictTVar
         m
         (PeerSelectionState
            ntnAddr
            (NodeToNodePeerConnectionHandle
               'InitiatorMode ntnAddr ntnVersionData m a Void))))
-> PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
-> m (StrictTVar
        m
        (PeerSelectionState
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorMode ntnAddr ntnVersionData m a Void)))
forall a b. (a -> b) -> a -> b
$ StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
forall peeraddr peerconn.
StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState peeraddr peerconn
emptyPeerSelectionState StdGen
fuzzRng ConsensusMode
daConsensusMode MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState
          diInstallSigUSR1Handler connectionManager debugStateVar daPeerMetrics
          withPeerStateActions' connectionManager $ \PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
peerStateActions->
            m (Map ntnAddr PeerSharing)
-> PeerSelectionActionsDiffusionMode
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (NodeToNodePeerConnectionHandle
            'InitiatorMode ntnAddr ntnVersionData m a Void)
         m
    -> m Void)
-> m Void
forall (muxMode :: Mode) responderCtx bytes a1 b c.
m (Map ntnAddr PeerSharing)
-> PeerSelectionActionsDiffusionMode
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
         m
    -> m c)
-> m c
withPeerSelectionActions'
              (Map ntnAddr PeerSharing -> m (Map ntnAddr PeerSharing)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map ntnAddr PeerSharing
forall k a. Map k a
Map.empty)
              PeerSelectionActionsDiffusionMode { psPeerStateActions :: PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
psPeerStateActions = PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
peerStateActions } (((Async m Void, Async m Void)
  -> PeerSelectionActions
       ntnAddr
       (NodeToNodePeerConnectionHandle
          'InitiatorMode ntnAddr ntnVersionData m a Void)
       m
  -> m Void)
 -> m Void)
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (NodeToNodePeerConnectionHandle
            'InitiatorMode ntnAddr ntnVersionData m a Void)
         m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$
              \(Async m Void
ledgerPeersThread, Async m Void
localRootPeersProvider) PeerSelectionActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
peerSelectionActions->
                m Void -> (Async m Void -> m Void) -> m Void
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                  (Tracer m (DebugPeerSelection ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        ntnAddr
        (NodeToNodePeerConnectionHandle
           'InitiatorMode ntnAddr ntnVersionData m a Void))
-> PeerSelectionActions
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
     m
-> m Void
forall (muxMode :: Mode) b.
Tracer m (DebugPeerSelection ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        ntnAddr
        (NodeToNodePeerConnectionHandle
           muxMode ntnAddr ntnVersionData m a b))
-> NodeToNodePeerSelectionActions
     muxMode ntnAddr ntnVersionData m a b
-> m Void
peerSelectionGovernor'
                    Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorTracer
                    StrictTVar
  m
  (PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void))
debugStateVar
                    PeerSelectionActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
peerSelectionActions) ((Async m Void -> m Void) -> m Void)
-> (Async m Void -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
governorThread ->
                    m Void -> (Async m Void -> m Void) -> m Void
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                      m Void
peerChurnGovernor' ((Async m Void -> m Void) -> m Void)
-> (Async m Void -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
churnGovernorThread ->
                      -- wait for any thread to fail:
                      (Async m Void, Void) -> Void
forall a b. (a, b) -> b
snd ((Async m Void, Void) -> Void) -> m (Async m Void, Void) -> m Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Async m Void] -> m (Async m Void, Void)
forall a. [Async m a] -> m (Async m a, a)
forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
Async.waitAny
                                [Async m Void
ledgerPeersThread, Async m Void
localRootPeersProvider, Async m Void
governorThread, Async m Void
churnGovernorThread]

        -- InitiatorAndResponder mode, run peer selection and the server:
        DiffusionMode
InitiatorAndResponderDiffusionMode -> do
          inboundInfoChannel  <- m (InformationChannel
     (NewConnectionInfo
        ntnAddr
        (Handle
           'InitiatorResponderMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           ()))
     m)
forall a (m :: * -> *).
MonadLabelledSTM m =>
m (InformationChannel a m)
newInformationChannel
          withConnectionManagerInitiatorAndResponderMode
            inboundInfoChannel $ \ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager ->
              --
              -- node-to-node sockets
              --
              Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> Snocket m ntnFd ntnAddr
-> (ntnFd -> ntnAddr -> m ())
-> (ntnFd -> ntnAddr -> m ())
-> [Either ntnFd ntnAddr]
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void)
-> m Void
forall (m :: * -> *) ntnFd ntnAddr ntcAddr a.
(MonadCatch m, Typeable ntnAddr, Show ntnAddr) =>
Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> Snocket m ntnFd ntnAddr
-> (ntnFd -> ntnAddr -> m ())
-> (ntnFd -> ntnAddr -> m ())
-> [Either ntnFd ntnAddr]
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a)
-> m a
withSockets
                Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer
                Snocket m ntnFd ntnAddr
diNtnSnocket
                (\ntnFd
sock ntnAddr
addr -> ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket ntnFd
sock (ntnAddr -> Maybe ntnAddr
forall a. a -> Maybe a
Just ntnAddr
addr))
                (\ntnFd
sock ntnAddr
addr -> ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket ntnFd
sock ntnAddr
addr)
                ([Maybe (Either ntnFd ntnAddr)] -> [Either ntnFd ntnAddr]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Either ntnFd ntnAddr)
daIPv4Address, Maybe (Either ntnFd ntnAddr)
daIPv6Address])
                ((NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void)
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \NonEmpty ntnFd
sockets NonEmpty ntnAddr
addresses ->
                  --
                  -- node-to-node server
                  --
                  Arguments
  'InitiatorResponderMode
  ntnFd
  (ExpandedInitiatorContext ntnAddr m)
  ntnAddr
  ntnVersionData
  ntnVersion
  ByteString
  m
  a
  ()
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData) -> m Void)
-> m Void
forall (muxMode :: Mode) socket initiatorCtx peerAddr versionData
       versionNumber (m :: * -> *) a b x.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadCatch m,
 MonadEvaluate m, MonadLabelledSTM m, MonadMask m,
 MonadThrow (STM m), MonadTime m, MonadTimer m,
 HasResponder muxMode ~ 'True, Ord peerAddr, Show peerAddr) =>
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
-> (Async m Void -> m (PublicState peerAddr versionData) -> m x)
-> m x
Server.with
                    Server.Arguments {
                        sockets :: NonEmpty ntnFd
Server.sockets               = NonEmpty ntnFd
sockets,
                        snocket :: Snocket m ntnFd ntnAddr
Server.snocket               = Snocket m ntnFd ntnAddr
diNtnSnocket,
                        tracer :: Tracer m (Trace ntnAddr)
Server.tracer                = Tracer m (Trace ntnAddr)
dtServerTracer,
                        trTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
Server.trTracer              = Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer,
                        debugInboundGovernor :: Tracer m (Debug ntnAddr ntnVersionData)
Server.debugInboundGovernor  = Tracer m (Debug ntnAddr ntnVersionData)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer,
                        inboundGovernorTracer :: Tracer m (Trace ntnAddr)
Server.inboundGovernorTracer = Tracer m (Trace ntnAddr)
dtInboundGovernorTracer,
                        connectionLimits :: AcceptedConnectionsLimit
Server.connectionLimits      = AcceptedConnectionsLimit
daAcceptedConnectionsLimit,
                        connectionManager :: ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
Server.connectionManager     = ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager,
                        connectionDataFlow :: ntnVersionData -> DataFlow
Server.connectionDataFlow    = ntnVersionData -> DataFlow
diNtnDataFlow,
                        inboundIdleTimeout :: Maybe DiffTime
Server.inboundIdleTimeout    = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
daProtocolIdleTimeout,
                        inboundInfoChannel :: InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
Server.inboundInfoChannel    = InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
inboundInfoChannel
                      } ((Async m Void -> m (PublicState ntnAddr ntnVersionData) -> m Void)
 -> m Void)
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData) -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
inboundGovernorThread m (PublicState ntnAddr ntnVersionData)
readInboundState -> do
                    debugStateVar <- PeerSelectionState
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
-> m (StrictTVar
        m
        (PeerSelectionState
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorResponderMode ntnAddr ntnVersionData m a ())))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (PeerSelectionState
   ntnAddr
   (NodeToNodePeerConnectionHandle
      'InitiatorResponderMode ntnAddr ntnVersionData m a ())
 -> m (StrictTVar
         m
         (PeerSelectionState
            ntnAddr
            (NodeToNodePeerConnectionHandle
               'InitiatorResponderMode ntnAddr ntnVersionData m a ()))))
-> PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
-> m (StrictTVar
        m
        (PeerSelectionState
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorResponderMode ntnAddr ntnVersionData m a ())))
forall a b. (a -> b) -> a -> b
$ StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
forall peeraddr peerconn.
StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState peeraddr peerconn
emptyPeerSelectionState StdGen
fuzzRng ConsensusMode
daConsensusMode MinBigLedgerPeersForTrustedState
daMinBigLedgerPeersForTrustedState
                    diInstallSigUSR1Handler connectionManager debugStateVar daPeerMetrics
                    withPeerStateActions' connectionManager $ \PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
peerStateActions ->
                      m (Map ntnAddr PeerSharing)
-> PeerSelectionActionsDiffusionMode
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (NodeToNodePeerConnectionHandle
            'InitiatorResponderMode ntnAddr ntnVersionData m a ())
         m
    -> m Void)
-> m Void
forall (muxMode :: Mode) responderCtx bytes a1 b c.
m (Map ntnAddr PeerSharing)
-> PeerSelectionActionsDiffusionMode
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a1 b)
         m
    -> m c)
-> m c
withPeerSelectionActions'
                        (PublicState ntnAddr ntnVersionData -> Map ntnAddr PeerSharing
mkInboundPeersMap (PublicState ntnAddr ntnVersionData -> Map ntnAddr PeerSharing)
-> m (PublicState ntnAddr ntnVersionData)
-> m (Map ntnAddr PeerSharing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (PublicState ntnAddr ntnVersionData)
readInboundState)
                        PeerSelectionActionsDiffusionMode { psPeerStateActions :: PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
psPeerStateActions = PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
peerStateActions } (((Async m Void, Async m Void)
  -> PeerSelectionActions
       ntnAddr
       (NodeToNodePeerConnectionHandle
          'InitiatorResponderMode ntnAddr ntnVersionData m a ())
       m
  -> m Void)
 -> m Void)
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (NodeToNodePeerConnectionHandle
            'InitiatorResponderMode ntnAddr ntnVersionData m a ())
         m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$
                          \(Async m Void
ledgerPeersThread, Async m Void
localRootPeersProvider) PeerSelectionActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
peerSelectionActions ->
                            m Void -> (Async m Void -> m Void) -> m Void
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                              (Tracer m (DebugPeerSelection ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        ntnAddr
        (NodeToNodePeerConnectionHandle
           'InitiatorResponderMode ntnAddr ntnVersionData m a ()))
-> PeerSelectionActions
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
     m
-> m Void
forall (muxMode :: Mode) b.
Tracer m (DebugPeerSelection ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        ntnAddr
        (NodeToNodePeerConnectionHandle
           muxMode ntnAddr ntnVersionData m a b))
-> NodeToNodePeerSelectionActions
     muxMode ntnAddr ntnVersionData m a b
-> m Void
peerSelectionGovernor' Tracer m (DebugPeerSelection ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer StrictTVar
  m
  (PeerSelectionState
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ()))
debugStateVar PeerSelectionActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
peerSelectionActions) ((Async m Void -> m Void) -> m Void)
-> (Async m Void -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
governorThread -> do
                                -- begin, unique to InitiatorAndResponder mode:
                                Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> DiffusionTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer (NonEmpty ntnAddr -> DiffusionTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
NonEmpty ntnAddr -> DiffusionTracer ntnAddr ntcAddr
RunServer NonEmpty ntnAddr
addresses)
                                -- end, unique to ...
                                m Void -> (Async m Void -> m Void) -> m Void
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync m Void
peerChurnGovernor' ((Async m Void -> m Void) -> m Void)
-> (Async m Void -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
churnGovernorThread ->
                                  -- wait for any thread to fail:
                                  (Async m Void, Void) -> Void
forall a b. (a, b) -> b
snd ((Async m Void, Void) -> Void) -> m (Async m Void, Void) -> m Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Async m Void] -> m (Async m Void, Void)
forall a. [Async m a] -> m (Async m a, a)
forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
Async.waitAny [Async m Void
ledgerPeersThread, Async m Void
localRootPeersProvider, Async m Void
governorThread, Async m Void
churnGovernorThread, Async m Void
inboundGovernorThread]

-- | Main entry point for data diffusion service.  It allows to:
--
-- * connect to upstream peers;
-- * accept connection from downstream peers, if run in
--  'InitiatorAndResponderDiffusionMode'.
-- * runs a local service which allows to use node-to-client protocol to obtain
--   information from the running system.  This is used by 'cardano-cli' or
--   a wallet and a like local services.
--
run
    :: Tracers RemoteAddress NodeToNodeVersion
               LocalAddress  NodeToClientVersion
               IO
    -> TracersExtra RemoteAddress NodeToNodeVersion   NodeToNodeVersionData
                    LocalAddress  NodeToClientVersion NodeToClientVersionData
                    IOException IO
    -> Arguments IO
                 Socket      RemoteAddress
                 LocalSocket LocalAddress
    -> ArgumentsExtra IO
    -> Applications
         RemoteAddress NodeToNodeVersion   NodeToNodeVersionData
         LocalAddress  NodeToClientVersion NodeToClientVersionData
         IO a
    -> ApplicationsExtra RemoteAddress IO a
    -> IO Void
run :: forall a.
Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> TracersExtra
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IOException
     IO
-> Arguments IO Socket SockAddr LocalSocket LocalAddress
-> ArgumentsExtra IO
-> Applications
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
     a
-> ApplicationsExtra SockAddr IO a
-> IO Void
run Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
tracersExtra Arguments IO Socket SockAddr LocalSocket LocalAddress
args ArgumentsExtra IO
argsExtra Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
  a
apps ApplicationsExtra SockAddr IO a
appsExtra = do
    let tracer :: Tracer IO (DiffusionTracer SockAddr LocalAddress)
tracer = Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> Tracer IO (DiffusionTracer SockAddr LocalAddress)
forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers
    -- We run two services: for /node-to-node/ and /node-to-client/.  The
    -- naming convention is that we use /local/ prefix for /node-to-client/
    -- related terms, as this is a local only service running over a unix
    -- socket / windows named pipe.
    (SomeException -> Maybe SomeException)
-> (SomeException -> IO Void) -> IO Void -> IO Void
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust (\SomeException
e -> case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e :: Maybe ExitCode of
                  Maybe ExitCode
Nothing -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
                  Just {} -> Maybe SomeException
forall a. Maybe a
Nothing)
               (\SomeException
e -> Tracer IO (DiffusionTracer SockAddr LocalAddress)
-> DiffusionTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (DiffusionTracer SockAddr LocalAddress)
tracer (SomeException -> DiffusionTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
SomeException -> DiffusionTracer ntnAddr ntcAddr
DiffusionErrored SomeException
e)
                   IO () -> IO Void -> IO Void
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Failure -> IO Void
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (SomeException -> Failure
DiffusionError SomeException
e))
         (IO Void -> IO Void) -> IO Void -> IO Void
forall a b. (a -> b) -> a -> b
$ (IOManager -> IO Void) -> IO Void
WithIOManager
withIOManager ((IOManager -> IO Void) -> IO Void)
-> (IOManager -> IO Void) -> IO Void
forall a b. (a -> b) -> a -> b
$ \IOManager
iocp -> do
             let diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId SockAddr) NodeToNodeVersion NodeToNodeVersionData IO
diNtnHandshakeArguments =
                   HandshakeArguments {
                       haHandshakeTracer :: Tracer
  IO
  (WithBearer
     (ConnectionId SockAddr)
     (TraceSendRecv (Handshake NodeToNodeVersion Term)))
haHandshakeTracer = Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> Tracer
     IO
     (WithBearer
        (ConnectionId SockAddr)
        (TraceSendRecv (Handshake NodeToNodeVersion Term)))
forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntnAddr ntnVersion)
dtHandshakeTracer Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers,
                       haHandshakeCodec :: Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
haHandshakeCodec  = Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
NodeToNode.nodeToNodeHandshakeCodec,
                       haVersionDataCodec :: VersionDataCodec Term NodeToNodeVersion NodeToNodeVersionData
haVersionDataCodec =
                         (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> VersionDataCodec Term NodeToNodeVersion NodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec
                           NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
NodeToNode.nodeToNodeCodecCBORTerm,
                       haAcceptVersion :: NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
haAcceptVersion = NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion,
                       haQueryVersion :: NodeToNodeVersionData -> Bool
haQueryVersion = NodeToNodeVersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion,
                       haTimeLimits :: ProtocolTimeLimits (Handshake NodeToNodeVersion Term)
haTimeLimits = ProtocolTimeLimits (Handshake NodeToNodeVersion Term)
forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
timeLimitsHandshake
                     }
                 diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId LocalAddress)
  NodeToClientVersion
  NodeToClientVersionData
  IO
diNtcHandshakeArguments =
                   HandshakeArguments {
                       haHandshakeTracer :: Tracer
  IO
  (WithBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
haHandshakeTracer  = Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> Tracer
     IO
     (WithBearer
        (ConnectionId LocalAddress)
        (TraceSendRecv (Handshake NodeToClientVersion Term)))
forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntcAddr ntcVersion)
dtLocalHandshakeTracer Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers,
                       haHandshakeCodec :: Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
haHandshakeCodec   = Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  m
  ByteString
NodeToClient.nodeToClientHandshakeCodec,
                       haVersionDataCodec :: VersionDataCodec Term NodeToClientVersion NodeToClientVersionData
haVersionDataCodec =
                         (NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec
                           NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
NodeToClient.nodeToClientCodecCBORTerm,
                       haAcceptVersion :: NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
haAcceptVersion = NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion,
                       haQueryVersion :: NodeToClientVersionData -> Bool
haQueryVersion = NodeToClientVersionData -> Bool
forall v. Queryable v => v -> Bool
queryVersion,
                       haTimeLimits :: ProtocolTimeLimits (Handshake NodeToClientVersion Term)
haTimeLimits = ProtocolTimeLimits (Handshake NodeToClientVersion Term)
forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake
                     }

                 diInstallSigUSR1Handler
                   :: forall mode x y ntnconn.
                      NodeToNodeConnectionManager mode Socket RemoteAddress
                                                  NodeToNodeVersionData NodeToNodeVersion IO x y
                   -> StrictTVar IO (PeerSelectionState RemoteAddress ntnconn)
                   -> PeerMetrics IO RemoteAddress
                   -> IO ()
#ifdef POSIX
                 diInstallSigUSR1Handler :: forall (mode :: Mode) x y ntnconn.
NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersionData NodeToNodeVersion IO x y
-> StrictTVar IO (PeerSelectionState SockAddr ntnconn)
-> PeerMetrics IO SockAddr
-> IO ()
diInstallSigUSR1Handler = \NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersionData NodeToNodeVersion IO x y
connectionManager StrictTVar IO (PeerSelectionState SockAddr ntnconn)
dbgStateVar PeerMetrics IO SockAddr
metrics -> do
                   _ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler
                     Signal
Signals.sigUSR1
                     (IO () -> Handler
Signals.Catch
                       (do state <- STM IO (Map SockAddr AbstractState)
-> IO (Map SockAddr AbstractState)
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Map SockAddr AbstractState)
 -> IO (Map SockAddr AbstractState))
-> STM IO (Map SockAddr AbstractState)
-> IO (Map SockAddr AbstractState)
forall a b. (a -> b) -> a -> b
$ NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersionData NodeToNodeVersion IO x y
-> STM IO (Map SockAddr AbstractState)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> STM m (Map peerAddr AbstractState)
readState NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersionData NodeToNodeVersion IO x y
connectionManager
                           traceWith (dtConnectionManagerTracer tracersExtra)
                                     (CM.TrState state)
                           ps <- readTVarIO dbgStateVar
                           now <- getMonotonicTime
                           (up, bp, lsj, am) <- atomically $
                                                  (,,,) <$> upstreamyness metrics
                                                        <*> fetchynessBlocks metrics
                                                        <*> lpGetLedgerStateJudgement (daLedgerPeersCtx apps)
                                                        <*> Governor.readAssociationMode
                                                              (daReadUseLedgerPeers argsExtra)
                                                              (daOwnPeerSharing argsExtra)
                                                              (Governor.bootstrapPeersFlag ps)
                           let dbgState = PeerSelectionState SockAddr ntnconn
-> Map SockAddr Int
-> Map SockAddr Int
-> LedgerStateJudgement
-> AssociationMode
-> DebugPeerSelectionState SockAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> Map peeraddr Int
-> Map peeraddr Int
-> LedgerStateJudgement
-> AssociationMode
-> DebugPeerSelectionState peeraddr
makeDebugPeerSelectionState PeerSelectionState SockAddr ntnconn
ps Map SockAddr Int
up Map SockAddr Int
bp LedgerStateJudgement
lsj AssociationMode
am
                           traceWith (dtTracePeerSelectionTracer tracersExtra)
                                     (TraceDebugState now dbgState)
                       )
                     )
                     Maybe SignalSet
forall a. Maybe a
Nothing
                   return ()
#else
                 diInstallSigUSR1Handler = \_ _ _ -> pure ()
#endif

             diRng <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
             runM
               Interfaces {
                 diNtnSnocket = Snocket.socketSnocket iocp,
                 diNtnBearer = makeSocketBearer,
                 diNtnConfigureSocket = configureSocket,
                 diNtnConfigureSystemdSocket =
                   configureSystemdSocket
                     (SystemdSocketConfiguration `contramap` tracer),
                 diNtnHandshakeArguments,
                 diNtnAddressType = socketAddressType,
                 diNtnDataFlow = ntnDataFlow,
                 diNtnPeerSharing = peerSharing,
                 diNtnToPeerAddr = curry IP.toSockAddr,

                 diNtcSnocket = Snocket.localSnocket iocp,
                 diNtcBearer = makeLocalBearer,
                 diNtcHandshakeArguments,
                 diNtcGetFileDescriptor = localSocketFileDescriptor,

                 diRng,
                 diInstallSigUSR1Handler,
                 diDnsActions = ioDNSActions
               }
               tracers tracersExtra args argsExtra apps appsExtra


--
-- Data flow
--

-- | Node-To-Node protocol connections which negotiated
-- `InitiatorAndResponderDiffusionMode` are `Duplex`.
--
ntnDataFlow :: NodeToNodeVersionData -> DataFlow
ntnDataFlow :: NodeToNodeVersionData -> DataFlow
ntnDataFlow NodeToNodeVersionData { DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode } =
  case DiffusionMode
diffusionMode of
    DiffusionMode
InitiatorAndResponderDiffusionMode -> DataFlow
Duplex
    DiffusionMode
InitiatorOnlyDiffusionMode         -> DataFlow
Unidirectional


-- | All Node-To-Client protocol connections are considered 'Unidirectional'.
--
ntcDataFlow :: ntcVersionData -> DataFlow
ntcDataFlow :: forall ntcVersionData. ntcVersionData -> DataFlow
ntcDataFlow ntcVersionData
_ = DataFlow
Unidirectional