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

-- | This module is expected to be imported qualified.
--
module Ouroboros.Network.Diffusion
  ( run
  , runM
  , mkInterfaces
  , socketAddressType
  , module Ouroboros.Network.Diffusion.Types
  ) where


import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadMVar (MonadMVar)
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Exception (IOException)
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.Function ((&))
import Data.Hashable (Hashable)
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)
import Data.Typeable (Proxy (..), Typeable)
import Data.Void (Void)
import System.Exit (ExitCode)
import System.Random (StdGen, newStdGen, split)

import Network.DNS (Resolver)
import Network.Mux qualified as Mx
import Network.Mux.Bearer (withReadBufferIO)
import Network.Mux.Types
import Network.Socket (Socket)
import Network.Socket qualified as Socket

import Ouroboros.Network.ConnectionHandler
import Ouroboros.Network.ConnectionManager.Core qualified as CM
import Ouroboros.Network.ConnectionManager.State qualified as CM
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.Context (ExpandedInitiatorContext)
import Ouroboros.Network.Diffusion.Configuration
import Ouroboros.Network.Diffusion.Policies qualified as Diffusion.Policies
import Ouroboros.Network.Diffusion.Types
import Ouroboros.Network.Diffusion.Utils
import Ouroboros.Network.ExitPolicy
import Ouroboros.Network.InboundGovernor qualified as IG
import Ouroboros.Network.InboundGovernor.InformationChannel (InformationChannel,
           newInformationChannel)
import Ouroboros.Network.IOManager
import Ouroboros.Network.Mux hiding (MiniProtocol (..))
import Ouroboros.Network.MuxMode
import Ouroboros.Network.PeerSelection as PeerSelection
import Ouroboros.Network.PeerSelection.Churn as PeerSelection
import Ouroboros.Network.PeerSelection.PeerSelectionActions as PeerSelection
import Ouroboros.Network.PeerSelection.RootPeersDNS qualified as RootPeersDNS
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSharing (PeerSharingRegistry (..))
import Ouroboros.Network.Protocol.Handshake
import Ouroboros.Network.RethrowPolicy
import Ouroboros.Network.Server qualified as Server
import Ouroboros.Network.Snocket (LocalAddress, LocalSocket (..), RemoteAddress,
           localSocketFileDescriptor, makeLocalBearer, makeSocketBearer')
import Ouroboros.Network.Snocket qualified as Snocket
import Ouroboros.Network.Socket (configureSocket, configureSystemdSocket)


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


runM
    :: forall m ntnFd ntnAddr ntnVersion ntnVersionData
                ntcFd ntcAddr ntcVersion ntcVersionData
                resolver exception a
                extraState extraDebugState extraPeers
                extraAPI extraFlags extraChurnArgs
                extraCounters extraTrace.

       ( 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
       , Monoid extraPeers
       , Eq extraFlags
       , Eq extraCounters
       , Exception exception
       )
       -- | interfaces
    => Interfaces ntnFd ntnAddr ntcFd ntcAddr
                  resolver m
    -> -- | tracers
       Tracers ntnAddr ntnVersion ntnVersionData
               ntcAddr ntcVersion ntcVersionData
               extraState extraDebugState extraFlags
               extraPeers extraCounters extraTrace m
       -- | arguments
    -> Arguments extraState extraDebugState extraFlags
                 extraPeers extraAPI extraChurnArgs
                 extraCounters extraTrace
                 exception resolver m
                 ntnFd ntnAddr ntnVersion ntnVersionData
                       ntcAddr ntcVersion ntcVersionData
    -> -- | configuration
       Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr

    -> -- | protocol handlers
       Applications ntnAddr ntnVersion ntnVersionData
                    ntcAddr ntcVersion ntcVersionData
                    m a
    -> m Void
runM :: forall (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcFd
       ntcAddr ntcVersion ntcVersionData resolver exception a extraState
       extraDebugState extraPeers extraAPI extraFlags extraChurnArgs
       extraCounters extraTrace.
(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, Monoid extraPeers,
 Eq extraFlags, Eq extraCounters, Exception exception) =>
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> Tracers
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     extraTrace
     m
-> Arguments
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     extraTrace
     exception
     resolver
     m
     ntnFd
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
-> Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> Applications
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     m
     a
-> m Void
runM Interfaces
       { Snocket m ntnFd ntnAddr
diNtnSnocket :: Snocket m ntnFd ntnAddr
diNtnSnocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> Snocket m ntnFd ntnAddr
diNtnSnocket
       , MakeBearer m ntnFd
diNtnBearer :: MakeBearer m ntnFd
diNtnBearer :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> MakeBearer m ntnFd
diNtnBearer
       , (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer :: (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer
       , ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket :: ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket
       , ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket :: ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket
       , ntnAddr -> Maybe AddressType
diNtnAddressType :: ntnAddr -> Maybe AddressType
diNtnAddressType :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> ntnAddr -> Maybe AddressType
diNtnAddressType
       , IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
       , Snocket m ntcFd ntcAddr
diNtcSnocket :: Snocket m ntcFd ntcAddr
diNtcSnocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> Snocket m ntcFd ntcAddr
diNtcSnocket
       , MakeBearer m ntcFd
diNtcBearer :: MakeBearer m ntcFd
diNtcBearer :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> MakeBearer m ntcFd
diNtcBearer
       , ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> ntcFd -> m FileDescriptor
diNtcGetFileDescriptor
       , StdGen
diRng :: StdGen
diRng :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m -> StdGen
diRng
       , Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver m
diDnsActions :: Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver m
diDnsActions :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver m
diDnsActions
       , ConnStateIdSupply m
diConnStateIdSupply :: ConnStateIdSupply m
diConnStateIdSupply :: forall ntnFd ntnAddr ntcFd ntcAddr resolver (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver m
-> ConnStateIdSupply m
diConnStateIdSupply
       }
     Tracers
       { Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer
       , Tracer m (WithBearer (ConnectionId ntnAddr) ChannelTrace)
dtChannelTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) ChannelTrace)
dtChannelTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (WithBearer (ConnectionId ntnAddr) ChannelTrace)
dtChannelTracer
       , Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
dtBearerTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
dtBearerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
dtBearerTracer
       , Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer
       , Tracer m (WithBearer (ConnectionId ntcAddr) ChannelTrace)
dtLocalChannelTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) ChannelTrace)
dtLocalChannelTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (WithBearer (ConnectionId ntcAddr) ChannelTrace)
dtLocalChannelTracer
       , Tracer m (WithBearer (ConnectionId ntcAddr) BearerTrace)
dtLocalBearerTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) BearerTrace)
dtLocalBearerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (WithBearer (ConnectionId ntcAddr) BearerTrace)
dtLocalBearerTracer
       , dtDiffusionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer = Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer
       , Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace ntnAddr)
dtTracePeerSelectionTracer :: Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace ntnAddr)
dtTracePeerSelectionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer
     m
     (TracePeerSelection
        extraDebugState extraFlags extraPeers extraTrace ntnAddr)
dtTracePeerSelectionTracer
       , Tracer m ChurnCounters
dtTraceChurnCounters :: Tracer m ChurnCounters
dtTraceChurnCounters :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m ChurnCounters
dtTraceChurnCounters
       , Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorTracer :: Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorTracer
       , Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer :: Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer
       , Tracer m (PeerSelectionCounters extraCounters)
dtTracePeerSelectionCounters :: Tracer m (PeerSelectionCounters extraCounters)
dtTracePeerSelectionCounters :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (PeerSelectionCounters extraCounters)
dtTracePeerSelectionCounters
       , Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer
       , Tracer m (TraceLocalRootPeers extraFlags ntnAddr)
dtTraceLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers extraFlags ntnAddr)
dtTraceLocalRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (TraceLocalRootPeers extraFlags ntnAddr)
dtTraceLocalRootPeersTracer
       , Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
       , Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer :: Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer
       , Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer :: Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer
     m
     (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer
       , Tracer m (AbstractTransitionTrace ConnStateId)
dtConnectionManagerTransitionTracer :: Tracer m (AbstractTransitionTrace ConnStateId)
dtConnectionManagerTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (AbstractTransitionTrace ConnStateId)
dtConnectionManagerTransitionTracer
       , Tracer m (Trace ntnAddr)
dtServerTracer :: Tracer m (Trace ntnAddr)
dtServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (Trace ntnAddr)
dtServerTracer
       , Tracer m (Trace ntnAddr)
dtInboundGovernorTracer :: Tracer m (Trace ntnAddr)
dtInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (Trace ntnAddr)
dtInboundGovernorTracer
       , Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer
       , Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer :: Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer
     m
     (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer
       , Tracer m (Trace ntcAddr)
dtLocalServerTracer :: Tracer m (Trace ntcAddr)
dtLocalServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (Trace ntcAddr)
dtLocalServerTracer
       , Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer :: Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer
       , Tracer m DNSTrace
dtDnsTracer :: Tracer m DNSTrace
dtDnsTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m DNSTrace
dtDnsTracer
       }
     Arguments
       { ntnVersionData -> DataFlow
daNtnDataFlow :: ntnVersionData -> DataFlow
daNtnDataFlow :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> ntnVersionData -> DataFlow
daNtnDataFlow
       , ntnVersionData -> PeerSharing
daNtnPeerSharing :: ntnVersionData -> PeerSharing
daNtnPeerSharing :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> ntnVersionData -> PeerSharing
daNtnPeerSharing
       , ntnVersionData -> DiffusionMode -> ntnVersionData
daUpdateVersionData :: ntnVersionData -> DiffusionMode -> ntnVersionData
daUpdateVersionData :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> ntnVersionData -> DiffusionMode -> ntnVersionData
daUpdateVersionData
       , HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
daNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
daNtnHandshakeArguments :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
daNtnHandshakeArguments
       , HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
daNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
daNtcHandshakeArguments :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
daNtcHandshakeArguments
       , LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx :: LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx
       , extraState
daEmptyExtraState :: extraState
daEmptyExtraState :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> extraState
daEmptyExtraState
       , extraCounters
daEmptyExtraCounters :: extraCounters
daEmptyExtraCounters :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> extraCounters
daEmptyExtraCounters
       , PublicExtraPeersAPI extraPeers ntnAddr
daExtraPeersAPI :: PublicExtraPeersAPI extraPeers ntnAddr
daExtraPeersAPI :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> PublicExtraPeersAPI extraPeers ntnAddr
daExtraPeersAPI
       , forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        ntnAddr
        (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
-> m ()
daInstallSigUSR1Handler :: forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        ntnAddr
        (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
-> m ()
daInstallSigUSR1Handler :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> forall (mode :: Mode) x y.
   NodeToNodeConnectionManager
     mode ntnFd ntnAddr ntnVersionData ntnVersion m x y
   -> StrictTVar
        m
        (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           ntnAddr
           (NodeToNodePeerConnectionHandle mode ntnAddr ntnVersionData m x y))
   -> m ()
daInstallSigUSR1Handler
       , forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  exception
  m
daPeerSelectionGovernorArgs :: forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  exception
  m
daPeerSelectionGovernorArgs :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> forall (muxMode :: Mode) responderCtx bytes a b.
   PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     extraTrace
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
     exception
     m
daPeerSelectionGovernorArgs
       , forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
-> extraCounters
daPeerSelectionStateToExtraCounters :: forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
-> extraCounters
daPeerSelectionStateToExtraCounters :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> forall (muxMode :: Mode) responderCtx bytes a b.
   PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
   -> extraCounters
daPeerSelectionStateToExtraCounters
       , Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers :: Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers
       , Maybe
  (PeerActionsDNS ntnAddr resolver m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> extraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers extraPeers ntnAddr, DiffTime))
daRequestPublicRootPeers :: Maybe
  (PeerActionsDNS ntnAddr resolver m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> extraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers extraPeers ntnAddr, DiffTime))
daRequestPublicRootPeers :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> Maybe
     (PeerActionsDNS ntnAddr resolver m
      -> DNSSemaphore m
      -> (Map ntnAddr PeerAdvertise -> extraPeers)
      -> (NumberOfPeers
          -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
      -> LedgerPeersKind
      -> StdGen
      -> Int
      -> m (PublicRootPeers extraPeers ntnAddr, DiffTime))
daRequestPublicRootPeers
       , PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
-> m Void
daPeerChurnGovernor :: PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
-> m Void
daPeerChurnGovernor :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> PeerChurnArgs
     m
     extraChurnArgs
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     extraTrace
     ntnAddr
-> m Void
daPeerChurnGovernor
       , extraChurnArgs
daExtraChurnArgs :: extraChurnArgs
daExtraChurnArgs :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> extraChurnArgs
daExtraChurnArgs
       , SRVPrefix
daSRVPrefix :: SRVPrefix
daSRVPrefix :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters extraTrace exception resolver
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  resolver
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> SRVPrefix
daSRVPrefix
       }
     Configuration
       { Maybe (Either ntnFd ntnAddr)
dcIPv4Address :: Maybe (Either ntnFd ntnAddr)
dcIPv4Address :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
dcIPv4Address
       , Maybe (Either ntnFd ntnAddr)
dcIPv6Address :: Maybe (Either ntnFd ntnAddr)
dcIPv6Address :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
dcIPv6Address
       , Maybe (Either ntcFd ntcAddr)
dcLocalAddress :: Maybe (Either ntcFd ntcAddr)
dcLocalAddress :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntcFd ntcAddr)
dcLocalAddress
       , AcceptedConnectionsLimit
dcAcceptedConnectionsLimit :: AcceptedConnectionsLimit
dcAcceptedConnectionsLimit :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> AcceptedConnectionsLimit
dcAcceptedConnectionsLimit
       , dcMode :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> DiffusionMode
dcMode = DiffusionMode
diffusionMode
       , StrictTVar m (PublicPeerSelectionState ntnAddr)
dcPublicPeerSelectionVar :: StrictTVar m (PublicPeerSelectionState ntnAddr)
dcPublicPeerSelectionVar :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> StrictTVar m (PublicPeerSelectionState ntnAddr)
dcPublicPeerSelectionVar
       , PeerSelectionTargets
dcPeerSelectionTargets :: PeerSelectionTargets
dcPeerSelectionTargets :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> PeerSelectionTargets
dcPeerSelectionTargets
       , STM m (Config extraFlags RelayAccessPoint)
dcReadLocalRootPeers :: STM m (Config extraFlags RelayAccessPoint)
dcReadLocalRootPeers :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> STM m (Config extraFlags RelayAccessPoint)
dcReadLocalRootPeers
       , STM m (Map RelayAccessPoint PeerAdvertise)
dcReadPublicRootPeers :: STM m (Map RelayAccessPoint PeerAdvertise)
dcReadPublicRootPeers :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> STM m (Map RelayAccessPoint PeerAdvertise)
dcReadPublicRootPeers
       , PeerSharing
dcPeerSharing :: PeerSharing
dcPeerSharing :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> PeerSharing
dcPeerSharing
       , STM m UseLedgerPeers
dcReadUseLedgerPeers :: STM m UseLedgerPeers
dcReadUseLedgerPeers :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> STM m UseLedgerPeers
dcReadUseLedgerPeers
       , DiffTime
dcProtocolIdleTimeout :: DiffTime
dcProtocolIdleTimeout :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr -> DiffTime
dcProtocolIdleTimeout
       , DiffTime
dcTimeWaitTimeout :: DiffTime
dcTimeWaitTimeout :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr -> DiffTime
dcTimeWaitTimeout
       , DiffTime
dcDeadlineChurnInterval :: DiffTime
dcDeadlineChurnInterval :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr -> DiffTime
dcDeadlineChurnInterval
       , DiffTime
dcBulkChurnInterval :: DiffTime
dcBulkChurnInterval :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr -> DiffTime
dcBulkChurnInterval
       , STM m (Maybe LedgerPeerSnapshot)
dcReadLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
dcReadLedgerPeerSnapshot :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> STM m (Maybe LedgerPeerSnapshot)
dcReadLedgerPeerSnapshot
       , ForkPolicy ntnAddr
dcMuxForkPolicy :: ForkPolicy ntnAddr
dcMuxForkPolicy :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> ForkPolicy ntnAddr
dcMuxForkPolicy
       , ForkPolicy ntcAddr
dcLocalMuxForkPolicy :: ForkPolicy ntcAddr
dcLocalMuxForkPolicy :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> ForkPolicy ntcAddr
dcLocalMuxForkPolicy
       }
     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
       , RethrowPolicy
daRethrowPolicy :: RethrowPolicy
daRethrowPolicy :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> RethrowPolicy
daRethrowPolicy
       , RethrowPolicy
daLocalRethrowPolicy :: RethrowPolicy
daLocalRethrowPolicy :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> RethrowPolicy
daLocalRethrowPolicy
       , ReturnPolicy a
daReturnPolicy :: ReturnPolicy a
daReturnPolicy :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> ReturnPolicy a
daReturnPolicy
       , RepromoteDelay
daRepromoteErrorDelay :: RepromoteDelay
daRepromoteErrorDelay :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> RepromoteDelay
daRepromoteErrorDelay
       , PeerSelectionPolicy ntnAddr m
daPeerSelectionPolicy :: PeerSelectionPolicy ntnAddr m
daPeerSelectionPolicy :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> PeerSelectionPolicy ntnAddr m
daPeerSelectionPolicy
       , PeerSharingRegistry ntnAddr m
daPeerSharingRegistry :: PeerSharingRegistry ntnAddr m
daPeerSharingRegistry :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
  a
-> 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

    -- If we have a local address, race the remote and local threads. Otherwise
    -- just launch the remote thread.
    mkRemoteThread mainThreadId &
      (case dcLocalAddress of
         Maybe (Either ntcFd ntcAddr)
Nothing -> m Void -> m Void
forall a. a -> a
id
         Just Either ntcFd ntcAddr
addr -> (Either Void Void -> Void) -> m (Either Void Void) -> m Void
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Void -> Void) -> (Void -> Void) -> Either Void Void -> Void
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> Void
forall a. a -> a
id Void -> Void
forall a. a -> a
id) (m (Either Void Void) -> m Void)
-> (m Void -> m (Either Void Void)) -> m Void -> m Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m Void -> m Void -> m (Either Void Void)
forall a b. m a -> m b -> m (Either a b)
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> m b -> m (Either a b)
`Async.race` ThreadId m -> Either ntcFd ntcAddr -> m Void
mkLocalThread ThreadId m
mainThreadId Either ntcFd ntcAddr
addr)
      )

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

    mkInboundPeersMap :: IG.PublicState ntnAddr ntnVersionData
                      -> Map ntnAddr PeerSharing
    mkInboundPeersMap :: PublicState ntnAddr ntnVersionData -> Map ntnAddr PeerSharing
mkInboundPeersMap
      IG.PublicState { Map ntnAddr ntnVersionData
inboundDuplexPeers :: Map ntnAddr ntnVersionData
inboundDuplexPeers :: forall peerAddr versionData.
PublicState peerAddr versionData -> Map peerAddr versionData
IG.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
daNtnPeerSharing 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
<>
      -- IOError rethrow-policy
      --
      -- After a critical bug, we decided that `IOError` policy should only
      -- kill the connection which thrown it.  `IOError`s are not propagated.
      -- There's a risk that one could arm an attack if one discovers
      -- a mechanism to trigger fatal `IOError`s, e.g. through a kernel bug.
      --
      -- It is responsibility for an SPO to monitor the node if it is making
      -- progress and have enough resources to do so, e.g. if it has enough
      -- memory, file descriptors.
      --
      -- The `ouroboros-network` guarantees running on a fixed number of file
      -- descriptors given a topology file, see
      -- https://github.com/IntersectMBO/ouroboros-network/issues/4585#issuecomment-1591777447
      -- There's also a calculation for `ouroboros-consensus`, see
      -- https://github.com/IntersectMBO/ouroboros-consensus/issues/20#issuecomment-1514554680
      -- File descriptors could be drained by the tracing system in
      -- `cardano-node` (such a bug existed), or even an external process.
      --
      (ErrorContext -> SomeException -> ErrorCommand) -> RethrowPolicy
RethrowPolicy (\ErrorContext
_ctx SomeException
err ->
        case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err :: Maybe IOException of
          Just {} -> 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
                        (ErrorContext
OutboundError, Just Mx.UnknownMiniProtocol {})
                          -> ErrorCommand
ShutdownPeer
                        (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 = do
     String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"local connection manager"
     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
     (Event
        'ResponderMode
        (NodeToClientHandle ntcAddr ntcVersionData m)
        (MinimalInitiatorContext ntcAddr)
        ntcAddr
        ntcVersionData
        m
        Void
        ())
     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

            mkLocalConnectionHandler :: MkNodeToClientConnectionHandler
                                          ntcFd ntcAddr ntcVersion ntcVersionData m
            mkLocalConnectionHandler StrictTVar m (StrictMaybe ResponderCounters)
-> Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
responderMuxChannelTracer =
              TracersWithBearer (ConnectionId ntcAddr) m
-> ForkPolicy ntcAddr
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosBundle
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ())
-> (ThreadId m, RethrowPolicy)
-> MkMuxConnectionHandler
     'ResponderMode
     ntcFd
     (MinimalInitiatorContext ntcAddr)
     (ResponderContext ntcAddr)
     ntcAddr
     ntcVersion
     ntcVersionData
     ByteString
     m
     Void
     ()
-> MuxConnectionHandler
     'ResponderMode
     ntcFd
     (MinimalInitiatorContext ntcAddr)
     (ResponderContext ntcAddr)
     ntcAddr
     ntcVersion
     ntcVersionData
     ByteString
     m
     Void
     ()
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) =>
TracersWithBearer (ConnectionId peerAddr) m
-> ForkPolicy peerAddr
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MkMuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
makeConnectionHandler
                Mx.Tracers {
                  tracer :: Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
Mx.tracer        = Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer,
                  channelTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) ChannelTrace)
Mx.channelTracer = Tracer m (WithBearer (ConnectionId ntcAddr) ChannelTrace)
dtLocalChannelTracer,
                  bearerTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) BearerTrace)
Mx.bearerTracer  = Tracer m (WithBearer (ConnectionId ntcAddr) BearerTrace)
dtLocalBearerTracer
                }
                ForkPolicy ntcAddr
dcLocalMuxForkPolicy
                HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
daNtcHandshakeArguments
                ( ( \ (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)
                ((StrictTVar m (StrictMaybe ResponderCounters)
 -> Tracer m (WithBearer (ConnectionId ntcAddr) Trace))
-> MkMuxConnectionHandler
     'ResponderMode
     ntcFd
     (MinimalInitiatorContext ntcAddr)
     (ResponderContext ntcAddr)
     ntcAddr
     ntcVersion
     ntcVersionData
     ByteString
     m
     Void
     ()
forall (m :: * -> *) peerAddr socket initiatorCtx responderCtx
       versionNumber versionData bytes a b.
(StrictTVar m (StrictMaybe ResponderCounters)
 -> Tracer m (WithBearer (ConnectionId peerAddr) Trace))
-> MkMuxConnectionHandler
     'ResponderMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     bytes
     m
     a
     b
MuxResponderConnectionHandler StrictTVar m (StrictMaybe ResponderCounters)
-> Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
responderMuxChannelTracer)

            localWithConnectionManager
              :: InformationChannel
                   (IG.Event 'ResponderMode handle initiatorCtx ntcAddr versionData m c b) m
              -> ConnectionHandler 'ResponderMode (ConnectionHandlerTrace ntcVersion ntcVersionData)
                                   ntcFd ntcAddr handle (HandlerError versionNumber) version
                                   versionData m
              -> (   ConnectionManager 'ResponderMode ntcFd ntcAddr handle
                                       (HandlerError versionNumber) m
                  -> m x)
              -> m x
            localWithConnectionManager InformationChannel
  (Event
     'ResponderMode handle initiatorCtx ntcAddr versionData m c b)
  m
responderInfoChannel ConnectionHandler
  'ResponderMode
  (ConnectionHandlerTrace ntcVersion ntcVersionData)
  ntcFd
  ntcAddr
  handle
  (HandlerError versionNumber)
  version
  versionData
  m
connectionHandler ConnectionManager
  'ResponderMode ntcFd ntcAddr handle (HandlerError versionNumber) m
-> m x
k =
              Arguments
  (ConnectionHandlerTrace ntcVersion ntcVersionData)
  ntcFd
  ntcAddr
  handle
  (HandlerError versionNumber)
  version
  versionData
  m
  c
  b
-> InResponderMode
     'ResponderMode
     (InformationChannel
        (Event
           'ResponderMode handle initiatorCtx ntcAddr versionData m c b)
        m)
-> ConnectionHandler
     'ResponderMode
     (ConnectionHandlerTrace ntcVersion ntcVersionData)
     ntcFd
     ntcAddr
     handle
     (HandlerError versionNumber)
     version
     versionData
     m
-> (ConnectionManager
      'ResponderMode ntcFd ntcAddr handle (HandlerError versionNumber) m
    -> m x)
-> m x
forall (muxMode :: Mode) peerAddr socket initiatorCtx handlerTrace
       handle handleError version versionData (m :: * -> *) a b x.
(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
  a
  b
-> InResponderMode
     muxMode
     (InformationChannel
        (Event muxMode handle initiatorCtx peerAddr versionData m a b) m)
-> ConnectionHandler
     muxMode
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     version
     versionData
     m
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m x)
-> m x
CM.with CM.Arguments {
                  tracer :: Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
CM.tracer              = Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer,
                  trTracer :: Tracer
  m
  (TransitionTrace
     ConnStateId
     (ConnectionState
        ntcAddr handle (HandlerError versionNumber) version m))
CM.trTracer            = Tracer
  m
  (TransitionTrace
     ConnStateId
     (ConnectionState
        ntcAddr handle (HandlerError versionNumber) version m))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer, -- TODO: issue #3320
                  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,
                  withBuffer :: (Maybe (ReadBuffer m) -> m ()) -> m ()
CM.withBuffer          = (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer,
                  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 :: versionData -> DataFlow
CM.connectionDataFlow  = versionData -> 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,
                  updateVersionData :: versionData -> DiffusionMode -> versionData
CM.updateVersionData   = \versionData
a DiffusionMode
_ -> versionData
a,
                  connStateIdSupply :: ConnStateIdSupply m
CM.connStateIdSupply   = ConnStateIdSupply m
diConnStateIdSupply,
                  HandlerError versionNumber -> HandlerErrorType
forall versionNumber.
HandlerError versionNumber -> HandlerErrorType
classifyHandlerError :: forall versionNumber.
HandlerError versionNumber -> HandlerErrorType
classifyHandlerError :: HandlerError versionNumber -> HandlerErrorType
CM.classifyHandlerError
              }
              (InformationChannel
  (Event
     'ResponderMode handle initiatorCtx ntcAddr versionData m c b)
  m
-> InResponderMode
     'ResponderMode
     (InformationChannel
        (Event
           'ResponderMode handle initiatorCtx ntcAddr versionData m c b)
        m)
forall (mode :: Mode) a.
(HasResponder mode ~ 'True) =>
a -> InResponderMode mode a
InResponderMode InformationChannel
  (Event
     'ResponderMode handle initiatorCtx ntcAddr versionData m c b)
  m
responderInfoChannel)
              ConnectionHandler
  'ResponderMode
  (ConnectionHandlerTrace ntcVersion ntcVersionData)
  ntcFd
  ntcAddr
  handle
  (HandlerError versionNumber)
  version
  versionData
  m
connectionHandler
              ConnectionManager
  'ResponderMode ntcFd ntcAddr handle (HandlerError versionNumber) m
-> m x
k

        traceWith tracer . RunLocalServer =<< Snocket.getLocalAddr diNtcSnocket localSocket
        Server.with
          Server.Arguments {
              Server.sockets          = localSocket :| [],
              Server.snocket          = diNtcSnocket,
              Server.tracer           = dtLocalServerTracer,
              Server.connectionLimits = localConnectionLimits,
              Server.inboundGovernorArgs =
                IG.Arguments {
                  IG.tracer                = dtLocalInboundGovernorTracer,
                  IG.transitionTracer      = nullTracer,
                  IG.debugTracer           = nullTracer,
                  IG.connectionDataFlow    = ntcDataFlow,
                  IG.idleTimeout           = Nothing,
                  IG.withConnectionManager = localWithConnectionManager localInbInfoChannel,
                  IG.mkConnectionHandler   = mkLocalConnectionHandler,
                  IG.infoChannel           = localInbInfoChannel
                }
              }
          (\Async m Void
inboundGovernorThread m (PublicState ntcAddr ntcVersionData)
_ ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr ntcVersionData m)
  (HandlerError ntcVersion)
  m
_ -> 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
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"remote connection manager"
      let
        exitPolicy :: ExitPolicy a
        exitPolicy :: ExitPolicy a
exitPolicy = ExitPolicy {
          epReturnDelay :: ReturnPolicy a
epReturnDelay = ReturnPolicy a
daReturnPolicy,
          epErrorDelay :: RepromoteDelay
epErrorDelay  = RepromoteDelay
daRepromoteErrorDelay
        }

      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)
dcIPv4Address
      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)
                    dcIPv6Address
      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
RootPeersDNS.LookupReqAOnly
                           (Maybe ntnAddr
Nothing, Just ntnAddr
_ ) -> DNSLookupType -> m DNSLookupType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DNSLookupType
RootPeersDNS.LookupReqAAAAOnly
                           (Just ntnAddr
_ , Just ntnAddr
_ ) -> DNSLookupType -> m DNSLookupType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DNSLookupType
RootPeersDNS.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

      localRootsVar <- newTVarIO mempty

      -- churn will set initial targets
      peerSelectionTargetsVar <- newTVarIO PeerSelection.nullPeerSelectionTargets

      countersVar <- newTVarIO (PeerSelection.emptyPeerSelectionCounters daEmptyExtraCounters)

      -- 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 b.
               PrunePolicy ntnAddr
            -> StdGen
            -> CM.Arguments
                 (ConnectionHandlerTrace ntnVersion ntnVersionData)
                 ntnFd ntnAddr handle (HandlerError ntnVersion) ntnVersion ntnVersionData m a b
          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
     ConnStateId
     (ConnectionState
        ntnAddr handle (HandlerError ntnVersion) ntnVersion m))
CM.trTracer            =
                (MaybeUnknown
   (ConnectionState
      ntnAddr handle (HandlerError ntnVersion) ntnVersion m)
 -> AbstractState)
-> TransitionTrace
     ConnStateId
     (ConnectionState
        ntnAddr handle (HandlerError ntnVersion) ntnVersion m)
-> AbstractTransitionTrace ConnStateId
forall a b.
(a -> b)
-> TransitionTrace' ConnStateId a -> TransitionTrace' ConnStateId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeUnknown
  (ConnectionState
     ntnAddr handle (HandlerError ntnVersion) ntnVersion m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
CM.abstractState
                (TransitionTrace
   ConnStateId
   (ConnectionState
      ntnAddr handle (HandlerError ntnVersion) ntnVersion m)
 -> AbstractTransitionTrace ConnStateId)
-> Tracer m (AbstractTransitionTrace ConnStateId)
-> Tracer
     m
     (TransitionTrace
        ConnStateId
        (ConnectionState
           ntnAddr handle (HandlerError ntnVersion) 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 ConnStateId)
dtConnectionManagerTransitionTracer,
              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,
              withBuffer :: (Maybe (ReadBuffer m) -> m ()) -> m ()
CM.withBuffer          = (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer,
              configureSocket :: ntnFd -> Maybe ntnAddr -> m ()
CM.configureSocket     = ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket,
              connectionDataFlow :: ntnVersionData -> DataFlow
CM.connectionDataFlow  = ntnVersionData -> DataFlow
daNtnDataFlow,
              prunePolicy :: PrunePolicy ntnAddr
CM.prunePolicy         = PrunePolicy ntnAddr
prunePolicy,
              StdGen
stdGen :: StdGen
stdGen :: StdGen
CM.stdGen,
              connectionsLimits :: AcceptedConnectionsLimit
CM.connectionsLimits   = AcceptedConnectionsLimit
dcAcceptedConnectionsLimit,
              timeWaitTimeout :: DiffTime
CM.timeWaitTimeout     = DiffTime
dcTimeWaitTimeout,
              outboundIdleTimeout :: DiffTime
CM.outboundIdleTimeout = DiffTime
dcProtocolIdleTimeout,
              updateVersionData :: ntnVersionData -> DiffusionMode -> ntnVersionData
CM.updateVersionData   = ntnVersionData -> DiffusionMode -> ntnVersionData
daUpdateVersionData,
              connStateIdSupply :: ConnStateIdSupply m
CM.connStateIdSupply   = ConnStateIdSupply m
diConnStateIdSupply,
              HandlerError ntnVersion -> HandlerErrorType
forall versionNumber.
HandlerError versionNumber -> HandlerErrorType
classifyHandlerError :: forall versionNumber.
HandlerError versionNumber -> HandlerErrorType
classifyHandlerError :: HandlerError ntnVersion -> HandlerErrorType
CM.classifyHandlerError
            }

      let makeConnectionHandler'
            :: forall muxMode initiatorCtx responderCtx b c.
               Versions ntnVersion ntnVersionData
                 (OuroborosBundle muxMode initiatorCtx responderCtx ByteString m b c)
            -> MkMuxConnectionHandler
                 muxMode ntnFd initiatorCtx responderCtx ntnAddr
                 ntnVersion ntnVersionData ByteString m b c
            -> MuxConnectionHandler muxMode ntnFd initiatorCtx responderCtx ntnAddr
                                    ntnVersion ntnVersionData ByteString m b c
          makeConnectionHandler' Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     muxMode initiatorCtx responderCtx ByteString m b c)
versions =
            TracersWithBearer (ConnectionId ntnAddr) m
-> ForkPolicy ntnAddr
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m b c)
-> (ThreadId m, RethrowPolicy)
-> MkMuxConnectionHandler
     muxMode
     ntnFd
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
-> MuxConnectionHandler
     muxMode
     ntnFd
     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) =>
TracersWithBearer (ConnectionId peerAddr) m
-> ForkPolicy peerAddr
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MkMuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
makeConnectionHandler
              Mx.Tracers {
                tracer :: Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
Mx.tracer        = Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer,
                channelTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) ChannelTrace)
Mx.channelTracer = Tracer m (WithBearer (ConnectionId ntnAddr) ChannelTrace)
dtChannelTracer,
                bearerTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
Mx.bearerTracer  = Tracer m (WithBearer (ConnectionId ntnAddr) BearerTrace)
dtBearerTracer
              }
              ForkPolicy ntnAddr
dcMuxForkPolicy
              HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
daNtnHandshakeArguments
              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 ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     Void)
  (HandlerError ntnVersion)
  m
-> m Void
k =
            Arguments
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     Void)
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  m
  a
  (ZonkAny 2)
-> InResponderMode
     'InitiatorMode
     (InformationChannel
        (Event
           'InitiatorMode
           (Handle
              'InitiatorMode
              (ExpandedInitiatorContext ntnAddr m)
              (ResponderContext ntnAddr)
              ntnVersionData
              ByteString
              m
              a
              Void)
           (ZonkAny 3)
           ntnAddr
           ntnVersionData
           m
           a
           (ZonkAny 2))
        m)
-> ConnectionHandler
     'InitiatorMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        Void)
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         Void)
      (HandlerError ntnVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: Mode) peerAddr socket initiatorCtx handlerTrace
       handle handleError version versionData (m :: * -> *) a b x.
(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
  a
  b
-> InResponderMode
     muxMode
     (InformationChannel
        (Event muxMode handle initiatorCtx peerAddr versionData m a b) m)
-> ConnectionHandler
     muxMode
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     version
     versionData
     m
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m x)
-> m x
CM.with
              (PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        Void)
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
     a
     (ZonkAny 2)
forall handle b.
PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     handle
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
     a
     b
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'.
              InResponderMode
  'InitiatorMode
  (InformationChannel
     (Event
        'InitiatorMode
        (Handle
           'InitiatorMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           Void)
        (ZonkAny 3)
        ntnAddr
        ntnVersionData
        m
        a
        (ZonkAny 2))
     m)
forall (mode :: Mode) a. InResponderMode mode a
NotInResponderMode
              (Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
-> MkMuxConnectionHandler
     'InitiatorMode
     ntnFd
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     a
     Void
-> ConnectionHandler
     'InitiatorMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        Void)
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
forall (muxMode :: Mode) initiatorCtx responderCtx b c.
Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     muxMode initiatorCtx responderCtx ByteString m b c)
-> MkMuxConnectionHandler
     muxMode
     ntnFd
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
-> MuxConnectionHandler
     muxMode
     ntnFd
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
makeConnectionHandler' Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
daApplicationInitiatorMode
                                      MkMuxConnectionHandler
  'InitiatorMode
  ntnFd
  (ExpandedInitiatorContext ntnAddr m)
  (ResponderContext ntnAddr)
  ntnAddr
  ntnVersion
  ntnVersionData
  ByteString
  m
  a
  Void
forall socket initiatorCtx responderCtx peerAddr versionNumber
       versionData bytes (m :: * -> *) a b.
MkMuxConnectionHandler
  'InitiatorMode
  socket
  initiatorCtx
  responderCtx
  peerAddr
  versionNumber
  versionData
  bytes
  m
  a
  b
MuxInitiatorConnectionHandler)
              ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     Void)
  (HandlerError ntnVersion)
  m
-> m Void
k

          withConnectionManagerInitiatorAndResponderMode
            InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
responderInfoChannel ConnectionHandler
  'InitiatorResponderMode
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  m
connectionHandler ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  m
-> m Void
k =
              Arguments
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  m
  a
  ()
-> InResponderMode
     'InitiatorResponderMode
     (InformationChannel
        (Event
           'InitiatorResponderMode
           (Handle
              'InitiatorResponderMode
              (ExpandedInitiatorContext ntnAddr m)
              (ResponderContext ntnAddr)
              ntnVersionData
              ByteString
              m
              a
              ())
           (ExpandedInitiatorContext ntnAddr m)
           ntnAddr
           ntnVersionData
           m
           a
           ())
        m)
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
-> (ConnectionManager
      'InitiatorResponderMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorResponderMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         ())
      (HandlerError ntnVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: Mode) peerAddr socket initiatorCtx handlerTrace
       handle handleError version versionData (m :: * -> *) a b x.
(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
  a
  b
-> InResponderMode
     muxMode
     (InformationChannel
        (Event muxMode handle initiatorCtx peerAddr versionData m a b) m)
-> ConnectionHandler
     muxMode
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     version
     versionData
     m
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m x)
-> m x
CM.with
                  (PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
     a
     ()
forall handle b.
PrunePolicy ntnAddr
-> StdGen
-> Arguments
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     handle
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
     a
     b
connectionManagerArguments' PrunePolicy ntnAddr
forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
Diffusion.Policies.prunePolicy
                                               StdGen
cmStdGen2)
                  (InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
-> InResponderMode
     'InitiatorResponderMode
     (InformationChannel
        (Event
           'InitiatorResponderMode
           (Handle
              'InitiatorResponderMode
              (ExpandedInitiatorContext ntnAddr m)
              (ResponderContext ntnAddr)
              ntnVersionData
              ByteString
              m
              a
              ())
           (ExpandedInitiatorContext ntnAddr m)
           ntnAddr
           ntnVersionData
           m
           a
           ())
        m)
forall (mode :: Mode) a.
(HasResponder mode ~ 'True) =>
a -> InResponderMode mode a
InResponderMode InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
responderInfoChannel)
                  ConnectionHandler
  'InitiatorResponderMode
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  m
connectionHandler
                  ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  m
-> m Void
k

      --
      -- 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
            -> (PeerSelection.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 <- RootPeersDNS.newLedgerAndPublicRootDNSSemaphore
      let dnsActions =
            PeerActionsDNS {
              paToPeerAddr :: IP -> PortNumber -> ntnAddr
paToPeerAddr = IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
            , paDnsActions :: DNSActions ntnAddr resolver m
paDnsActions = Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver m
diDnsActions Tracer m DNSTrace
dtDnsTracer DNSLookupType
lookupReqs IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
            }
      --
      -- Run peer selection (p2p governor)
      --
      let
          withPeerSelectionActions'
            :: m (Map ntnAddr PeerSharing)
            -> PeerStateActions
                 ntnAddr
                 (PeerConnectionHandle
                    muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
                 m
            -> ((Async m Void, Async m Void)
                -> PeerSelectionActions
                     extraState
                     extraFlags
                     extraPeers
                     extraAPI
                     extraCounters
                     ntnAddr
                     (PeerConnectionHandle
                        muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
                     m
                -> m c)
            -> m c
          withPeerSelectionActions' m (Map ntnAddr PeerSharing)
readInboundPeers PeerStateActions
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  m
peerStateActions =
              Tracer m (TraceLocalRootPeers extraFlags ntnAddr)
-> StrictTVar
     m
     [(HotValency, WarmValency,
       Map ntnAddr (LocalRootConfig extraFlags))]
-> PeerActionsDNS ntnAddr resolver m
-> ((NumberOfPeers
     -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
         m)
-> WithLedgerPeersArgs extraAPI m
-> StdGen
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
         m
    -> m c)
-> m c
forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn resolver (m :: * -> *) a.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadThrow m,
 Ord peeraddr, Eq extraFlags) =>
Tracer m (TraceLocalRootPeers extraFlags peeraddr)
-> StrictTVar m (Config extraFlags peeraddr)
-> PeerActionsDNS peeraddr resolver m
-> ((NumberOfPeers
     -> LedgerPeersKind -> m (Maybe (Set peeraddr, DiffTime)))
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         peeraddr
         peerconn
         m)
-> WithLedgerPeersArgs extraAPI m
-> StdGen
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         peeraddr
         peerconn
         m
    -> m a)
-> m a
withPeerSelectionActions Tracer m (TraceLocalRootPeers extraFlags ntnAddr)
dtTraceLocalRootPeersTracer
                                       StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
localRootsVar
                                       PeerActionsDNS ntnAddr resolver m
dnsActions
                                       (\NumberOfPeers
-> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime))
getLedgerPeers -> PeerSelectionActions {
                                         peerSelectionTargets :: PeerSelectionTargets
peerSelectionTargets       = PeerSelectionTargets
dcPeerSelectionTargets,
                                         readPeerSelectionTargets :: STM m PeerSelectionTargets
readPeerSelectionTargets   = StrictTVar m PeerSelectionTargets -> STM m PeerSelectionTargets
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar,
                                         getLedgerStateCtx :: LedgerPeersConsensusInterface extraAPI m
getLedgerStateCtx          = LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx,
                                         readLocalRootPeersFromFile :: STM m (Config extraFlags RelayAccessPoint)
readLocalRootPeersFromFile = STM m (Config extraFlags RelayAccessPoint)
dcReadLocalRootPeers,
                                         readLocalRootPeers :: STM
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
readLocalRootPeers         = StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
-> STM
     m
     [(HotValency, WarmValency,
       Map ntnAddr (LocalRootConfig extraFlags))]
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
localRootsVar,
                                         peerSharing :: PeerSharing
peerSharing                = PeerSharing
dcPeerSharing,
                                         peerConnToPeerSharing :: PeerConnectionHandle
  muxMode responderCtx ntnAddr ntnVersionData bytes m a b
-> PeerSharing
peerConnToPeerSharing      = (ntnVersionData -> PeerSharing)
-> PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a 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
daNtnPeerSharing,
                                         requestPeerShare :: PeerSharingAmount -> ntnAddr -> m (PeerSharingResult ntnAddr)
requestPeerShare           =
                                           STM m (Map ntnAddr (PeerSharingController ntnAddr m))
-> PeerSharingAmount -> ntnAddr -> m (PeerSharingResult ntnAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, MonadMVar m, Ord peeraddr) =>
STM m (Map peeraddr (PeerSharingController peeraddr m))
-> PeerSharingAmount -> peeraddr -> m (PeerSharingResult peeraddr)
requestPeerSharingResult (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)),
                                         requestPublicRootPeers :: LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers ntnAddr, DiffTime)
requestPublicRootPeers     =
                                           case Maybe
  (PeerActionsDNS ntnAddr resolver m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> extraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers extraPeers ntnAddr, DiffTime))
daRequestPublicRootPeers of
                                             Maybe
  (PeerActionsDNS ntnAddr resolver m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> extraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers extraPeers ntnAddr, DiffTime))
Nothing ->
                                               Tracer m TracePublicRootPeers
-> STM m (Map RelayAccessPoint PeerAdvertise)
-> PeerActionsDNS ntnAddr resolver m
-> DNSSemaphore m
-> (Map ntnAddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
-> LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers ntnAddr, DiffTime)
forall (m :: * -> *) peeraddr extraPeers resolver.
(MonadThrow m, MonadAsync m, Monoid extraPeers, Ord peeraddr) =>
Tracer m TracePublicRootPeers
-> STM m (Map RelayAccessPoint PeerAdvertise)
-> PeerActionsDNS peeraddr resolver m
-> DNSSemaphore m
-> (Map peeraddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set peeraddr, DiffTime)))
-> LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
PeerSelection.requestPublicRootPeersImpl
                                                 Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
                                                 STM m (Map RelayAccessPoint PeerAdvertise)
dcReadPublicRootPeers
                                                 PeerActionsDNS ntnAddr resolver m
dnsActions
                                                 DNSSemaphore m
dnsSemaphore
                                                 Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers
                                                 NumberOfPeers
-> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime))
getLedgerPeers
                                             Just PeerActionsDNS ntnAddr resolver m
-> DNSSemaphore m
-> (Map ntnAddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
-> LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers ntnAddr, DiffTime)
requestPublicRootPeers' ->
                                               PeerActionsDNS ntnAddr resolver m
-> DNSSemaphore m
-> (Map ntnAddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
-> LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers ntnAddr, DiffTime)
requestPublicRootPeers' PeerActionsDNS ntnAddr resolver m
dnsActions DNSSemaphore m
dnsSemaphore Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers NumberOfPeers
-> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime))
getLedgerPeers,
                                         readInboundPeers :: m (Map ntnAddr PeerSharing)
readInboundPeers =
                                           case PeerSharing
dcPeerSharing 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,
                                         readLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
readLedgerPeerSnapshot = STM m (Maybe LedgerPeerSnapshot)
dcReadLedgerPeerSnapshot,
                                         extraPeersAPI :: PublicExtraPeersAPI extraPeers ntnAddr
extraPeersAPI             = PublicExtraPeersAPI extraPeers ntnAddr
daExtraPeersAPI,
                                         extraStateToExtraCounters :: PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
-> extraCounters
extraStateToExtraCounters = PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
-> extraCounters
forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
-> extraCounters
daPeerSelectionStateToExtraCounters,
                                         PeerStateActions
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  m
peerStateActions :: PeerStateActions
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  m
peerStateActions :: PeerStateActions
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  m
peerStateActions
                                       })
                                       WithLedgerPeersArgs {
                                         wlpRng :: StdGen
wlpRng                   = StdGen
ledgerPeersRng,
                                         wlpConsensusInterface :: LedgerPeersConsensusInterface extraAPI m
wlpConsensusInterface    = LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx,
                                         wlpTracer :: Tracer m TraceLedgerPeers
wlpTracer                = Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer,
                                         wlpGetUseLedgerPeers :: STM m UseLedgerPeers
wlpGetUseLedgerPeers     = STM m UseLedgerPeers
dcReadUseLedgerPeers,
                                         wlpGetLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
wlpGetLedgerPeerSnapshot = STM m (Maybe LedgerPeerSnapshot)
dcReadLedgerPeerSnapshot,
                                         wlpSemaphore :: DNSSemaphore m
wlpSemaphore             = DNSSemaphore m
dnsSemaphore,
                                         wlpSRVPrefix :: SRVPrefix
wlpSRVPrefix             = SRVPrefix
daSRVPrefix
                                       }
                                       StdGen
peerSelectionActionsRng

          peerSelectionGovernor'
            :: Tracer m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
            -> StrictTVar m (PeerSelectionState extraState extraFlags extraPeers ntnAddr
                (PeerConnectionHandle muxMode responderCtx ntnAddr ntnVersionData ByteString m a b))
            -> PeerSelectionActions
                extraState extraFlags extraPeers
                extraAPI extraCounters ntnAddr
                (PeerConnectionHandle muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
                m
            -> m Void
          peerSelectionGovernor' Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
peerSelectionTracer StrictTVar
  m
  (PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b))
dbgVar PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
  m
peerSelectionActions =
            Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace ntnAddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     extraTrace
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
     exception
     m
-> StdGen
-> extraState
-> extraPeers
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
     m
-> PeerSelectionPolicy ntnAddr m
-> PeerSelectionInterfaces
     extraState
     extraFlags
     extraPeers
     extraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
     m
-> m Void
forall (m :: * -> *) peeraddr peerconn exception extraCounters
       extraPeers extraFlags extraDebugState extraTrace extraState
       extraAPI.
(Alternative (STM m), MonadAsync m, MonadDelay m,
 MonadLabelledSTM m, MonadMask m, MonadTimer m, Ord peeraddr,
 Show peerconn, Hashable peeraddr, Exception exception,
 Eq extraCounters, Semigroup extraPeers, Eq extraFlags) =>
Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     extraTrace
     peeraddr
     peerconn
     exception
     m
-> StdGen
-> extraState
-> extraPeers
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> m Void
PeerSelection.peerSelectionGovernor
              Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace ntnAddr)
dtTracePeerSelectionTracer
              Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
peerSelectionTracer
              Tracer m (PeerSelectionCounters extraCounters)
dtTracePeerSelectionCounters
              PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
  exception
  m
forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  exception
  m
daPeerSelectionGovernorArgs
              StdGen
fuzzRng
              extraState
daEmptyExtraState
              extraPeers
forall a. Monoid a => a
mempty
              PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
  m
peerSelectionActions
              PeerSelectionPolicy ntnAddr m
daPeerSelectionPolicy
              PeerSelectionInterfaces {
                StrictTVar m (PeerSelectionCounters extraCounters)
countersVar :: StrictTVar m (PeerSelectionCounters extraCounters)
countersVar :: StrictTVar m (PeerSelectionCounters extraCounters)
countersVar,
                publicStateVar :: StrictTVar m (PublicPeerSelectionState ntnAddr)
publicStateVar     = StrictTVar m (PublicPeerSelectionState ntnAddr)
dcPublicPeerSelectionVar,
                debugStateVar :: StrictTVar
  m
  (PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b))
debugStateVar      = StrictTVar
  m
  (PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b))
dbgVar,
                readUseLedgerPeers :: STM m UseLedgerPeers
readUseLedgerPeers = STM m UseLedgerPeers
dcReadUseLedgerPeers
              }


      --
      -- The peer churn governor:
      --
      let peerChurnGovernor' =
            PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  extraTrace
  ntnAddr
-> m Void
daPeerChurnGovernor
              PeerChurnArgs {
                pcaPeerSelectionTracer :: Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace ntnAddr)
pcaPeerSelectionTracer = Tracer
  m
  (TracePeerSelection
     extraDebugState extraFlags extraPeers extraTrace ntnAddr)
dtTracePeerSelectionTracer
              , pcaChurnTracer :: Tracer m ChurnCounters
pcaChurnTracer         = Tracer m ChurnCounters
dtTraceChurnCounters
              , pcaDeadlineInterval :: DiffTime
pcaDeadlineInterval    = DiffTime
dcDeadlineChurnInterval
              , pcaBulkInterval :: DiffTime
pcaBulkInterval        = DiffTime
dcBulkChurnInterval
              , pcaPeerRequestTimeout :: DiffTime
pcaPeerRequestTimeout  = PeerSelectionPolicy ntnAddr m -> DiffTime
forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPeerShareOverallTimeout PeerSelectionPolicy ntnAddr m
daPeerSelectionPolicy
              , pcaRng :: StdGen
pcaRng                 = StdGen
churnRng
              , pcaPeerSelectionVar :: StrictTVar m PeerSelectionTargets
pcaPeerSelectionVar    = StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar
              , pcaReadCounters :: STM m (PeerSelectionCounters extraCounters)
pcaReadCounters        = StrictTVar m (PeerSelectionCounters extraCounters)
-> STM m (PeerSelectionCounters extraCounters)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (PeerSelectionCounters extraCounters)
countersVar
              , getLedgerPeersAPI :: LedgerPeersConsensusInterface extraAPI m
getLedgerPeersAPI      = LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx
              , getLocalRootHotTarget :: STM m HotValency
getLocalRootHotTarget  =
                   LocalRootPeers extraFlags ntnAddr -> HotValency
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> HotValency
LocalRootPeers.hotTarget
                 (LocalRootPeers extraFlags ntnAddr -> HotValency)
-> ([(HotValency, WarmValency,
      Map ntnAddr (LocalRootConfig extraFlags))]
    -> LocalRootPeers extraFlags ntnAddr)
-> [(HotValency, WarmValency,
     Map ntnAddr (LocalRootConfig extraFlags))]
-> HotValency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HotValency, WarmValency,
  Map ntnAddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags ntnAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups
                 ([(HotValency, WarmValency,
   Map ntnAddr (LocalRootConfig extraFlags))]
 -> HotValency)
-> STM
     m
     [(HotValency, WarmValency,
       Map ntnAddr (LocalRootConfig extraFlags))]
-> STM m HotValency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
-> STM
     m
     [(HotValency, WarmValency,
       Map ntnAddr (LocalRootConfig extraFlags))]
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
localRootsVar
              , pcaPeerSelectionTargets :: PeerSelectionTargets
pcaPeerSelectionTargets= PeerSelectionTargets
dcPeerSelectionTargets
              , getExtraArgs :: extraChurnArgs
getExtraArgs           = extraChurnArgs
daExtraChurnArgs
              }

      --
      -- Two functions only used in InitiatorAndResponder mode
      --
      let
          -- create sockets
          withSockets' NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void
f =
            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)
dcIPv4Address
                , Maybe (Either ntnFd ntnAddr)
dcIPv6Address
                ]
              )
              NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void
f

          -- run node-to-node server
          withServer NonEmpty ntnFd
sockets InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
inboundInfoChannel =
           Arguments
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (ExpandedInitiatorContext ntnAddr m)
  (ZonkAny 5)
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  (ZonkAny 4)
  m
  a
  ()
  Void
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData)
    -> ConnectionManager
         'InitiatorResponderMode
         ntnFd
         ntnAddr
         (Handle
            'InitiatorResponderMode
            (ExpandedInitiatorContext ntnAddr m)
            (ResponderContext ntnAddr)
            ntnVersionData
            ByteString
            m
            a
            ())
         (HandlerError ntnVersion)
         m
    -> m Void)
-> m Void
forall (muxMode :: Mode) socket peerAddr initiatorCtx responderCtx
       handle handlerTrace handleError versionNumber versionData bytes
       (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,
 MonadTraceSTM m, MonadFork m, MonadFix m) =>
Arguments
  muxMode
  socket
  peerAddr
  initiatorCtx
  responderCtx
  handle
  handlerTrace
  handleError
  versionNumber
  versionData
  bytes
  m
  a
  b
  x
-> (Async m Void
    -> m (PublicState peerAddr versionData)
    -> ConnectionManager muxMode socket peerAddr handle handleError m
    -> 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,
               connectionLimits :: AcceptedConnectionsLimit
Server.connectionLimits
                                   = AcceptedConnectionsLimit
dcAcceptedConnectionsLimit,
               inboundGovernorArgs :: Arguments
  'InitiatorResponderMode
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (ExpandedInitiatorContext ntnAddr m)
  (ZonkAny 5)
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  (ZonkAny 4)
  m
  a
  ()
  Void
Server.inboundGovernorArgs =
                 IG.Arguments {
                   tracer :: Tracer m (Trace ntnAddr)
IG.tracer                = Tracer m (Trace ntnAddr)
dtInboundGovernorTracer,
                   transitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
IG.transitionTracer      = Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer,
                   debugTracer :: Tracer m (Debug ntnAddr ntnVersionData)
IG.debugTracer           = Tracer m (Debug ntnAddr ntnVersionData)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer,
                   connectionDataFlow :: ntnVersionData -> DataFlow
IG.connectionDataFlow    = ntnVersionData -> DataFlow
daNtnDataFlow,
                   idleTimeout :: Maybe DiffTime
IG.idleTimeout           = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
dcProtocolIdleTimeout,
                   withConnectionManager :: ConnectionHandler
  'InitiatorResponderMode
  (ConnectionHandlerTrace ntnVersion ntnVersionData)
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  ntnVersion
  ntnVersionData
  m
-> (ConnectionManager
      'InitiatorResponderMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorResponderMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         ())
      (HandlerError ntnVersion)
      m
    -> m Void)
-> m Void
IG.withConnectionManager =
                     InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
-> (ConnectionManager
      'InitiatorResponderMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorResponderMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         ())
      (HandlerError ntnVersion)
      m
    -> m Void)
-> m Void
withConnectionManagerInitiatorAndResponderMode InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
inboundInfoChannel,
                   mkConnectionHandler :: (StrictTVar m (StrictMaybe ResponderCounters)
 -> Tracer m (WithBearer (ConnectionId ntnAddr) Trace))
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
IG.mkConnectionHandler   =
                       Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ())
-> MkMuxConnectionHandler
     'InitiatorResponderMode
     ntnFd
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     a
     ()
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
forall (muxMode :: Mode) initiatorCtx responderCtx b c.
Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     muxMode initiatorCtx responderCtx ByteString m b c)
-> MkMuxConnectionHandler
     muxMode
     ntnFd
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
-> MuxConnectionHandler
     muxMode
     ntnFd
     initiatorCtx
     responderCtx
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     b
     c
makeConnectionHandler' Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ())
daApplicationInitiatorResponderMode
                     (MkMuxConnectionHandler
   'InitiatorResponderMode
   ntnFd
   (ExpandedInitiatorContext ntnAddr m)
   (ResponderContext ntnAddr)
   ntnAddr
   ntnVersion
   ntnVersionData
   ByteString
   m
   a
   ()
 -> ConnectionHandler
      'InitiatorResponderMode
      (ConnectionHandlerTrace ntnVersion ntnVersionData)
      ntnFd
      ntnAddr
      (Handle
         'InitiatorResponderMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         ())
      (HandlerError ntnVersion)
      ntnVersion
      ntnVersionData
      m)
-> ((StrictTVar m (StrictMaybe ResponderCounters)
     -> Tracer m (WithBearer (ConnectionId ntnAddr) Trace))
    -> MkMuxConnectionHandler
         'InitiatorResponderMode
         ntnFd
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnAddr
         ntnVersion
         ntnVersionData
         ByteString
         m
         a
         ())
-> (StrictTVar m (StrictMaybe ResponderCounters)
    -> Tracer m (WithBearer (ConnectionId ntnAddr) Trace))
-> ConnectionHandler
     'InitiatorResponderMode
     (ConnectionHandlerTrace ntnVersion ntnVersionData)
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandlerError ntnVersion)
     ntnVersion
     ntnVersionData
     m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ntnVersionData -> DataFlow)
-> (StrictTVar m (StrictMaybe ResponderCounters)
    -> Tracer m (WithBearer (ConnectionId ntnAddr) Trace))
-> MkMuxConnectionHandler
     'InitiatorResponderMode
     ntnFd
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnAddr
     ntnVersion
     ntnVersionData
     ByteString
     m
     a
     ()
forall versionData (m :: * -> *) peerAddr socket initiatorCtx
       responderCtx versionNumber bytes a b.
(versionData -> DataFlow)
-> (StrictTVar m (StrictMaybe ResponderCounters)
    -> Tracer m (WithBearer (ConnectionId peerAddr) Trace))
-> MkMuxConnectionHandler
     'InitiatorResponderMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     bytes
     m
     a
     b
MuxInitiatorResponderConnectionHandler ntnVersionData -> DataFlow
daNtnDataFlow,
                   infoChannel :: InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
IG.infoChannel           = InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
inboundInfoChannel
                 }
             }

      --
      -- 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)
   (HandlerError ntnVersion)
   m
 -> m Void)
-> m Void
withConnectionManagerInitiatorOnlyMode ((ConnectionManager
    'InitiatorMode
    ntnFd
    ntnAddr
    (Handle
       'InitiatorMode
       (ExpandedInitiatorContext ntnAddr m)
       (ResponderContext ntnAddr)
       ntnVersionData
       ByteString
       m
       a
       Void)
    (HandlerError ntnVersion)
    m
  -> m Void)
 -> m Void)
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         Void)
      (HandlerError 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)
  (HandlerError ntnVersion)
  m
connectionManager -> do
          debugStateVar <- PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
-> m (StrictTVar
        m
        (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorMode ntnAddr ntnVersionData m a Void)))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (PeerSelectionState
   extraState
   extraFlags
   extraPeers
   ntnAddr
   (NodeToNodePeerConnectionHandle
      'InitiatorMode ntnAddr ntnVersionData m a Void)
 -> m (StrictTVar
         m
         (PeerSelectionState
            extraState
            extraFlags
            extraPeers
            ntnAddr
            (NodeToNodePeerConnectionHandle
               'InitiatorMode ntnAddr ntnVersionData m a Void))))
-> PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
-> m (StrictTVar
        m
        (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorMode ntnAddr ntnVersionData m a Void)))
forall a b. (a -> b) -> a -> b
$ StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
forall extraState extraPeers extraFlags peeraddr peerconn.
StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
PeerSelection.emptyPeerSelectionState StdGen
fuzzRng extraState
daEmptyExtraState extraPeers
forall a. Monoid a => a
mempty
          daInstallSigUSR1Handler connectionManager debugStateVar
          withPeerStateActions' connectionManager $ \PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
peerStateActions->
            m (Map ntnAddr PeerSharing)
-> PeerStateActions
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         ntnAddr
         (NodeToNodePeerConnectionHandle
            'InitiatorMode ntnAddr ntnVersionData m a Void)
         m
    -> m Void)
-> m Void
forall (muxMode :: Mode) responderCtx bytes b c.
m (Map ntnAddr PeerSharing)
-> PeerStateActions
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a 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)
              PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorMode ntnAddr ntnVersionData m a Void)
  m
peerStateActions (((Async m Void, Async m Void)
  -> PeerSelectionActions
       extraState
       extraFlags
       extraPeers
       extraAPI
       extraCounters
       ntnAddr
       (NodeToNodePeerConnectionHandle
          'InitiatorMode ntnAddr ntnVersionData m a Void)
       m
  -> m Void)
 -> m Void)
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         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
localRootPeersProviderThread) PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  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 extraState extraFlags extraPeers ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        ntnAddr
        (NodeToNodePeerConnectionHandle
           'InitiatorMode ntnAddr ntnVersionData m a Void))
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void)
     m
-> m Void
forall (muxMode :: Mode) responderCtx b.
Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr ntnVersionData ByteString m a b))
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
     m
-> m Void
peerSelectionGovernor'
                    Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorTracer
                    StrictTVar
  m
  (PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorMode ntnAddr ntnVersionData m a Void))
debugStateVar
                    PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  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
localRootPeersProviderThread, Async m Void
governorThread, Async m Void
churnGovernorThread]

        -- InitiatorAndResponder mode, run peer selection and the server:
        DiffusionMode
InitiatorAndResponderDiffusionMode -> do
          inboundInfoChannel <- m (InformationChannel
     (Event
        'InitiatorResponderMode
        (Handle
           'InitiatorResponderMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           ())
        (ExpandedInitiatorContext ntnAddr m)
        ntnAddr
        ntnVersionData
        m
        a
        ())
     m)
forall a (m :: * -> *).
MonadLabelledSTM m =>
m (InformationChannel a m)
newInformationChannel
          --
          -- node-to-node sockets
          --
          withSockets' \NonEmpty ntnFd
sockets NonEmpty ntnAddr
addresses -> do
            --
            -- node-to-node server
            --
            -- 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 ...
            NonEmpty ntnFd
-> InformationChannel
     (Event
        'InitiatorResponderMode
        (Handle
           'InitiatorResponderMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           ())
        (ExpandedInitiatorContext ntnAddr m)
        ntnAddr
        ntnVersionData
        m
        a
        ())
     m
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData)
    -> ConnectionManager
         'InitiatorResponderMode
         ntnFd
         ntnAddr
         (Handle
            'InitiatorResponderMode
            (ExpandedInitiatorContext ntnAddr m)
            (ResponderContext ntnAddr)
            ntnVersionData
            ByteString
            m
            a
            ())
         (HandlerError ntnVersion)
         m
    -> m Void)
-> m Void
withServer NonEmpty ntnFd
sockets InformationChannel
  (Event
     'InitiatorResponderMode
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (ExpandedInitiatorContext ntnAddr m)
     ntnAddr
     ntnVersionData
     m
     a
     ())
  m
inboundInfoChannel
              \Async m Void
inboundGovernorThread m (PublicState ntnAddr ntnVersionData)
readInboundState ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandlerError ntnVersion)
  m
connectionManager -> do
                debugStateVar <- PeerSelectionState
  extraState
  extraFlags
  extraPeers
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
-> m (StrictTVar
        m
        (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorResponderMode ntnAddr ntnVersionData m a ())))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (PeerSelectionState
   extraState
   extraFlags
   extraPeers
   ntnAddr
   (NodeToNodePeerConnectionHandle
      'InitiatorResponderMode ntnAddr ntnVersionData m a ())
 -> m (StrictTVar
         m
         (PeerSelectionState
            extraState
            extraFlags
            extraPeers
            ntnAddr
            (NodeToNodePeerConnectionHandle
               'InitiatorResponderMode ntnAddr ntnVersionData m a ()))))
-> PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
-> m (StrictTVar
        m
        (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           ntnAddr
           (NodeToNodePeerConnectionHandle
              'InitiatorResponderMode ntnAddr ntnVersionData m a ())))
forall a b. (a -> b) -> a -> b
$ StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
forall extraState extraPeers extraFlags peeraddr peerconn.
StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
PeerSelection.emptyPeerSelectionState StdGen
fuzzRng extraState
daEmptyExtraState extraPeers
forall a. Monoid a => a
mempty
                daInstallSigUSR1Handler connectionManager debugStateVar
                withPeerStateActions' connectionManager $
                  \PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
peerStateActions ->
                    m (Map ntnAddr PeerSharing)
-> PeerStateActions
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         ntnAddr
         (NodeToNodePeerConnectionHandle
            'InitiatorResponderMode ntnAddr ntnVersionData m a ())
         m
    -> m Void)
-> m Void
forall (muxMode :: Mode) responderCtx bytes b c.
m (Map ntnAddr PeerSharing)
-> PeerStateActions
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
     m
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         ntnAddr
         (PeerConnectionHandle
            muxMode responderCtx ntnAddr ntnVersionData bytes m a 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)
                      PeerStateActions
  ntnAddr
  (NodeToNodePeerConnectionHandle
     'InitiatorResponderMode ntnAddr ntnVersionData m a ())
  m
peerStateActions (((Async m Void, Async m Void)
  -> PeerSelectionActions
       extraState
       extraFlags
       extraPeers
       extraAPI
       extraCounters
       ntnAddr
       (NodeToNodePeerConnectionHandle
          'InitiatorResponderMode ntnAddr ntnVersionData m a ())
       m
  -> m Void)
 -> m Void)
-> ((Async m Void, Async m Void)
    -> PeerSelectionActions
         extraState
         extraFlags
         extraPeers
         extraAPI
         extraCounters
         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
localRootPeersProviderThread) PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  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
                            (do
                              String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"Peer selection governor"
                              Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        ntnAddr
        (NodeToNodePeerConnectionHandle
           'InitiatorResponderMode ntnAddr ntnVersionData m a ()))
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ())
     m
-> m Void
forall (muxMode :: Mode) responderCtx b.
Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr ntnVersionData ByteString m a b))
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr ntnVersionData ByteString m a b)
     m
-> m Void
peerSelectionGovernor' Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
dtDebugPeerSelectionInitiatorResponderTracer StrictTVar
  m
  (PeerSelectionState
     extraState
     extraFlags
     extraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        'InitiatorResponderMode ntnAddr ntnVersionData m a ()))
debugStateVar PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  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
                                  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 (do
                                                      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"Peer churn governor"
                                                      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
localRootPeersProviderThread
                                                            , 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 :: ( Monoid extraPeers
       , Eq extraFlags
       , Eq extraCounters
       , Exception exception
       , Typeable ntnVersion
       , Ord ntnVersion
       , Show ntnVersion
       , Show ntnVersionData
       , Ord ntcVersion
       )
    => Arguments
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraAPI
        extraChurnArgs
        extraCounters
        extraTrace
        exception
        Resolver
        IO
        Socket
        RemoteAddress
        ntnVersion
        ntnVersionData
        LocalAddress
        ntcVersion
        ntcVersionData
    -> Tracers
        RemoteAddress
        ntnVersion
        ntnVersionData
        LocalAddress
        ntcVersion
        ntcVersionData
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraCounters
        extraTrace
        IO
    -> Configuration
        extraFlags
        IO
        Socket
        RemoteAddress
        LocalSocket
        LocalAddress
    -> Applications
        RemoteAddress
        ntnVersion
        ntnVersionData
        LocalAddress
        ntcVersion
        ntcVersionData
        IO
        a
    -> IO Void
run :: forall extraPeers extraFlags extraCounters exception ntnVersion
       ntnVersionData ntcVersion extraState extraDebugState extraAPI
       extraChurnArgs extraTrace ntcVersionData a.
(Monoid extraPeers, Eq extraFlags, Eq extraCounters,
 Exception exception, Typeable ntnVersion, Ord ntnVersion,
 Show ntnVersion, Show ntnVersionData, Ord ntcVersion) =>
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  Resolver
  IO
  Socket
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
-> Tracers
     SockAddr
     ntnVersion
     ntnVersionData
     LocalAddress
     ntcVersion
     ntcVersionData
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     extraTrace
     IO
-> Configuration
     extraFlags IO Socket SockAddr LocalSocket LocalAddress
-> Applications
     SockAddr
     ntnVersion
     ntnVersionData
     LocalAddress
     ntcVersion
     ntcVersionData
     IO
     a
-> IO Void
run Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  extraTrace
  exception
  Resolver
  IO
  Socket
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
extraParams Tracers
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  IO
tracers Configuration
  extraFlags IO Socket SockAddr LocalSocket LocalAddress
args Applications
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
  IO
  a
apps = do
    let tracer :: Tracer IO (DiffusionTracer SockAddr LocalAddress)
tracer = Tracers
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  IO
-> Tracer IO (DiffusionTracer SockAddr LocalAddress)
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraDebugState extraFlags extraPeers
       extraCounters extraTrace (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer Tracers
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  extraTrace
  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

             interfaces <- IOManager
-> Tracer IO (DiffusionTracer SockAddr LocalAddress)
-> DiffTime
-> IO
     (Interfaces Socket SockAddr LocalSocket LocalAddress Resolver IO)
forall ntnAddr ntcAddr.
IOManager
-> Tracer IO (DiffusionTracer ntnAddr ntcAddr)
-> DiffTime
-> IO
     (Interfaces Socket SockAddr LocalSocket LocalAddress Resolver IO)
mkInterfaces IOManager
iocp Tracer IO (DiffusionTracer SockAddr LocalAddress)
tracer (Configuration
  extraFlags IO Socket SockAddr LocalSocket LocalAddress
-> DiffTime
forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr -> DiffTime
dcEgressPollInterval Configuration
  extraFlags IO Socket SockAddr LocalSocket LocalAddress
args)

             runM interfaces
                  tracers
                  extraParams
                  args
                  apps

--
-- Interfaces
--

mkInterfaces :: IOManager
             -> Tracer IO (DiffusionTracer ntnAddr ntcAddr)
             -> DiffTime
             -> IO (Interfaces Socket
                               RemoteAddress
                               LocalSocket
                               LocalAddress
                               Resolver
                               IO)
mkInterfaces :: forall ntnAddr ntcAddr.
IOManager
-> Tracer IO (DiffusionTracer ntnAddr ntcAddr)
-> DiffTime
-> IO
     (Interfaces Socket SockAddr LocalSocket LocalAddress Resolver IO)
mkInterfaces IOManager
iocp Tracer IO (DiffusionTracer ntnAddr ntcAddr)
tracer DiffTime
egressPollInterval = do

  diRng <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  diConnStateIdSupply <- atomically $ CM.newConnStateIdSupply Proxy

  -- Clamp the mux egress poll interval to sane values.
  let egressInterval = DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max DiffTime
0 (DiffTime -> DiffTime) -> DiffTime -> DiffTime
forall a b. (a -> b) -> a -> b
$ DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
min DiffTime
0.200 DiffTime
egressPollInterval

  return $ Interfaces {
    diNtnSnocket                = Snocket.socketSnocket iocp,
    diNtnBearer                 = makeSocketBearer' egressInterval,
    diWithBuffer                = withReadBufferIO,
    diNtnConfigureSocket        = configureSocket,
    diNtnConfigureSystemdSocket =
      configureSystemdSocket
        (SystemdSocketConfiguration `contramap` tracer),
    diNtnAddressType       = socketAddressType,
    diNtnToPeerAddr        = curry IP.toSockAddr,
    diNtcSnocket           = Snocket.localSnocket iocp,
    diNtcBearer            = makeLocalBearer,
    diNtcGetFileDescriptor = localSocketFileDescriptor,
    diDnsActions           = RootPeersDNS.ioDNSActions,
    diRng,
    diConnStateIdSupply
  }

--
-- Data flow
--

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