{-# LANGUAGE CPP                      #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# 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.Socket (Socket)
import Network.Socket qualified as Socket

import Ouroboros.Network.ConnectionHandler
import Ouroboros.Network.ConnectionManager.Core qualified as CM
import Ouroboros.Network.ConnectionManager.InformationChannel
           (newInformationChannel)
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.IOManager
import Ouroboros.Network.Mux hiding (MiniProtocol (..))
import Ouroboros.Network.MuxMode
import Ouroboros.Network.NodeToNode (RemoteAddress)
import Ouroboros.Network.PeerSelection as PeerSelection
import Ouroboros.Network.PeerSelection.Governor qualified as Governor
import Ouroboros.Network.PeerSelection.RootPeersDNS (PeerActionsDNS (..))
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 (..),
           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 resolverError exception a
                extraState extraDebugState extraPeers
                extraAPI extraFlags extraChurnArgs extraCounters .

       ( Alternative (STM m)
       , MonadAsync       m
       , MonadDelay       m
       , MonadEvaluate    m
       , MonadFix         m
       , MonadFork        m
       , MonadLabelledSTM m
       , MonadTraceSTM    m
       , MonadMask        m
       , MonadThrow  (STM m)
       , MonadTime        m
       , MonadTimer       m
       , MonadMVar        m
       , Typeable  ntnAddr
       , Ord       ntnAddr
       , Show      ntnAddr
       , Hashable  ntnAddr
       , Typeable  ntnVersion
       , Ord       ntnVersion
       , Show      ntnVersion
       , Show      ntnVersionData
       , Typeable  ntcAddr
       , Ord       ntcAddr
       , Show      ntcAddr
       , Ord       ntcVersion
       , Exception resolverError
       , Monoid extraPeers
       , Eq extraFlags
       , Eq extraCounters
       , Exception exception
       )
       -- | interfaces
    => Interfaces ntnFd ntnAddr ntcFd ntcAddr
                  resolver resolverError m
    -> -- | tracers
       Tracers ntnAddr ntnVersion ntnVersionData
               ntcAddr ntcVersion ntcVersionData
               resolverError
               extraState extraDebugState extraFlags
               extraPeers extraCounters m
       -- | arguments
    -> Arguments extraState extraDebugState extraFlags
                 extraPeers extraAPI extraChurnArgs
                 extraCounters exception resolver
                 resolverError 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 resolverError exception
       a extraState extraDebugState extraPeers extraAPI extraFlags
       extraChurnArgs extraCounters.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadEvaluate m,
 MonadFix m, MonadFork m, MonadLabelledSTM m, MonadTraceSTM m,
 MonadMask m, MonadThrow (STM m), MonadTime m, MonadTimer m,
 MonadMVar m, Typeable ntnAddr, Ord ntnAddr, Show ntnAddr,
 Hashable ntnAddr, Typeable ntnVersion, Ord ntnVersion,
 Show ntnVersion, Show ntnVersionData, Typeable ntcAddr,
 Ord ntcAddr, Show ntcAddr, Ord ntcVersion, Exception resolverError,
 Monoid extraPeers, Eq extraFlags, Eq extraCounters,
 Exception exception) =>
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> Tracers
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     resolverError
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     m
-> Arguments
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     resolver
     resolverError
     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 resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> Snocket m ntnFd ntnAddr
diNtnSnocket
       , MakeBearer m ntnFd
diNtnBearer :: MakeBearer m ntnFd
diNtnBearer :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> MakeBearer m ntnFd
diNtnBearer
       , (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer :: (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> (Maybe (ReadBuffer m) -> m ()) -> m ()
diWithBuffer
       , ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket :: ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> ntnFd -> Maybe ntnAddr -> m ()
diNtnConfigureSocket
       , ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket :: ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> ntnFd -> ntnAddr -> m ()
diNtnConfigureSystemdSocket
       , ntnAddr -> Maybe AddressType
diNtnAddressType :: ntnAddr -> Maybe AddressType
diNtnAddressType :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> ntnAddr -> Maybe AddressType
diNtnAddressType
       , IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
       , Snocket m ntcFd ntcAddr
diNtcSnocket :: Snocket m ntcFd ntcAddr
diNtcSnocket :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> Snocket m ntcFd ntcAddr
diNtcSnocket
       , MakeBearer m ntcFd
diNtcBearer :: MakeBearer m ntcFd
diNtcBearer :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> MakeBearer m ntcFd
diNtcBearer
       , ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> ntcFd -> m FileDescriptor
diNtcGetFileDescriptor
       , StdGen
diRng :: StdGen
diRng :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> StdGen
diRng
       , Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver resolverError m
diDnsActions :: Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver resolverError m
diDnsActions :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError m
-> Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver resolverError m
diDnsActions
       , ConnStateIdSupply m
diConnStateIdSupply :: ConnStateIdSupply m
diConnStateIdSupply :: forall ntnFd ntnAddr ntcFd ntcAddr resolver resolverError
       (m :: * -> *).
Interfaces ntnFd ntnAddr ntcFd ntcAddr resolver resolverError 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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer
       , Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer
       , dtDiffusionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer = Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer
       , Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers ntnAddr)
dtTracePeerSelectionTracer :: Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers ntnAddr)
dtTracePeerSelectionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer
     m
     (TracePeerSelection extraDebugState extraFlags extraPeers ntnAddr)
dtTracePeerSelectionTracer
       , Tracer m ChurnCounters
dtTraceChurnCounters :: Tracer m ChurnCounters
dtTraceChurnCounters :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (PeerSelectionActionsTrace ntnAddr ntnVersion)
dtPeerSelectionActionsTracer
       , Tracer m (TraceLocalRootPeers extraFlags ntnAddr resolverError)
dtTraceLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers extraFlags ntnAddr resolverError)
dtTraceLocalRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (TraceLocalRootPeers extraFlags ntnAddr resolverError)
dtTraceLocalRootPeersTracer
       , Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
       , Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer :: Tracer m TraceLedgerPeers
dtTraceLedgerPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (AbstractTransitionTrace ConnStateId)
dtConnectionManagerTransitionTracer
       , Tracer m (Trace ntnAddr)
dtServerTracer :: Tracer m (Trace ntnAddr)
dtServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (Trace ntnAddr)
dtServerTracer
       , Tracer m (Trace ntnAddr)
dtInboundGovernorTracer :: Tracer m (Trace ntnAddr)
dtInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (Trace ntnAddr)
dtInboundGovernorTracer
       , Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (Trace ntcAddr)
dtLocalServerTracer
       , Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer :: Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (Trace ntcAddr)
dtLocalInboundGovernorTracer
       , Tracer m DNSTrace
dtDnsTracer :: Tracer m DNSTrace
dtDnsTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m DNSTrace
dtDnsTracer
       }
    Arguments
       { ntnVersionData -> DataFlow
daNtnDataFlow :: ntnVersionData -> DataFlow
daNtnDataFlow :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> LedgerPeersConsensusInterface extraAPI m
daLedgerPeersCtx
       , extraState
daEmptyExtraState :: extraState
daEmptyExtraState :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> extraState
daEmptyExtraState
       , extraCounters
daEmptyExtraCounters :: extraCounters
daEmptyExtraCounters :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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
  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
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr ntnVersionData bytes m a b)
  exception
  m
daPeerSelectionGovernorArgs :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> forall (muxMode :: Mode) responderCtx bytes a b.
   PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers
       , Maybe
  (PeerActionsDNS ntnAddr resolver resolverError 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 resolverError 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 exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> Maybe
     (PeerActionsDNS ntnAddr resolver resolverError 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
  ntnAddr
-> m Void
daPeerChurnGovernor :: PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  ntnAddr
-> m Void
daPeerChurnGovernor :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> PeerChurnArgs
     m
     extraChurnArgs
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     ntnAddr
-> m Void
daPeerChurnGovernor
       , extraChurnArgs
daExtraChurnArgs :: extraChurnArgs
daExtraChurnArgs :: forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcAddr
       ntcVersion ntcVersionData.
Arguments
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  resolver
  resolverError
  m
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
-> extraChurnArgs
daExtraChurnArgs
       }
     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
dcOwnPeerSharing :: PeerSharing
dcOwnPeerSharing :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> PeerSharing
dcOwnPeerSharing
       , 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
       , 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
     (NewConnectionInfo
        ntcAddr (NodeToClientHandle ntcAddr ntcVersionData m))
     m)
forall a (m :: * -> *).
MonadLabelledSTM m =>
m (InformationChannel a m)
newInformationChannel

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

            localConnectionHandler :: NodeToClientConnectionHandler
                                        ntcFd ntcAddr ntcVersion ntcVersionData m
            localConnectionHandler =
              Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
-> SingMuxMode 'ResponderMode
-> ForkPolicy ntcAddr
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosBundle
        'ResponderMode
        (MinimalInitiatorContext ntcAddr)
        (ResponderContext ntcAddr)
        ByteString
        m
        Void
        ())
-> (ThreadId m, RethrowPolicy)
-> NodeToClientConnectionHandler
     ntcFd ntcAddr ntcVersion ntcVersionData m
forall initiatorCtx responderCtx peerAddr (muxMode :: Mode) socket
       versionNumber versionData (m :: * -> *) a b.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFork m,
 MonadLabelledSTM m, MonadThrow (STM m), MonadTimer m, MonadMask m,
 Ord versionNumber, Show peerAddr, Typeable peerAddr) =>
Tracer m (WithBearer (ConnectionId peerAddr) Trace)
-> SingMuxMode muxMode
-> ForkPolicy peerAddr
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle
        muxMode initiatorCtx responderCtx ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode
     socket
     initiatorCtx
     responderCtx
     peerAddr
     versionNumber
     versionData
     ByteString
     m
     a
     b
makeConnectionHandler
                Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer
                SingMuxMode 'ResponderMode
SingResponderMode
                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)

            localConnectionManagerArguments
              :: NodeToClientConnectionManagerArguments
                   ntcFd ntcAddr ntcVersion ntcVersionData m
            localConnectionManagerArguments =
              CM.Arguments {
                  tracer :: Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
CM.tracer              = Tracer
  m
  (Trace ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer,
                  trTracer :: Tracer
  m
  (TransitionTrace
     ConnStateId
     (ConnectionState
        ntcAddr
        (NodeToClientHandle ntcAddr ntcVersionData m)
        (NodeToClientHandleError ntcVersion)
        ntcVersion
        m))
CM.trTracer            = Tracer
  m
  (TransitionTrace
     ConnStateId
     (ConnectionState
        ntcAddr
        (NodeToClientHandle ntcAddr ntcVersionData m)
        (NodeToClientHandleError ntcVersion)
        ntcVersion
        m))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer, -- TODO: issue #3320
                  muxTracer :: Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
CM.muxTracer           = Tracer m (WithBearer (ConnectionId ntcAddr) Trace)
dtLocalMuxTracer,
                  ipv4Address :: Maybe ntcAddr
CM.ipv4Address         = Maybe ntcAddr
forall a. Maybe a
Nothing,
                  ipv6Address :: Maybe ntcAddr
CM.ipv6Address         = Maybe ntcAddr
forall a. Maybe a
Nothing,
                  addressType :: ntcAddr -> Maybe AddressType
CM.addressType         = Maybe AddressType -> ntcAddr -> Maybe AddressType
forall a b. a -> b -> a
const Maybe AddressType
forall a. Maybe a
Nothing,
                  snocket :: Snocket m ntcFd ntcAddr
CM.snocket             = Snocket m ntcFd ntcAddr
diNtcSnocket,
                  makeBearer :: MakeBearer m ntcFd
CM.makeBearer          = MakeBearer m ntcFd
diNtcBearer,
                  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 :: ntcVersionData -> DataFlow
CM.connectionDataFlow  = ntcVersionData -> DataFlow
forall ntcVersionData. ntcVersionData -> DataFlow
ntcDataFlow,
                  prunePolicy :: PrunePolicy ntcAddr
CM.prunePolicy         = PrunePolicy ntcAddr
forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
Diffusion.Policies.prunePolicy,
                  stdGen :: StdGen
CM.stdGen              = StdGen
cmLocalStdGen,
                  connectionsLimits :: AcceptedConnectionsLimit
CM.connectionsLimits   = AcceptedConnectionsLimit
localConnectionLimits,
                  updateVersionData :: ntcVersionData -> DiffusionMode -> ntcVersionData
CM.updateVersionData   = \ntcVersionData
a DiffusionMode
_ -> ntcVersionData
a,
                  connStateIdSupply :: ConnStateIdSupply m
CM.connStateIdSupply   = ConnStateIdSupply m
diConnStateIdSupply
              }

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

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


    -- | mkRemoteThread - create remote connection manager

    mkRemoteThread :: ThreadId m -> m Void
    mkRemoteThread :: ThreadId m -> m Void
mkRemoteThread ThreadId m
mainThreadId = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"remote connection manager"
      let
        exitPolicy :: ExitPolicy a
        exitPolicy :: ExitPolicy a
exitPolicy = ReturnPolicy a -> ExitPolicy a
forall a. ReturnPolicy a -> ExitPolicy a
stdExitPolicy ReturnPolicy a
daReturnPolicy

      ipv4Address
        <- (Either ntnFd ntnAddr -> m ntnAddr)
-> Maybe (Either ntnFd ntnAddr) -> m (Maybe ntnAddr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ntnFd -> m ntnAddr)
-> (ntnAddr -> m ntnAddr) -> Either ntnFd ntnAddr -> m ntnAddr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Snocket m ntnFd ntnAddr -> ntnFd -> m ntnAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr Snocket m ntnFd ntnAddr
diNtnSnocket) ntnAddr -> m ntnAddr
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
                    Maybe (Either ntnFd ntnAddr)
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

      peerSelectionTargetsVar <- newTVarIO dcPeerSelectionTargets

      countersVar <- newTVarIO (Governor.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 handleError.
               PrunePolicy ntnAddr
            -> StdGen
            -> CM.Arguments
                 (ConnectionHandlerTrace ntnVersion ntnVersionData)
                 ntnFd ntnAddr handle handleError ntnVersion ntnVersionData m
          connectionManagerArguments' PrunePolicy ntnAddr
prunePolicy StdGen
stdGen =
            CM.Arguments {
                tracer :: Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
CM.tracer              = Tracer
  m
  (Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer,
                trTracer :: Tracer
  m
  (TransitionTrace
     ConnStateId
     (ConnectionState ntnAddr handle handleError ntnVersion m))
CM.trTracer            =
                  (MaybeUnknown
   (ConnectionState ntnAddr handle handleError ntnVersion m)
 -> AbstractState)
-> TransitionTrace
     ConnStateId
     (ConnectionState ntnAddr handle handleError 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 handleError ntnVersion m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
CM.abstractState
                  (TransitionTrace
   ConnStateId
   (ConnectionState ntnAddr handle handleError ntnVersion m)
 -> AbstractTransitionTrace ConnStateId)
-> Tracer m (AbstractTransitionTrace ConnStateId)
-> Tracer
     m
     (TransitionTrace
        ConnStateId
        (ConnectionState ntnAddr handle handleError ntnVersion m))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (AbstractTransitionTrace ConnStateId)
dtConnectionManagerTransitionTracer,
                muxTracer :: Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
CM.muxTracer           = Tracer m (WithBearer (ConnectionId ntnAddr) Trace)
dtMuxTracer,
                Maybe ntnAddr
ipv4Address :: Maybe ntnAddr
ipv4Address :: Maybe ntnAddr
CM.ipv4Address,
                Maybe ntnAddr
ipv6Address :: Maybe ntnAddr
ipv6Address :: Maybe ntnAddr
CM.ipv6Address,
                addressType :: ntnAddr -> Maybe AddressType
CM.addressType         = ntnAddr -> Maybe AddressType
diNtnAddressType,
                snocket :: Snocket m ntnFd ntnAddr
CM.snocket             = Snocket m ntnFd ntnAddr
diNtnSnocket,
                makeBearer :: MakeBearer m ntnFd
CM.makeBearer          = MakeBearer m ntnFd
diNtnBearer,
                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
            }

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

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

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

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

      dnsSemaphore <- RootPeersDNS.newLedgerAndPublicRootDNSSemaphore
      let dnsActions =
            PeerActionsDNS {
              paToPeerAddr :: IP -> PortNumber -> ntnAddr
paToPeerAddr = IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
            , paDnsActions :: DNSActions ntnAddr resolver resolverError m
paDnsActions = Tracer m DNSTrace
-> DNSLookupType
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions ntnAddr resolver resolverError 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 resolverError)
-> StrictTVar
     m
     [(HotValency, WarmValency,
       Map ntnAddr (LocalRootConfig extraFlags))]
-> PeerActionsDNS ntnAddr resolver resolverError 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 exception (m :: * -> *) a.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadThrow m,
 Ord peeraddr, Exception exception, Eq extraFlags) =>
Tracer m (TraceLocalRootPeers extraFlags peeraddr exception)
-> StrictTVar m (Config extraFlags peeraddr)
-> PeerActionsDNS peeraddr resolver exception 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 resolverError)
dtTraceLocalRootPeersTracer
                                       StrictTVar
  m
  [(HotValency, WarmValency,
    Map ntnAddr (LocalRootConfig extraFlags))]
localRootsVar
                                       PeerActionsDNS ntnAddr resolver resolverError 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
dcOwnPeerSharing,
                                         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 resolverError 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 resolverError 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 resolverError 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 exception.
(MonadThrow m, MonadAsync m, Exception exception,
 Monoid extraPeers, Ord peeraddr) =>
Tracer m TracePublicRootPeers
-> STM m (Map RelayAccessPoint PeerAdvertise)
-> PeerActionsDNS peeraddr resolver exception m
-> DNSSemaphore m
-> (Map peeraddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set peeraddr, DiffTime)))
-> LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
PeerSelection.requestPublicRootPeers
                                                 Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
                                                 STM m (Map RelayAccessPoint PeerAdvertise)
dcReadPublicRootPeers
                                                 PeerActionsDNS ntnAddr resolver resolverError m
dnsActions
                                                 DNSSemaphore m
dnsSemaphore
                                                 Map ntnAddr PeerAdvertise -> extraPeers
daToExtraPeers
                                                 NumberOfPeers
-> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime))
getLedgerPeers
                                             Just PeerActionsDNS ntnAddr resolver resolverError 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 resolverError 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 resolverError 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
dcOwnPeerSharing 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
                                       }
                                       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 ntnAddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     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 extraState extraAPI.
(Alternative (STM m), MonadAsync m, MonadDelay m,
 MonadLabelledSTM m, MonadMask m, MonadTimer m, Ord peeraddr,
 Show peerconn, Hashable peeraddr, Exception exception,
 Eq extraCounters, Semigroup extraPeers, Eq extraFlags) =>
Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     exception
     m
-> StdGen
-> extraState
-> extraPeers
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> m Void
Governor.peerSelectionGovernor
              Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers ntnAddr)
dtTracePeerSelectionTracer
              Tracer
  m (DebugPeerSelection extraState extraFlags extraPeers ntnAddr)
peerSelectionTracer
              Tracer m (PeerSelectionCounters extraCounters)
dtTracePeerSelectionCounters
              PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  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
  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
  ntnAddr
-> m Void
daPeerChurnGovernor
              PeerChurnArgs {
                pcaPeerSelectionTracer :: Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers ntnAddr)
pcaPeerSelectionTracer = Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers 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
              , getLedgerStateCtx :: LedgerPeersConsensusInterface extraAPI m
getLedgerStateCtx      = 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
              , getOriginalPeerTargets :: PeerSelectionTargets
getOriginalPeerTargets = 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 ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
inboundInfoChannel =
            Arguments
  'InitiatorResponderMode
  ntnFd
  (ExpandedInitiatorContext ntnAddr m)
  ntnAddr
  ntnVersionData
  ntnVersion
  ByteString
  m
  a
  ()
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData) -> m Void)
-> m Void
forall (muxMode :: Mode) socket initiatorCtx peerAddr versionData
       versionNumber (m :: * -> *) a b x.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadCatch m,
 MonadEvaluate m, MonadLabelledSTM m, MonadMask m,
 MonadThrow (STM m), MonadTime m, MonadTimer m,
 HasResponder muxMode ~ 'True, Ord peerAddr, Show peerAddr) =>
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
-> (Async m Void -> m (PublicState peerAddr versionData) -> m x)
-> m x
Server.with
              Server.Arguments {
                  sockets :: NonEmpty ntnFd
Server.sockets               = NonEmpty ntnFd
sockets,
                  snocket :: Snocket m ntnFd ntnAddr
Server.snocket               = Snocket m ntnFd ntnAddr
diNtnSnocket,
                  tracer :: Tracer m (Trace ntnAddr)
Server.tracer                = Tracer m (Trace ntnAddr)
dtServerTracer,
                  trTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
Server.trTracer              = Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer,
                  debugInboundGovernor :: Tracer m (Debug ntnAddr ntnVersionData)
Server.debugInboundGovernor  = Tracer m (Debug ntnAddr ntnVersionData)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer,
                  inboundGovernorTracer :: Tracer m (Trace ntnAddr)
Server.inboundGovernorTracer = Tracer m (Trace ntnAddr)
dtInboundGovernorTracer,
                  connectionLimits :: AcceptedConnectionsLimit
Server.connectionLimits      = AcceptedConnectionsLimit
dcAcceptedConnectionsLimit,
                  connectionManager :: ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
Server.connectionManager     = ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager,
                  connectionDataFlow :: ntnVersionData -> DataFlow
Server.connectionDataFlow    = ntnVersionData -> DataFlow
daNtnDataFlow,
                  inboundIdleTimeout :: Maybe DiffTime
Server.inboundIdleTimeout    = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
dcProtocolIdleTimeout,
                  inboundInfoChannel :: InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
Server.inboundInfoChannel    = InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
inboundInfoChannel
                }

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

        -- InitiatorOnly mode, run peer selection only:
        DiffusionMode
InitiatorOnlyDiffusionMode ->
          (ConnectionManager
   'InitiatorMode
   ntnFd
   ntnAddr
   (Handle
      'InitiatorMode
      (ExpandedInitiatorContext ntnAddr m)
      (ResponderContext ntnAddr)
      ntnVersionData
      ByteString
      m
      a
      Void)
   (HandleError 'InitiatorMode ntnVersion)
   m
 -> m Void)
-> m Void
withConnectionManagerInitiatorOnlyMode ((ConnectionManager
    'InitiatorMode
    ntnFd
    ntnAddr
    (Handle
       'InitiatorMode
       (ExpandedInitiatorContext ntnAddr m)
       (ResponderContext ntnAddr)
       ntnVersionData
       ByteString
       m
       a
       Void)
    (HandleError 'InitiatorMode ntnVersion)
    m
  -> m Void)
 -> m Void)
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (Handle
         'InitiatorMode
         (ExpandedInitiatorContext ntnAddr m)
         (ResponderContext ntnAddr)
         ntnVersionData
         ByteString
         m
         a
         Void)
      (HandleError 'InitiatorMode ntnVersion)
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
connectionManager-> do
          debugStateVar <- PeerSelectionState
  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
Governor.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
localRootPeersProvider) 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
localRootPeersProvider, Async m Void
governorThread, Async m Void
churnGovernorThread]

        -- InitiatorAndResponder mode, run peer selection and the server:
        DiffusionMode
InitiatorAndResponderDiffusionMode -> do
          inboundInfoChannel  <- m (InformationChannel
     (NewConnectionInfo
        ntnAddr
        (Handle
           'InitiatorResponderMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           ()))
     m)
forall a (m :: * -> *).
MonadLabelledSTM m =>
m (InformationChannel a m)
newInformationChannel
          withConnectionManagerInitiatorAndResponderMode
            inboundInfoChannel $ \ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager ->
              --
              -- node-to-node sockets
              --
              (NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void
withSockets' ((NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void)
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \NonEmpty ntnFd
sockets NonEmpty ntnAddr
addresses -> do
                --
                -- node-to-node server
                --
                NonEmpty ntnFd
-> ConnectionManager
     'InitiatorResponderMode
     ntnFd
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ())
     (HandleError 'InitiatorResponderMode ntnVersion)
     m
-> InformationChannel
     (NewConnectionInfo
        ntnAddr
        (Handle
           'InitiatorResponderMode
           (ExpandedInitiatorContext ntnAddr m)
           (ResponderContext ntnAddr)
           ntnVersionData
           ByteString
           m
           a
           ()))
     m
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData) -> m Void)
-> m Void
withServer NonEmpty ntnFd
sockets ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle
     'InitiatorResponderMode
     (ExpandedInitiatorContext ntnAddr m)
     (ResponderContext ntnAddr)
     ntnVersionData
     ByteString
     m
     a
     ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager InformationChannel
  (NewConnectionInfo
     ntnAddr
     (Handle
        'InitiatorResponderMode
        (ExpandedInitiatorContext ntnAddr m)
        (ResponderContext ntnAddr)
        ntnVersionData
        ByteString
        m
        a
        ()))
  m
inboundInfoChannel ((Async m Void -> m (PublicState ntnAddr ntnVersionData) -> m Void)
 -> m Void)
-> (Async m Void
    -> m (PublicState ntnAddr ntnVersionData) -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$
                  \Async m Void
inboundGovernorThread m (PublicState ntnAddr ntnVersionData)
readInboundState -> do
                    debugStateVar <- PeerSelectionState
  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
Governor.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
localRootPeersProvider) 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
                                      -- begin, unique to InitiatorAndResponder mode:
                                      Tracer m (DiffusionTracer ntnAddr ntcAddr)
-> DiffusionTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (DiffusionTracer ntnAddr ntcAddr)
tracer (NonEmpty ntnAddr -> DiffusionTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
NonEmpty ntnAddr -> DiffusionTracer ntnAddr ntcAddr
RunServer NonEmpty ntnAddr
addresses)
                                      -- end, unique to ...
                                      m Void -> (Async m Void -> m Void) -> m Void
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync (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
localRootPeersProvider
                                                                , Async m Void
governorThread
                                                                , Async m Void
churnGovernorThread
                                                                , Async m Void
inboundGovernorThread
                                                                ]

-- | Main entry point for data diffusion service.  It allows to:
--
-- * connect to upstream peers;
-- * accept connection from downstream peers, if run in
--  'InitiatorAndResponderDiffusionMode'.
-- * runs a local service which allows to use node-to-client protocol to obtain
--   information from the running system.  This is used by 'cardano-cli' or
--   a wallet and a like local services.
--
run :: ( 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
        exception
        Resolver
        IOException
        IO
        Socket
        RemoteAddress
        ntnVersion
        ntnVersionData
        LocalAddress
        ntcVersion
        ntcVersionData
    -> Tracers
        RemoteAddress
        ntnVersion
        ntnVersionData
        LocalAddress
        ntcVersion
        ntcVersionData
        IOException
        extraState
        extraDebugState
        extraFlags
        extraPeers
        extraCounters
        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 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
  exception
  Resolver
  IOException
  IO
  Socket
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
-> Tracers
     SockAddr
     ntnVersion
     ntnVersionData
     LocalAddress
     ntcVersion
     ntcVersionData
     IOException
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     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
  exception
  Resolver
  IOException
  IO
  Socket
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
extraParams Tracers
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
  IOException
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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
  IOException
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  IO
-> Tracer IO (DiffusionTracer SockAddr LocalAddress)
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m (DiffusionTracer ntnAddr ntcAddr)
dtDiffusionTracer Tracers
  SockAddr
  ntnVersion
  ntnVersionData
  LocalAddress
  ntcVersion
  ntcVersionData
  IOException
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  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 IOException IO)
forall ntnAddr ntcAddr.
IOManager
-> Tracer IO (DiffusionTracer ntnAddr ntcAddr)
-> DiffTime
-> IO
     (Interfaces
        Socket SockAddr LocalSocket LocalAddress Resolver IOException 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
                               IOException
                               IO)
mkInterfaces :: forall ntnAddr ntcAddr.
IOManager
-> Tracer IO (DiffusionTracer ntnAddr ntcAddr)
-> DiffTime
-> IO
     (Interfaces
        Socket SockAddr LocalSocket LocalAddress Resolver IOException 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