{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

-- `withLocalSocket` has some constraints that are only required on Windows.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

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

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


import           Control.Exception (IOException)
import           Control.Monad.Class.MonadAsync (Async, MonadAsync)
import qualified Control.Monad.Class.MonadAsync as Async
import           Control.Monad.Class.MonadFork
import           Control.Monad.Class.MonadSTM.Strict
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Class.MonadTime
import           Control.Monad.Class.MonadTimer
import           Control.Monad.Fix (MonadFix)
import           Control.Tracer (Tracer, contramap, nullTracer, traceWith)
import           Data.ByteString.Lazy (ByteString)
import           Data.Foldable (asum)
import           Data.IP (IP)
import qualified Data.IP as IP
import           Data.Kind (Type)
import           Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Map (Map)
import           Data.Maybe (catMaybes, maybeToList)
import           Data.Set (Set)
import           Data.Typeable (Typeable)
import           Data.Void (Void)
import           System.Random (StdGen, newStdGen, split)
#ifdef POSIX
import qualified System.Posix.Signals as Signals
#endif

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

import           Ouroboros.Network.Snocket (FileDescriptor, LocalAddress,
                     LocalSnocket, LocalSocket (..), Snocket, SocketSnocket,
                     localSocketFileDescriptor)
import qualified Ouroboros.Network.Snocket as Snocket

import           Ouroboros.Network.BlockFetch
import           Ouroboros.Network.ConnectionId
import           Ouroboros.Network.Protocol.Handshake
import           Ouroboros.Network.Protocol.Handshake.Codec
import           Ouroboros.Network.Protocol.Handshake.Version

import           Ouroboros.Network.ConnectionHandler
import           Ouroboros.Network.ConnectionManager.Core
import           Ouroboros.Network.ConnectionManager.Types
import           Ouroboros.Network.Diffusion.Common hiding (nullTracers)
import qualified Ouroboros.Network.Diffusion.Policies as Diffusion.Policies
import           Ouroboros.Network.IOManager
import           Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..),
                     RemoteTransitionTrace)
import           Ouroboros.Network.Mux hiding (MiniProtocol (..))
import           Ouroboros.Network.MuxMode
import           Ouroboros.Network.NodeToClient (NodeToClientVersion (..),
                     NodeToClientVersionData)
import qualified Ouroboros.Network.NodeToClient as NodeToClient
import           Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..),
                     DiffusionMode (..), NodeToNodeVersion (..),
                     NodeToNodeVersionData (..), RemoteAddress)
import qualified Ouroboros.Network.NodeToNode as NodeToNode
import qualified Ouroboros.Network.PeerSelection.Governor as Governor
import           Ouroboros.Network.PeerSelection.Governor.Types
                     (ChurnMode (ChurnModeNormal), DebugPeerSelection (..),
                     PeerSelectionCounters (..), TracePeerSelection (..))
import           Ouroboros.Network.PeerSelection.LedgerPeers
                     (UseLedgerAfter (..), withLedgerPeers)
import           Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics (..))
import           Ouroboros.Network.PeerSelection.PeerStateActions
                     (PeerConnectionHandle, PeerSelectionActionsTrace (..),
                     PeerStateActionsArguments (..), withPeerStateActions)
import           Ouroboros.Network.PeerSelection.RootPeersDNS (DNSActions,
                     DomainAccessPoint, LookupReqs (..), RelayAccessPoint (..),
                     TraceLocalRootPeers (..), TracePublicRootPeers (..),
                     ioDNSActions, resolveDomainAccessPoint)
import           Ouroboros.Network.PeerSelection.Simple
import           Ouroboros.Network.RethrowPolicy
import           Ouroboros.Network.Server2 (ServerArguments (..),
                     ServerTrace (..))
import qualified Ouroboros.Network.Server2 as Server

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

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
        :: Tracer m TracePublicRootPeers

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

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
dtDebugPeerSelectionInitiatorTracer
        :: Tracer m (DebugPeerSelection
                       ntnAddr
                       (PeerConnectionHandle
                         InitiatorMode
                         ntnAddr
                         ByteString
                         m () Void))

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle
           'InitiatorResponderMode ntnAddr ByteString m () ()))
dtDebugPeerSelectionInitiatorResponderTracer
        :: Tracer m (DebugPeerSelection
                       ntnAddr
                       (PeerConnectionHandle
                         InitiatorResponderMode
                         ntnAddr
                         ByteString
                         m () ()))

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
        :: Tracer m PeerSelectionCounters

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

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (ConnectionManagerTrace
        ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer
        :: Tracer m (ConnectionManagerTrace
                      ntnAddr
                      (ConnectionHandlerTrace
                         ntnVersion
                         ntnVersionData))

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

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (ServerTrace ntnAddr)
dtServerTracer
        :: Tracer m (ServerTrace ntnAddr)

    , TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (InboundGovernorTrace ntnAddr)
dtInboundGovernorTracer
        :: Tracer m (InboundGovernorTrace ntnAddr)

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

      --
      -- NodeToClient tracers
      --

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

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

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

nullTracers :: Applicative m
            => TracersExtra ntnAddr ntnVersion ntnVersionData
                            ntcAddr ntcVersion ntcVersionData
                            resolverError m
nullTracers :: TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
nullTracers =
    TracersExtra :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
Tracer m (TraceLocalRootPeers ntnAddr resolverError)
-> Tracer m TracePublicRootPeers
-> Tracer m (TracePeerSelection ntnAddr)
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle
           'InitiatorResponderMode ntnAddr ByteString m () ()))
-> Tracer m PeerSelectionCounters
-> Tracer m (PeerSelectionActionsTrace ntnAddr)
-> Tracer
     m
     (ConnectionManagerTrace
        ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
-> Tracer m (AbstractTransitionTrace ntnAddr)
-> Tracer m (ServerTrace ntnAddr)
-> Tracer m (InboundGovernorTrace ntnAddr)
-> Tracer m (RemoteTransitionTrace ntnAddr)
-> Tracer
     m
     (ConnectionManagerTrace
        ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
-> Tracer m (ServerTrace ntcAddr)
-> Tracer m (InboundGovernorTrace ntcAddr)
-> TracersExtra
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     resolverError
     m
TracersExtra {
        dtTraceLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer                  = Tracer m (TraceLocalRootPeers ntnAddr resolverError)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTracePublicRootPeersTracer :: Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer                 = Tracer m TracePublicRootPeers
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTracePeerSelectionTracer :: Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer                   = Tracer m (TracePeerSelection ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtDebugPeerSelectionInitiatorTracer :: Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
dtDebugPeerSelectionInitiatorTracer          = Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtDebugPeerSelectionInitiatorResponderTracer :: Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ()))
dtDebugPeerSelectionInitiatorResponderTracer = Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ()))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtTracePeerSelectionCounters :: Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters                 = Tracer m PeerSelectionCounters
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtPeerSelectionActionsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr)
dtPeerSelectionActionsTracer                 = Tracer m (PeerSelectionActionsTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtConnectionManagerTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer                    = Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtConnectionManagerTransitionTracer :: Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer          = Tracer m (AbstractTransitionTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtServerTracer :: Tracer m (ServerTrace ntnAddr)
dtServerTracer                               = Tracer m (ServerTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtInboundGovernorTracer :: Tracer m (InboundGovernorTrace ntnAddr)
dtInboundGovernorTracer                      = Tracer m (InboundGovernorTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtInboundGovernorTransitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer            = Tracer m (RemoteTransitionTrace ntnAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalConnectionManagerTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer               = Tracer
  m
  (ConnectionManagerTrace
     ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalServerTracer :: Tracer m (ServerTrace ntcAddr)
dtLocalServerTracer                          = Tracer m (ServerTrace ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      , dtLocalInboundGovernorTracer :: Tracer m (InboundGovernorTrace ntcAddr)
dtLocalInboundGovernorTracer                 = Tracer m (InboundGovernorTrace ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    }

-- | P2P Arguments Extras
--
data ArgumentsExtra m = ArgumentsExtra {
      -- | selection targets for the peer governor
      --
      ArgumentsExtra m -> PeerSelectionTargets
daPeerSelectionTargets :: PeerSelectionTargets

    , ArgumentsExtra m
-> STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
daReadLocalRootPeers  :: STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
    , ArgumentsExtra m -> STM m [RelayAccessPoint]
daReadPublicRootPeers :: STM m [RelayAccessPoint]
    , ArgumentsExtra m -> STM m UseLedgerAfter
daReadUseLedgerAfter  :: STM m UseLedgerAfter

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

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

--
-- Constants
--

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

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


socketAddressType :: Socket.SockAddr -> Maybe AddressType
socketAddressType :: SockAddr -> Maybe AddressType
socketAddressType Socket.SockAddrInet {}  = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv4Address
socketAddressType Socket.SockAddrInet6 {} = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv6Address
socketAddressType SockAddr
addr                    =
  [Char] -> Maybe AddressType
forall a. HasCallStack => [Char] -> a
error ([Char]
"socketAddressType: unexpected address " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SockAddr -> [Char]
forall a. Show a => a -> [Char]
show SockAddr
addr)


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

    -- | /node-to-client/ rethrow policy
    --
    , ApplicationsExtra ntnAddr m -> RethrowPolicy
daLocalRethrowPolicy :: RethrowPolicy

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

    -- | Used by churn-governor
    --
    , ApplicationsExtra ntnAddr m -> STM m FetchMode
daBlockFetchMode     :: STM m FetchMode
  }

-- | Diffusion will always run initiator of node-to-node protocols, but in some
-- configurations, i.e. 'InitiatorOnlyDiffusionMode', it will not run the
-- responder side.  This type allows to reflect this.
--
-- This is only used internally by 'run'; This type allows to
-- construct configuration upfront, before all services like connection manager
-- or server are initialised \/ started.
--
-- This is an existential wrapper for the higher order type @f :: MuxMode ->
-- Type@, like @'ConnectionManagerDataInMode' (mode :: MuxMode)@ below.
--
data HasMuxMode (f :: MuxMode -> Type) where
    HasInitiator :: !(f InitiatorMode)
                 -> HasMuxMode f

    HasInitiatorResponder
                 :: !(f InitiatorResponderMode)
                 -> HasMuxMode f

-- | Node-To-Node connection manager requires extra data when running in
-- 'InitiatorResponderMode'.
--
data ConnectionManagerDataInMode peerAddr m (mode :: MuxMode) where
    CMDInInitiatorMode
      :: ConnectionManagerDataInMode peerAddr m InitiatorMode

    CMDInInitiatorResponderMode
      :: Server.ControlChannel m
          (Server.NewConnection
            peerAddr
            (Handle InitiatorResponderMode peerAddr ByteString m () ()))
      -> StrictTVar m Server.InboundGovernorObservableState
      -> ConnectionManagerDataInMode peerAddr m InitiatorResponderMode


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

type NodeToClientHandle ntcAddr m =
    Handle ResponderMode ntcAddr ByteString m Void ()

type NodeToClientHandleError ntcVersion =
    HandleError ResponderMode ntcVersion

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

type NodeToClientConnectionManagerArguments
      ntcFd ntcAddr ntcVersion ntcVersionData m =
    ConnectionManagerArguments
      (ConnectionHandlerTrace ntcVersion ntcVersionData)
      ntcFd
      ntcAddr
      (NodeToClientHandle ntcAddr m)
      (NodeToClientHandleError ntcVersion)
      (ntcVersion, ntcVersionData)
      m

type NodeToClientConnectionManager
      ntcFd ntcAddr ntcVersion ntcVersionData m =
    ConnectionManager
      ResponderMode
      ntcFd
      ntcAddr
      (NodeToClientHandle ntcAddr m)
      (NodeToClientHandleError ntcVersion)
      m

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

type NodeToNodeHandle
       (mode :: MuxMode)
       ntnAddr m a =
    Handle mode ntnAddr ByteString m () a

type NodeToNodeConnectionHandler
       (mode :: MuxMode)
       ntnFd ntnAddr ntnVersion ntnVersionData m a =
    ConnectionHandler
      mode
      (ConnectionHandlerTrace ntnVersion ntnVersionData)
      ntnFd
      ntnAddr
      (NodeToNodeHandle mode ntnAddr m a)
      (HandleError mode ntnVersion)
      (ntnVersion, ntnVersionData)
      m

type NodeToNodeConnectionManagerArguments
       (mode :: MuxMode)
       ntnFd ntnAddr ntnVersion ntnVersionData m a =
    ConnectionManagerArguments
      (ConnectionHandlerTrace ntnVersion ntnVersionData)
      ntnFd
      ntnAddr
      (NodeToNodeHandle mode ntnAddr m a)
      (HandleError mode ntnVersion)
      (ntnVersion, ntnVersionData)
      m

type NodeToNodeConnectionManager
       (mode :: MuxMode)
       ntnFd ntnAddr ntnVersion m a =
    ConnectionManager
      mode
      ntnFd
      ntnAddr
      (NodeToNodeHandle mode ntnAddr m a)
      (HandleError mode ntnVersion)
      m

--
-- Governor type aliases
--

type NodeToNodePeerConnectionHandle (mode :: MuxMode) ntnAddr m a =
    PeerConnectionHandle
      mode
      ntnAddr
      ByteString
      m () a

type NodeToNodePeerStateActions (mode :: MuxMode) ntnAddr m a =
    Governor.PeerStateActions
      ntnAddr
      (NodeToNodePeerConnectionHandle mode ntnAddr m a)
      m

type NodeToNodePeerSelectionActions (mode :: MuxMode) ntnAddr m a =
    Governor.PeerSelectionActions
      ntnAddr
      (NodeToNodePeerConnectionHandle mode ntnAddr m a)
      m

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

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

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

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

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

        -- | node-to-node domain resolver
        --
        Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> LookupReqs
-> [DomainAccessPoint]
-> m (Map DomainAccessPoint (Set ntnAddr))
diNtnDomainResolver
          :: LookupReqs -> [DomainAccessPoint] -> m (Map DomainAccessPoint (Set ntnAddr)),

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

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

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

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

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

        -- | diffusion dns actions
        --
        Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> LookupReqs -> DNSActions resolver resolverError m
diDnsActions
          :: LookupReqs -> DNSActions resolver resolverError m
      }

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

    -> -- | protocol handlers
       Applications ntnAddr ntnVersion ntnVersionData
                    ntcAddr ntcVersion ntcVersionData
                    m
    -> -- | p2p protocol handlers
       ApplicationsExtra ntnAddr m
    -> m Void
runM :: Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> TracersExtra
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     resolverError
     m
-> Arguments ntnFd ntnAddr ntcFd ntcAddr
-> ArgumentsExtra m
-> Applications
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     m
-> ApplicationsExtra ntnAddr m
-> m Void
runM Interfaces
       { Snocket m ntnFd ntnAddr
diNtnSnocket :: Snocket m ntnFd ntnAddr
diNtnSnocket :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Snocket m ntnFd ntnAddr
diNtnSnocket
       , HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments
       , ntnAddr -> Maybe AddressType
diNtnAddressType :: ntnAddr -> Maybe AddressType
diNtnAddressType :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnAddr -> Maybe AddressType
diNtnAddressType
       , ntnVersion -> ntnVersionData -> DataFlow
diNtnDataFlow :: ntnVersion -> ntnVersionData -> DataFlow
diNtnDataFlow :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntnVersion -> ntnVersionData -> DataFlow
diNtnDataFlow
       , IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: IP -> PortNumber -> ntnAddr
diNtnToPeerAddr :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
       , LookupReqs
-> [DomainAccessPoint] -> m (Map DomainAccessPoint (Set ntnAddr))
diNtnDomainResolver :: LookupReqs
-> [DomainAccessPoint] -> m (Map DomainAccessPoint (Set ntnAddr))
diNtnDomainResolver :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> LookupReqs
-> [DomainAccessPoint]
-> m (Map DomainAccessPoint (Set ntnAddr))
diNtnDomainResolver
       , Snocket m ntcFd ntcAddr
diNtcSnocket :: Snocket m ntcFd ntcAddr
diNtcSnocket :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Snocket m ntcFd ntcAddr
diNtcSnocket
       , HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments
       , ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: ntcFd -> m FileDescriptor
diNtcGetFileDescriptor :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> ntcFd -> m FileDescriptor
diNtcGetFileDescriptor
       , StdGen
diRng :: StdGen
diRng :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> StdGen
diRng
       , forall (mode :: MuxMode) x.
NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersion m x
-> m ()
diInstallSigUSR1Handler :: forall (mode :: MuxMode) x.
NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersion m x
-> m ()
diInstallSigUSR1Handler :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> forall (mode :: MuxMode) x.
   NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersion m x
   -> m ()
diInstallSigUSR1Handler
       , LookupReqs -> DNSActions resolver resolverError m
diDnsActions :: LookupReqs -> DNSActions resolver resolverError m
diDnsActions :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> LookupReqs -> DNSActions resolver resolverError m
diDnsActions
       }
     Tracers
       { Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer
       , Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer
       , Tracer m TraceLedgerPeers
dtLedgerPeersTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m TraceLedgerPeers
dtLedgerPeersTracer :: Tracer m TraceLedgerPeers
dtLedgerPeersTracer
       , dtDiffusionInitializationTracer :: forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (InitializationTracer ntnAddr ntcAddr)
dtDiffusionInitializationTracer = Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer
       }
     TracersExtra
       { Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer :: Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
       , Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
dtDebugPeerSelectionInitiatorTracer :: Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
dtDebugPeerSelectionInitiatorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
dtDebugPeerSelectionInitiatorTracer
       , Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ()))
dtDebugPeerSelectionInitiatorResponderTracer :: Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ()))
dtDebugPeerSelectionInitiatorResponderTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle
           'InitiatorResponderMode ntnAddr ByteString m () ()))
dtDebugPeerSelectionInitiatorResponderTracer
       , Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters :: Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
       , Tracer m (PeerSelectionActionsTrace ntnAddr)
dtPeerSelectionActionsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr)
dtPeerSelectionActionsTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (PeerSelectionActionsTrace ntnAddr)
dtPeerSelectionActionsTracer
       , Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer :: Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer
       , Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
       , Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (ConnectionManagerTrace
        ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer
       , Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer :: Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer
       , Tracer m (ServerTrace ntnAddr)
dtServerTracer :: Tracer m (ServerTrace ntnAddr)
dtServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (ServerTrace ntnAddr)
dtServerTracer
       , Tracer m (InboundGovernorTrace ntnAddr)
dtInboundGovernorTracer :: Tracer m (InboundGovernorTrace ntnAddr)
dtInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (InboundGovernorTrace ntnAddr)
dtInboundGovernorTracer
       , Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer
       , Tracer
  m
  (ConnectionManagerTrace
     ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (ConnectionManagerTrace
        ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer
       , Tracer m (ServerTrace ntcAddr)
dtLocalServerTracer :: Tracer m (ServerTrace ntcAddr)
dtLocalServerTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (ServerTrace ntcAddr)
dtLocalServerTracer
       , Tracer m (InboundGovernorTrace ntcAddr)
dtLocalInboundGovernorTracer :: Tracer m (InboundGovernorTrace ntcAddr)
dtLocalInboundGovernorTracer :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m (InboundGovernorTrace ntcAddr)
dtLocalInboundGovernorTracer
       }
     Arguments
       { Maybe (Either ntnFd ntnAddr)
daIPv4Address :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv4Address :: Maybe (Either ntnFd ntnAddr)
daIPv4Address
       , Maybe (Either ntnFd ntnAddr)
daIPv6Address :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntnFd ntnAddr)
daIPv6Address :: Maybe (Either ntnFd ntnAddr)
daIPv6Address
       , Maybe (Either ntcFd ntcAddr)
daLocalAddress :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr
-> Maybe (Either ntcFd ntcAddr)
daLocalAddress :: Maybe (Either ntcFd ntcAddr)
daLocalAddress
       , AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr -> AcceptedConnectionsLimit
daAcceptedConnectionsLimit :: AcceptedConnectionsLimit
daAcceptedConnectionsLimit
       , daMode :: forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
daMode = DiffusionMode
diffusionMode
       }
     ArgumentsExtra
       { PeerSelectionTargets
daPeerSelectionTargets :: PeerSelectionTargets
daPeerSelectionTargets :: forall (m :: * -> *). ArgumentsExtra m -> PeerSelectionTargets
daPeerSelectionTargets
       , STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
daReadLocalRootPeers :: STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
daReadLocalRootPeers :: forall (m :: * -> *).
ArgumentsExtra m
-> STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
daReadLocalRootPeers
       , STM m [RelayAccessPoint]
daReadPublicRootPeers :: STM m [RelayAccessPoint]
daReadPublicRootPeers :: forall (m :: * -> *). ArgumentsExtra m -> STM m [RelayAccessPoint]
daReadPublicRootPeers
       , STM m UseLedgerAfter
daReadUseLedgerAfter :: STM m UseLedgerAfter
daReadUseLedgerAfter :: forall (m :: * -> *). ArgumentsExtra m -> STM m UseLedgerAfter
daReadUseLedgerAfter
       , DiffTime
daProtocolIdleTimeout :: DiffTime
daProtocolIdleTimeout :: forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daProtocolIdleTimeout
       , DiffTime
daTimeWaitTimeout :: DiffTime
daTimeWaitTimeout :: forall (m :: * -> *). ArgumentsExtra m -> DiffTime
daTimeWaitTimeout
       }
     Applications
       { Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode :: Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode
       , Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     'InitiatorResponderMode ntnAddr ByteString m () ())
daApplicationInitiatorResponderMode :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        'InitiatorResponderMode ntnAddr ByteString m () ())
daApplicationInitiatorResponderMode :: Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     'InitiatorResponderMode ntnAddr ByteString m () ())
daApplicationInitiatorResponderMode
       , Versions
  ntcVersion
  ntcVersionData
  (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication :: Versions
  ntcVersion
  ntcVersionData
  (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
daLocalResponderApplication
       , LedgerPeersConsensusInterface m
daLedgerPeersCtx :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  m
-> LedgerPeersConsensusInterface m
daLedgerPeersCtx :: LedgerPeersConsensusInterface m
daLedgerPeersCtx
       }
     ApplicationsExtra
       { RethrowPolicy
daRethrowPolicy :: RethrowPolicy
daRethrowPolicy :: forall ntnAddr (m :: * -> *).
ApplicationsExtra ntnAddr m -> RethrowPolicy
daRethrowPolicy
       , RethrowPolicy
daLocalRethrowPolicy :: RethrowPolicy
daLocalRethrowPolicy :: forall ntnAddr (m :: * -> *).
ApplicationsExtra ntnAddr m -> RethrowPolicy
daLocalRethrowPolicy
       , PeerMetrics m ntnAddr
daPeerMetrics :: PeerMetrics m ntnAddr
daPeerMetrics :: forall ntnAddr (m :: * -> *).
ApplicationsExtra ntnAddr m -> PeerMetrics m ntnAddr
daPeerMetrics
       , STM m FetchMode
daBlockFetchMode :: STM m FetchMode
daBlockFetchMode :: forall ntnAddr (m :: * -> *).
ApplicationsExtra ntnAddr m -> STM m FetchMode
daBlockFetchMode
       }
  = do
    -- Thread to which 'RethrowPolicy' will throw fatal exceptions.
    ThreadId m
mainThreadId <- m (ThreadId m)
forall (m :: * -> *). MonadThread m => m (ThreadId m)
myThreadId

    Maybe ntnAddr
cmIPv4Address
      <- (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)
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 (f :: * -> *) a. Applicative f => a -> f a
pure)
                  Maybe (Either ntnFd ntnAddr)
daIPv4Address
    case Maybe ntnAddr
cmIPv4Address of
      Just ntnAddr
addr | Just AddressType
IPv4Address <- ntnAddr -> Maybe AddressType
diNtnAddressType ntnAddr
addr
                -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                | Bool
otherwise
                -> Failure ntnAddr -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ntnAddr -> Failure ntnAddr
forall ntnAddr. ntnAddr -> Failure ntnAddr
UnexpectedIPv4Address ntnAddr
addr)
      Maybe ntnAddr
Nothing   -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Maybe ntnAddr
cmIPv6Address
      <- (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)
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 (f :: * -> *) a. Applicative f => a -> f a
pure)
                  Maybe (Either ntnFd ntnAddr)
daIPv6Address
    case Maybe ntnAddr
cmIPv6Address of
      Just ntnAddr
addr | Just AddressType
IPv6Address <- ntnAddr -> Maybe AddressType
diNtnAddressType ntnAddr
addr
                -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                | Bool
otherwise
                -> Failure ntnAddr -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ntnAddr -> Failure ntnAddr
forall ntnAddr. ntnAddr -> Failure ntnAddr
UnexpectedIPv6Address ntnAddr
addr)
      Maybe ntnAddr
Nothing   -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

    -- control channel for the server; only required in
    -- @'InitiatorResponderMode' :: 'MuxMode'@
    HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
cmdInMode
      <- case DiffusionMode
diffusionMode of
          DiffusionMode
InitiatorOnlyDiffusionMode ->
            -- action which we pass to connection handler
            HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
-> m (HasMuxMode (ConnectionManagerDataInMode ntnAddr m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionManagerDataInMode ntnAddr m 'InitiatorMode
-> HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
forall (f :: MuxMode -> *). f 'InitiatorMode -> HasMuxMode f
HasInitiator ConnectionManagerDataInMode ntnAddr m 'InitiatorMode
forall peerAddr (m :: * -> *).
ConnectionManagerDataInMode peerAddr m 'InitiatorMode
CMDInInitiatorMode)
          DiffusionMode
InitiatorAndResponderDiffusionMode -> do
            -- we pass 'Server.newOutboundConnection serverControlChannel' to
            -- connection handler
            ConnectionManagerDataInMode ntnAddr m 'InitiatorResponderMode
-> HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
forall (f :: MuxMode -> *).
f 'InitiatorResponderMode -> HasMuxMode f
HasInitiatorResponder (ConnectionManagerDataInMode ntnAddr m 'InitiatorResponderMode
 -> HasMuxMode (ConnectionManagerDataInMode ntnAddr m))
-> m (ConnectionManagerDataInMode
        ntnAddr m 'InitiatorResponderMode)
-> m (HasMuxMode (ConnectionManagerDataInMode ntnAddr m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              (ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
-> StrictTVar m InboundGovernorObservableState
-> ConnectionManagerDataInMode ntnAddr m 'InitiatorResponderMode
forall (m :: * -> *) peerAddr.
ControlChannel
  m
  (NewConnection
     peerAddr
     (Handle 'InitiatorResponderMode peerAddr ByteString m () ()))
-> StrictTVar m InboundGovernorObservableState
-> ConnectionManagerDataInMode peerAddr m 'InitiatorResponderMode
CMDInInitiatorResponderMode
                (ControlChannel
   m
   (NewConnection
      ntnAddr
      (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
 -> StrictTVar m InboundGovernorObservableState
 -> ConnectionManagerDataInMode ntnAddr m 'InitiatorResponderMode)
-> m (ControlChannel
        m
        (NewConnection
           ntnAddr
           (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())))
-> m (StrictTVar m InboundGovernorObservableState
      -> ConnectionManagerDataInMode ntnAddr m 'InitiatorResponderMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ControlChannel
     m
     (NewConnection
        ntnAddr
        (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())))
forall (m :: * -> *) srvCntrlMsg.
MonadLabelledSTM m =>
m (ControlChannel m srvCntrlMsg)
Server.newControlChannel
                m (StrictTVar m InboundGovernorObservableState
   -> ConnectionManagerDataInMode ntnAddr m 'InitiatorResponderMode)
-> m (StrictTVar m InboundGovernorObservableState)
-> m (ConnectionManagerDataInMode
        ntnAddr m 'InitiatorResponderMode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StdGen -> m (StrictTVar m InboundGovernorObservableState)
forall (m :: * -> *).
MonadLabelledSTM m =>
StdGen -> m (StrictTVar m InboundGovernorObservableState)
Server.newObservableStateVar StdGen
ntnInbgovRng)

    ControlChannel
  m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m))
localControlChannel <- m (ControlChannel
     m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m)))
forall (m :: * -> *) srvCntrlMsg.
MonadLabelledSTM m =>
m (ControlChannel m srvCntrlMsg)
Server.newControlChannel
    StrictTVar m InboundGovernorObservableState
localServerStateVar <- StdGen -> m (StrictTVar m InboundGovernorObservableState)
forall (m :: * -> *).
MonadLabelledSTM m =>
StdGen -> m (StrictTVar m InboundGovernorObservableState)
Server.newObservableStateVar StdGen
ntcInbgovRng

    -- RNGs used for picking random peers from the ledger and for
    -- demoting/promoting peers.
    StrictTVar m StdGen
policyRngVar <- StdGen -> m (StrictTVar m StdGen)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO StdGen
policyRng

    StrictTVar m ChurnMode
churnModeVar <- ChurnMode -> m (StrictTVar m ChurnMode)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO ChurnMode
ChurnModeNormal

    StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar <- PeerSelectionTargets -> m (StrictTVar m PeerSelectionTargets)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (PeerSelectionTargets -> m (StrictTVar m PeerSelectionTargets))
-> PeerSelectionTargets -> m (StrictTVar m PeerSelectionTargets)
forall a b. (a -> b) -> a -> b
$ PeerSelectionTargets
daPeerSelectionTargets {
        -- Start with a smaller number of active peers, the churn governor will increase
        -- it to the configured value after a delay.
        targetNumberOfActivePeers :: Int
targetNumberOfActivePeers =
          Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 (PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
daPeerSelectionTargets)
      }

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

        --
        -- local connection manager
        --
        localThread :: Maybe (m Void)
        localThread :: Maybe (m Void)
localThread =
          case Maybe (Either ntcFd ntcAddr)
daLocalAddress of
            Maybe (Either ntcFd ntcAddr)
Nothing -> Maybe (m Void)
forall a. Maybe a
Nothing
            Just Either ntcFd ntcAddr
localAddr ->
              m Void -> Maybe (m Void)
forall a. a -> Maybe a
Just (m Void -> Maybe (m Void)) -> m Void -> Maybe (m Void)
forall a b. (a -> b) -> a -> b
$ Tracer m (InitializationTracer 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 (InitializationTracer ntnAddr ntcAddr)
-> (ntcFd -> m FileDescriptor)
-> Snocket m ntcFd ntcAddr
-> Either ntcFd ntcAddr
-> (ntcFd -> m a)
-> m a
withLocalSocket Tracer m (InitializationTracer 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
                let localConnectionHandler :: NodeToClientConnectionHandler
                                                ntcFd ntcAddr ntcVersion ntcVersionData m
                    localConnectionHandler :: NodeToClientConnectionHandler
  ntcFd ntcAddr ntcVersion ntcVersionData m
localConnectionHandler =
                      Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
-> SingMuxMode 'ResponderMode
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosBundle 'ResponderMode ntcAddr ByteString m Void ())
-> (ThreadId m, RethrowPolicy)
-> NodeToClientConnectionHandler
     ntcFd ntcAddr ntcVersion ntcVersionData m
forall peerAddr (muxMode :: MuxMode) socket versionNumber
       versionData (m :: * -> *) a b.
(MonadAsync m, MonadCatch m, MonadFork m, MonadLabelledSTM m,
 MonadThrow (STM m), MonadTime m, MonadTimer m, MonadMask m,
 Ord versionNumber, Show peerAddr, Typeable peerAddr) =>
Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
-> SingMuxMode muxMode
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle muxMode peerAddr ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode socket peerAddr versionNumber versionData ByteString m a b
makeConnectionHandler
                        Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer
                        SingMuxMode 'ResponderMode
SingResponderMode
                        HandshakeArguments
  (ConnectionId ntcAddr) ntcVersion ntcVersionData m
diNtcHandshakeArguments
                        ( ( \ (OuroborosApplication ConnectionId ntcAddr
-> ControlMessageSTM m
-> [MiniProtocol 'ResponderMode ByteString m Void ()]
apps)
                           -> WithProtocolTemperature
  'Hot
  (ConnectionId ntcAddr
   -> ControlMessageSTM m
   -> [MiniProtocol 'ResponderMode ByteString m Void ()])
-> WithProtocolTemperature
     'Warm
     (ConnectionId ntcAddr
      -> ControlMessageSTM m
      -> [MiniProtocol 'ResponderMode ByteString m Void ()])
-> WithProtocolTemperature
     'Established
     (ConnectionId ntcAddr
      -> ControlMessageSTM m
      -> [MiniProtocol 'ResponderMode ByteString m Void ()])
-> OuroborosBundle 'ResponderMode ntcAddr ByteString m Void ()
forall a.
WithProtocolTemperature 'Hot a
-> WithProtocolTemperature 'Warm a
-> WithProtocolTemperature 'Established a
-> Bundle a
Bundle
                                ((ConnectionId ntcAddr
 -> ControlMessageSTM m
 -> [MiniProtocol 'ResponderMode ByteString m Void ()])
-> WithProtocolTemperature
     'Hot
     (ConnectionId ntcAddr
      -> ControlMessageSTM m
      -> [MiniProtocol 'ResponderMode ByteString m Void ()])
forall a. a -> WithProtocolTemperature 'Hot a
WithHot ConnectionId ntcAddr
-> ControlMessageSTM m
-> [MiniProtocol 'ResponderMode ByteString m Void ()]
apps)
                                ((ConnectionId ntcAddr
 -> ControlMessageSTM m
 -> [MiniProtocol 'ResponderMode ByteString m Void ()])
-> WithProtocolTemperature
     'Warm
     (ConnectionId ntcAddr
      -> ControlMessageSTM m
      -> [MiniProtocol 'ResponderMode ByteString m Void ()])
forall a. a -> WithProtocolTemperature 'Warm a
WithWarm (\ConnectionId ntcAddr
_ ControlMessageSTM m
_ -> []))
                                ((ConnectionId ntcAddr
 -> ControlMessageSTM m
 -> [MiniProtocol 'ResponderMode ByteString m Void ()])
-> WithProtocolTemperature
     'Established
     (ConnectionId ntcAddr
      -> ControlMessageSTM m
      -> [MiniProtocol 'ResponderMode ByteString m Void ()])
forall a. a -> WithProtocolTemperature 'Established a
WithEstablished (\ConnectionId ntcAddr
_ ControlMessageSTM m
_ -> []))
                          ) (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ()
 -> OuroborosBundle 'ResponderMode ntcAddr ByteString m Void ())
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosBundle 'ResponderMode ntcAddr ByteString m Void ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versions
  ntcVersion
  ntcVersionData
  (OuroborosApplication '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 :: NodeToClientConnectionManagerArguments
  ntcFd ntcAddr ntcVersion ntcVersionData m
localConnectionManagerArguments =
                      ConnectionManagerArguments :: forall handlerTrace socket peerAddr handle handleError version
       (m :: * -> *).
Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
-> Tracer
     m
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m))
-> Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
-> Maybe peerAddr
-> Maybe peerAddr
-> (peerAddr -> Maybe AddressType)
-> Snocket m socket peerAddr
-> DiffTime
-> DiffTime
-> (version -> DataFlow)
-> PrunePolicy peerAddr (STM m)
-> AcceptedConnectionsLimit
-> ConnectionManagerArguments
     handlerTrace socket peerAddr handle handleError version m
ConnectionManagerArguments {
                          cmTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
cmTracer              = Tracer
  m
  (ConnectionManagerTrace
     ntcAddr (ConnectionHandlerTrace ntcVersion ntcVersionData))
dtLocalConnectionManagerTracer,
                          cmTrTracer :: Tracer
  m
  (TransitionTrace
     ntcAddr
     (ConnectionState
        ntcAddr
        (NodeToClientHandle ntcAddr m)
        (NodeToClientHandleError ntcVersion)
        (ntcVersion, ntcVersionData)
        m))
cmTrTracer            = Tracer
  m
  (TransitionTrace
     ntcAddr
     (ConnectionState
        ntcAddr
        (NodeToClientHandle ntcAddr m)
        (NodeToClientHandleError ntcVersion)
        (ntcVersion, ntcVersionData)
        m))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer, -- TODO: issue #3320
                          cmMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
cmMuxTracer           = Tracer m (WithMuxBearer (ConnectionId ntcAddr) MuxTrace)
dtLocalMuxTracer,
                          cmIPv4Address :: Maybe ntcAddr
cmIPv4Address         = Maybe ntcAddr
forall a. Maybe a
Nothing,
                          cmIPv6Address :: Maybe ntcAddr
cmIPv6Address         = Maybe ntcAddr
forall a. Maybe a
Nothing,
                          cmAddressType :: ntcAddr -> Maybe AddressType
cmAddressType         = Maybe AddressType -> ntcAddr -> Maybe AddressType
forall a b. a -> b -> a
const Maybe AddressType
forall a. Maybe a
Nothing,
                          cmSnocket :: Snocket m ntcFd ntcAddr
cmSnocket             = Snocket m ntcFd ntcAddr
diNtcSnocket,
                          cmTimeWaitTimeout :: DiffTime
cmTimeWaitTimeout     = DiffTime
local_TIME_WAIT_TIMEOUT,
                          cmOutboundIdleTimeout :: DiffTime
cmOutboundIdleTimeout = DiffTime
local_PROTOCOL_IDLE_TIMEOUT,
                          connectionDataFlow :: (ntcVersion, ntcVersionData) -> DataFlow
connectionDataFlow    = (ntcVersion -> ntcVersionData -> DataFlow)
-> (ntcVersion, ntcVersionData) -> DataFlow
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ntcVersion -> ntcVersionData -> DataFlow
forall ntcVersion ntcVersionData.
ntcVersion -> ntcVersionData -> DataFlow
localDataFlow,
                          cmPrunePolicy :: PrunePolicy ntcAddr (STM m)
cmPrunePolicy         = StrictTVar m InboundGovernorObservableState
-> PrunePolicy ntcAddr (STM m)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m InboundGovernorObservableState
-> PrunePolicy peerAddr (STM m)
Diffusion.Policies.prunePolicy
                                                    StrictTVar m InboundGovernorObservableState
localServerStateVar,
                          cmConnectionsLimits :: AcceptedConnectionsLimit
cmConnectionsLimits   = AcceptedConnectionsLimit
localConnectionLimits
                        }

                NodeToClientConnectionManagerArguments
  ntcFd ntcAddr ntcVersion ntcVersionData m
-> NodeToClientConnectionHandler
     ntcFd ntcAddr ntcVersion ntcVersionData m
-> (NodeToClientHandleError ntcVersion -> HandleErrorType)
-> InResponderMode
     'ResponderMode
     (ControlChannel
        m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m)))
-> (ConnectionManager
      'ResponderMode
      ntcFd
      ntcAddr
      (NodeToClientHandle ntcAddr m)
      (NodeToClientHandleError ntcVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: MuxMode) peerAddr socket handlerTrace handle
       handleError version (m :: * -> *) a.
(Monad m, MonadLabelledSTM m, MonadTraceSTM m, MonadFork m,
 MonadAsync m, MonadEvaluate m, MonadFix m, MonadMask m,
 MonadMonotonicTime m, MonadThrow (STM m), MonadTimer m,
 Ord peerAddr, Show peerAddr, Typeable peerAddr) =>
ConnectionManagerArguments
  handlerTrace socket peerAddr handle handleError version m
-> ConnectionHandler
     muxMode handlerTrace socket peerAddr handle handleError version m
-> (handleError -> HandleErrorType)
-> InResponderMode
     muxMode (ControlChannel m (NewConnection peerAddr handle))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m a)
-> m a
withConnectionManager
                  NodeToClientConnectionManagerArguments
  ntcFd ntcAddr ntcVersion ntcVersionData m
localConnectionManagerArguments
                  NodeToClientConnectionHandler
  ntcFd ntcAddr ntcVersion ntcVersionData m
localConnectionHandler
                  NodeToClientHandleError ntcVersion -> HandleErrorType
forall (muxMode :: MuxMode) versionNumber.
HandleError muxMode versionNumber -> HandleErrorType
classifyHandleError
                  (ControlChannel
  m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m))
-> InResponderMode
     'ResponderMode
     (ControlChannel
        m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m)))
forall (mode :: MuxMode) a.
(HasResponder mode ~ 'True) =>
a -> InResponderMode mode a
InResponderMode ControlChannel
  m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m))
localControlChannel)
                  ((ConnectionManager
    'ResponderMode
    ntcFd
    ntcAddr
    (NodeToClientHandle ntcAddr m)
    (NodeToClientHandleError ntcVersion)
    m
  -> m Void)
 -> m Void)
-> (ConnectionManager
      'ResponderMode
      ntcFd
      ntcAddr
      (NodeToClientHandle ntcAddr m)
      (NodeToClientHandleError ntcVersion)
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \(ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr m)
  (NodeToClientHandleError ntcVersion)
  m
localConnectionManager :: NodeToClientConnectionManager
                                                  ntcFd ntcAddr ntcVersion
                                                  ntcVersionData m)
                    -> do

                  --
                  -- run local server
                  --

                  Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> (ntcAddr -> InitializationTracer ntnAddr ntcAddr)
-> ntcAddr
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ntcAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer 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

                  m Void -> (Async m Void -> m Void) -> m Void
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                    (ServerArguments
  'ResponderMode ntcFd ntcAddr ntcVersion ByteString m Void ()
-> m Void
forall (muxMode :: MuxMode) socket peerAddr versionNumber
       (m :: * -> *) a b.
(MonadAsync m, MonadCatch m, MonadEvaluate m, MonadLabelledSTM m,
 MonadMask m, MonadThrow (STM m), MonadTime m, MonadTimer m,
 HasResponder muxMode ~ 'True, Ord peerAddr, Show peerAddr) =>
ServerArguments
  muxMode socket peerAddr versionNumber ByteString m a b
-> m Void
Server.run
                      ServerArguments :: forall (muxMode :: MuxMode) socket peerAddr versionNumber bytes
       (m :: * -> *) a b.
NonEmpty socket
-> Snocket m socket peerAddr
-> Tracer m (ServerTrace peerAddr)
-> Tracer m (RemoteTransitionTrace peerAddr)
-> Tracer m (InboundGovernorTrace peerAddr)
-> AcceptedConnectionsLimit
-> MuxConnectionManager
     muxMode socket peerAddr versionNumber bytes m a b
-> DiffTime
-> ServerControlChannel muxMode peerAddr bytes m a b
-> StrictTVar m InboundGovernorObservableState
-> ServerArguments
     muxMode socket peerAddr versionNumber bytes m a b
ServerArguments {
                          serverSockets :: NonEmpty ntcFd
serverSockets               = ntcFd
localSocket ntcFd -> [ntcFd] -> NonEmpty ntcFd
forall a. a -> [a] -> NonEmpty a
:| [],
                          serverSnocket :: Snocket m ntcFd ntcAddr
serverSnocket               = Snocket m ntcFd ntcAddr
diNtcSnocket,
                          serverTracer :: Tracer m (ServerTrace ntcAddr)
serverTracer                = Tracer m (ServerTrace ntcAddr)
dtLocalServerTracer,
                          serverTrTracer :: Tracer m (RemoteTransitionTrace ntcAddr)
serverTrTracer              = Tracer m (RemoteTransitionTrace ntcAddr)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer, -- TODO: issue #3320
                          serverInboundGovernorTracer :: Tracer m (InboundGovernorTrace ntcAddr)
serverInboundGovernorTracer = Tracer m (InboundGovernorTrace ntcAddr)
dtLocalInboundGovernorTracer,
                          serverInboundIdleTimeout :: DiffTime
serverInboundIdleTimeout    = DiffTime
local_PROTOCOL_IDLE_TIMEOUT,
                          serverConnectionLimits :: AcceptedConnectionsLimit
serverConnectionLimits      = AcceptedConnectionsLimit
localConnectionLimits,
                          serverConnectionManager :: ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr m)
  (NodeToClientHandleError ntcVersion)
  m
serverConnectionManager     = ConnectionManager
  'ResponderMode
  ntcFd
  ntcAddr
  (NodeToClientHandle ntcAddr m)
  (NodeToClientHandleError ntcVersion)
  m
localConnectionManager,
                          serverControlChannel :: ControlChannel
  m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m))
serverControlChannel        = ControlChannel
  m (NewConnection ntcAddr (NodeToClientHandle ntcAddr m))
localControlChannel,
                          serverObservableStateVar :: StrictTVar m InboundGovernorObservableState
serverObservableStateVar    = StrictTVar m InboundGovernorObservableState
localServerStateVar
                        }) Async m Void -> m Void
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
Async.wait

        --
        -- remote connection manager
        --

        remoteThread :: m Void
        remoteThread :: m Void
remoteThread =
          StdGen
-> (IP -> PortNumber -> ntnAddr)
-> Tracer m TraceLedgerPeers
-> STM m UseLedgerAfter
-> LedgerPeersConsensusInterface m
-> ([DomainAccessPoint] -> m (Map DomainAccessPoint (Set ntnAddr)))
-> ((NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime)))
    -> Async m Void -> m Void)
-> m Void
forall peerAddr (m :: * -> *) a.
(MonadAsync m, MonadTime m, Ord peerAddr) =>
StdGen
-> (IP -> PortNumber -> peerAddr)
-> Tracer m TraceLedgerPeers
-> STM m UseLedgerAfter
-> LedgerPeersConsensusInterface m
-> ([DomainAccessPoint]
    -> m (Map DomainAccessPoint (Set peerAddr)))
-> ((NumberOfPeers -> m (Maybe (Set peerAddr, DiffTime)))
    -> Async m Void -> m a)
-> m a
withLedgerPeers
            StdGen
ledgerPeersRng
            IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
            Tracer m TraceLedgerPeers
dtLedgerPeersTracer
            STM m UseLedgerAfter
daReadUseLedgerAfter
            LedgerPeersConsensusInterface m
daLedgerPeersCtx
            (LookupReqs
-> [DomainAccessPoint] -> m (Map DomainAccessPoint (Set ntnAddr))
diNtnDomainResolver LookupReqs
lookupReqs)
            (((NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime)))
  -> Async m Void -> m Void)
 -> m Void)
-> ((NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime)))
    -> Async m Void -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime))
requestLedgerPeers Async m Void
ledgerPeerThread ->
            case HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
cmdInMode of
              -- InitiatorOnlyMode
              --
              -- Run peer selection only
              HasInitiator ConnectionManagerDataInMode ntnAddr m 'InitiatorMode
CMDInInitiatorMode -> do
                let connectionManagerArguments
                      :: NodeToNodeConnectionManagerArguments
                           InitiatorMode
                           ntnFd ntnAddr ntnVersion ntnVersionData
                           m Void
                    connectionManagerArguments :: NodeToNodeConnectionManagerArguments
  'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
connectionManagerArguments =
                      ConnectionManagerArguments :: forall handlerTrace socket peerAddr handle handleError version
       (m :: * -> *).
Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
-> Tracer
     m
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m))
-> Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
-> Maybe peerAddr
-> Maybe peerAddr
-> (peerAddr -> Maybe AddressType)
-> Snocket m socket peerAddr
-> DiffTime
-> DiffTime
-> (version -> DataFlow)
-> PrunePolicy peerAddr (STM m)
-> AcceptedConnectionsLimit
-> ConnectionManagerArguments
     handlerTrace socket peerAddr handle handleError version m
ConnectionManagerArguments {
                          cmTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
cmTracer              = Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer,
                          cmTrTracer :: Tracer
  m
  (TransitionTrace
     ntnAddr
     (ConnectionState
        ntnAddr
        (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
        (HandleError 'InitiatorMode ntnVersion)
        (ntnVersion, ntnVersionData)
        m))
cmTrTracer            =
                            (MaybeUnknown
   (ConnectionState
      ntnAddr
      (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
      (HandleError 'InitiatorMode ntnVersion)
      (ntnVersion, ntnVersionData)
      m)
 -> AbstractState)
-> TransitionTrace
     ntnAddr
     (ConnectionState
        ntnAddr
        (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
        (HandleError 'InitiatorMode ntnVersion)
        (ntnVersion, ntnVersionData)
        m)
-> AbstractTransitionTrace ntnAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeUnknown
  (ConnectionState
     ntnAddr
     (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
     (HandleError 'InitiatorMode ntnVersion)
     (ntnVersion, ntnVersionData)
     m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState
                            (TransitionTrace
   ntnAddr
   (ConnectionState
      ntnAddr
      (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
      (HandleError 'InitiatorMode ntnVersion)
      (ntnVersion, ntnVersionData)
      m)
 -> AbstractTransitionTrace ntnAddr)
-> Tracer m (AbstractTransitionTrace ntnAddr)
-> Tracer
     m
     (TransitionTrace
        ntnAddr
        (ConnectionState
           ntnAddr
           (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
           (HandleError 'InitiatorMode ntnVersion)
           (ntnVersion, ntnVersionData)
           m))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer,
                          cmMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
cmMuxTracer           = Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer,
                          Maybe ntnAddr
cmIPv4Address :: Maybe ntnAddr
cmIPv4Address :: Maybe ntnAddr
cmIPv4Address,
                          Maybe ntnAddr
cmIPv6Address :: Maybe ntnAddr
cmIPv6Address :: Maybe ntnAddr
cmIPv6Address,
                          cmAddressType :: ntnAddr -> Maybe AddressType
cmAddressType         = ntnAddr -> Maybe AddressType
diNtnAddressType,
                          cmSnocket :: Snocket m ntnFd ntnAddr
cmSnocket             = Snocket m ntnFd ntnAddr
diNtnSnocket,
                          connectionDataFlow :: (ntnVersion, ntnVersionData) -> DataFlow
connectionDataFlow    = (ntnVersion -> ntnVersionData -> DataFlow)
-> (ntnVersion, ntnVersionData) -> DataFlow
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ntnVersion -> ntnVersionData -> DataFlow
diNtnDataFlow,
                          cmPrunePolicy :: PrunePolicy ntnAddr (STM m)
cmPrunePolicy         =
                            case HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
cmdInMode of
                              HasInitiator ConnectionManagerDataInMode ntnAddr m 'InitiatorMode
CMDInInitiatorMode ->
                                -- 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'.
                                PrunePolicy ntnAddr (STM m)
forall (stm :: * -> *) peerAddr.
(Applicative stm, Ord peerAddr) =>
PrunePolicy peerAddr stm
simplePrunePolicy,
                          cmConnectionsLimits :: AcceptedConnectionsLimit
cmConnectionsLimits   = AcceptedConnectionsLimit
daAcceptedConnectionsLimit,
                          cmTimeWaitTimeout :: DiffTime
cmTimeWaitTimeout     = DiffTime
daTimeWaitTimeout,
                          cmOutboundIdleTimeout :: DiffTime
cmOutboundIdleTimeout = DiffTime
daProtocolIdleTimeout
                        }

                    connectionHandler
                      :: NodeToNodeConnectionHandler
                           InitiatorMode
                           ntnFd ntnAddr ntnVersion ntnVersionData
                           m Void
                    connectionHandler :: NodeToNodeConnectionHandler
  'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
connectionHandler =
                      Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
-> SingMuxMode 'InitiatorMode
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
-> (ThreadId m, RethrowPolicy)
-> NodeToNodeConnectionHandler
     'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
forall peerAddr (muxMode :: MuxMode) socket versionNumber
       versionData (m :: * -> *) a b.
(MonadAsync m, MonadCatch m, MonadFork m, MonadLabelledSTM m,
 MonadThrow (STM m), MonadTime m, MonadTimer m, MonadMask m,
 Ord versionNumber, Show peerAddr, Typeable peerAddr) =>
Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
-> SingMuxMode muxMode
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle muxMode peerAddr ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode socket peerAddr versionNumber versionData ByteString m a b
makeConnectionHandler
                        Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer
                        SingMuxMode 'InitiatorMode
SingInitiatorMode
                        HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments
                        Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
daApplicationInitiatorMode
                        (ThreadId m
mainThreadId, RethrowPolicy
rethrowPolicy RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<> RethrowPolicy
daRethrowPolicy)

                NodeToNodeConnectionManagerArguments
  'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
-> NodeToNodeConnectionHandler
     'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
-> (HandleError 'InitiatorMode ntnVersion -> HandleErrorType)
-> InResponderMode
     'InitiatorMode
     (ControlChannel
        m
        (NewConnection
           ntnAddr (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)))
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
      (HandleError 'InitiatorMode ntnVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: MuxMode) peerAddr socket handlerTrace handle
       handleError version (m :: * -> *) a.
(Monad m, MonadLabelledSTM m, MonadTraceSTM m, MonadFork m,
 MonadAsync m, MonadEvaluate m, MonadFix m, MonadMask m,
 MonadMonotonicTime m, MonadThrow (STM m), MonadTimer m,
 Ord peerAddr, Show peerAddr, Typeable peerAddr) =>
ConnectionManagerArguments
  handlerTrace socket peerAddr handle handleError version m
-> ConnectionHandler
     muxMode handlerTrace socket peerAddr handle handleError version m
-> (handleError -> HandleErrorType)
-> InResponderMode
     muxMode (ControlChannel m (NewConnection peerAddr handle))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m a)
-> m a
withConnectionManager
                  NodeToNodeConnectionManagerArguments
  'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
connectionManagerArguments
                  NodeToNodeConnectionHandler
  'InitiatorMode ntnFd ntnAddr ntnVersion ntnVersionData m Void
connectionHandler
                  HandleError 'InitiatorMode ntnVersion -> HandleErrorType
forall (muxMode :: MuxMode) versionNumber.
HandleError muxMode versionNumber -> HandleErrorType
classifyHandleError
                  InResponderMode
  'InitiatorMode
  (ControlChannel
     m
     (NewConnection
        ntnAddr (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)))
forall (mode :: MuxMode) a. InResponderMode mode a
NotInResponderMode
                  ((ConnectionManager
    'InitiatorMode
    ntnFd
    ntnAddr
    (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
    (HandleError 'InitiatorMode ntnVersion)
    m
  -> m Void)
 -> m Void)
-> (ConnectionManager
      'InitiatorMode
      ntnFd
      ntnAddr
      (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
      (HandleError 'InitiatorMode ntnVersion)
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \(ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
connectionManager
                      :: NodeToNodeConnectionManager
                           InitiatorMode ntnFd ntnAddr ntnVersion m Void)
                    -> do
                  ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
-> m ()
forall (mode :: MuxMode) x.
NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersion m x
-> m ()
diInstallSigUSR1Handler ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
connectionManager

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

                  PeerStateActionsArguments
  'InitiatorMode ntnFd ntnAddr ntnVersion m () Void
-> (PeerStateActions
      ntnAddr
      (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
      m
    -> m Void)
-> m Void
forall (muxMode :: MuxMode) socket peerAddr versionNumber
       (m :: * -> *) a b x.
(MonadAsync m, MonadCatch m, MonadLabelledSTM m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), HasInitiator muxMode ~ 'True,
 Typeable versionNumber, Show versionNumber, Ord peerAddr,
 Typeable peerAddr, Show peerAddr) =>
PeerStateActionsArguments
  muxMode socket peerAddr versionNumber m a b
-> (PeerStateActions
      peerAddr (PeerConnectionHandle muxMode peerAddr ByteString m a b) m
    -> m x)
-> m x
withPeerStateActions
                    PeerStateActionsArguments :: forall (muxMode :: MuxMode) socket peerAddr versionNumber
       (m :: * -> *) a b.
Tracer m (PeerSelectionActionsTrace peerAddr)
-> DiffTime
-> DiffTime
-> MuxConnectionManager
     muxMode socket peerAddr versionNumber ByteString m a b
-> PeerStateActionsArguments
     muxMode socket peerAddr versionNumber m a b
PeerStateActionsArguments {
                        spsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr)
spsTracer = Tracer m (PeerSelectionActionsTrace ntnAddr)
dtPeerSelectionActionsTracer,
                        spsDeactivateTimeout :: DiffTime
spsDeactivateTimeout = DiffTime
Diffusion.Policies.deactivateTimeout,
                        spsCloseConnectionTimeout :: DiffTime
spsCloseConnectionTimeout =
                          DiffTime
Diffusion.Policies.closeConnectionTimeout,
                        spsConnectionManager :: ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
spsConnectionManager = ConnectionManager
  'InitiatorMode
  ntnFd
  ntnAddr
  (NodeToNodeHandle 'InitiatorMode ntnAddr m Void)
  (HandleError 'InitiatorMode ntnVersion)
  m
connectionManager
                      }
                    ((PeerStateActions
    ntnAddr
    (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
    m
  -> m Void)
 -> m Void)
-> (PeerStateActions
      ntnAddr
      (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \(PeerStateActions
  ntnAddr
  (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
  m
peerStateActions
                          :: NodeToNodePeerStateActions InitiatorMode ntnAddr m Void) ->
                    --
                    -- Run peer selection (p2p governor)
                    --

                    Tracer m (TraceLocalRootPeers ntnAddr resolverError)
-> Tracer m TracePublicRootPeers
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions resolver resolverError m
-> STM m PeerSelectionTargets
-> STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
-> STM m [RelayAccessPoint]
-> PeerStateActions
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
     m
-> (NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime)))
-> (Maybe (Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
         m
    -> m Void)
-> m Void
forall peeraddr peerconn resolver exception (m :: * -> *) a.
(MonadAsync m, MonadDelay m, MonadThrow m, Ord peeraddr,
 Exception exception, Eq (Async m Void)) =>
Tracer m (TraceLocalRootPeers peeraddr exception)
-> Tracer m TracePublicRootPeers
-> (IP -> PortNumber -> peeraddr)
-> DNSActions resolver exception m
-> STM m PeerSelectionTargets
-> STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
-> STM m [RelayAccessPoint]
-> PeerStateActions peeraddr peerconn m
-> (NumberOfPeers -> m (Maybe (Set peeraddr, DiffTime)))
-> (Maybe (Async m Void)
    -> PeerSelectionActions peeraddr peerconn m -> m a)
-> m a
withPeerSelectionActions
                      Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer
                      Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
                      IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
                      (LookupReqs -> DNSActions resolver resolverError m
diDnsActions LookupReqs
lookupReqs)
                      (StrictTVar m PeerSelectionTargets -> STM m PeerSelectionTargets
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar)
                      STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
daReadLocalRootPeers
                      STM m [RelayAccessPoint]
daReadPublicRootPeers
                      PeerStateActions
  ntnAddr
  (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
  m
peerStateActions
                      NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime))
requestLedgerPeers
                      ((Maybe (Async m Void)
  -> PeerSelectionActions
       ntnAddr
       (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
       m
  -> m Void)
 -> m Void)
-> (Maybe (Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
         m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \Maybe (Async m Void)
mbLocalPeerSelectionActionsThread
                        (PeerSelectionActions
  ntnAddr
  (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
  m
peerSelectionActions
                           :: NodeToNodePeerSelectionActions
                                InitiatorMode ntnAddr m Void) ->

                      m Void -> (Async m Void -> m Void) -> m Void
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                      (Tracer m (TracePeerSelection ntnAddr)
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
-> Tracer m PeerSelectionCounters
-> StdGen
-> PeerSelectionActions
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
     m
-> PeerSelectionPolicy ntnAddr m
-> m Void
forall (m :: * -> *) peeraddr peerconn.
(MonadAsync m, MonadLabelledSTM m, MonadMask m, MonadTime m,
 MonadTimer m, Ord peeraddr) =>
Tracer m (TracePeerSelection peeraddr)
-> Tracer m (DebugPeerSelection peeraddr peerconn)
-> Tracer m PeerSelectionCounters
-> StdGen
-> PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> m Void
Governor.peerSelectionGovernor
                      Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
                      Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void))
dtDebugPeerSelectionInitiatorTracer
                      Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
                      StdGen
fuzzRng
                      PeerSelectionActions
  ntnAddr
  (PeerConnectionHandle 'InitiatorMode ntnAddr ByteString m () Void)
  m
peerSelectionActions
                      (StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m ntnAddr
-> PeerSelectionPolicy ntnAddr m
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m peerAddr
-> PeerSelectionPolicy peerAddr m
Diffusion.Policies.simplePeerSelectionPolicy
                      StrictTVar m StdGen
policyRngVar (StrictTVar m ChurnMode -> STM m ChurnMode
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m ChurnMode
churnModeVar) PeerMetrics m ntnAddr
daPeerMetrics))
                      ((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 (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                        (Tracer m (TracePeerSelection ntnAddr)
-> PeerMetrics m ntnAddr
-> StrictTVar m ChurnMode
-> StdGen
-> STM m FetchMode
-> PeerSelectionTargets
-> StrictTVar m PeerSelectionTargets
-> m Void
forall (m :: * -> *) peeraddr.
(MonadSTM m, MonadMonotonicTime m, MonadDelay m) =>
Tracer m (TracePeerSelection peeraddr)
-> PeerMetrics m peeraddr
-> StrictTVar m ChurnMode
-> StdGen
-> STM m FetchMode
-> PeerSelectionTargets
-> StrictTVar m PeerSelectionTargets
-> m Void
Governor.peerChurnGovernor
                        Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
                        PeerMetrics m ntnAddr
daPeerMetrics
                        StrictTVar m ChurnMode
churnModeVar
                        StdGen
churnRng
                        STM m FetchMode
daBlockFetchMode
                        PeerSelectionTargets
daPeerSelectionTargets
                        StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar)
                        ((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 (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
Async.waitAny
                              (Maybe (Async m Void) -> [Async m Void]
forall a. Maybe a -> [a]
maybeToList Maybe (Async m Void)
mbLocalPeerSelectionActionsThread
                              [Async m Void] -> [Async m Void] -> [Async m Void]
forall a. [a] -> [a] -> [a]
++ [ Async m Void
governorThread
                                 , Async m Void
ledgerPeerThread
                                 , Async m Void
churnGovernorThread
                                 ])


              -- InitiatorResponderMode
              --
              -- Run peer selection and the server.
              --
              HasInitiatorResponder
                (CMDInInitiatorResponderMode ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
controlChannel StrictTVar m InboundGovernorObservableState
observableStateVar) -> do
                let connectionManagerArguments
                      :: NodeToNodeConnectionManagerArguments
                          InitiatorResponderMode
                          ntnFd ntnAddr ntnVersion ntnVersionData
                          m ()
                    connectionManagerArguments :: NodeToNodeConnectionManagerArguments
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  m
  ()
connectionManagerArguments =
                      ConnectionManagerArguments :: forall handlerTrace socket peerAddr handle handleError version
       (m :: * -> *).
Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
-> Tracer
     m
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m))
-> Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
-> Maybe peerAddr
-> Maybe peerAddr
-> (peerAddr -> Maybe AddressType)
-> Snocket m socket peerAddr
-> DiffTime
-> DiffTime
-> (version -> DataFlow)
-> PrunePolicy peerAddr (STM m)
-> AcceptedConnectionsLimit
-> ConnectionManagerArguments
     handlerTrace socket peerAddr handle handleError version m
ConnectionManagerArguments {
                          cmTracer :: Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
cmTracer              = Tracer
  m
  (ConnectionManagerTrace
     ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer,
                          cmTrTracer :: Tracer
  m
  (TransitionTrace
     ntnAddr
     (ConnectionState
        ntnAddr
        (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
        (HandleError 'InitiatorResponderMode ntnVersion)
        (ntnVersion, ntnVersionData)
        m))
cmTrTracer            =
                            (MaybeUnknown
   (ConnectionState
      ntnAddr
      (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
      (HandleError 'InitiatorResponderMode ntnVersion)
      (ntnVersion, ntnVersionData)
      m)
 -> AbstractState)
-> TransitionTrace
     ntnAddr
     (ConnectionState
        ntnAddr
        (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
        (HandleError 'InitiatorResponderMode ntnVersion)
        (ntnVersion, ntnVersionData)
        m)
-> AbstractTransitionTrace ntnAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeUnknown
  (ConnectionState
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
     (HandleError 'InitiatorResponderMode ntnVersion)
     (ntnVersion, ntnVersionData)
     m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState
                            (TransitionTrace
   ntnAddr
   (ConnectionState
      ntnAddr
      (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
      (HandleError 'InitiatorResponderMode ntnVersion)
      (ntnVersion, ntnVersionData)
      m)
 -> AbstractTransitionTrace ntnAddr)
-> Tracer m (AbstractTransitionTrace ntnAddr)
-> Tracer
     m
     (TransitionTrace
        ntnAddr
        (ConnectionState
           ntnAddr
           (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
           (HandleError 'InitiatorResponderMode ntnVersion)
           (ntnVersion, ntnVersionData)
           m))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer m (AbstractTransitionTrace ntnAddr)
dtConnectionManagerTransitionTracer,
                          cmMuxTracer :: Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
cmMuxTracer           = Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer,
                          Maybe ntnAddr
cmIPv4Address :: Maybe ntnAddr
cmIPv4Address :: Maybe ntnAddr
cmIPv4Address,
                          Maybe ntnAddr
cmIPv6Address :: Maybe ntnAddr
cmIPv6Address :: Maybe ntnAddr
cmIPv6Address,
                          cmAddressType :: ntnAddr -> Maybe AddressType
cmAddressType         = ntnAddr -> Maybe AddressType
diNtnAddressType,
                          cmSnocket :: Snocket m ntnFd ntnAddr
cmSnocket             = Snocket m ntnFd ntnAddr
diNtnSnocket,
                          connectionDataFlow :: (ntnVersion, ntnVersionData) -> DataFlow
connectionDataFlow    = (ntnVersion -> ntnVersionData -> DataFlow)
-> (ntnVersion, ntnVersionData) -> DataFlow
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ntnVersion -> ntnVersionData -> DataFlow
diNtnDataFlow,
                          cmPrunePolicy :: PrunePolicy ntnAddr (STM m)
cmPrunePolicy         =
                            case HasMuxMode (ConnectionManagerDataInMode ntnAddr m)
cmdInMode of
                              HasInitiatorResponder (CMDInInitiatorResponderMode ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
_ StrictTVar m InboundGovernorObservableState
serverStateVar) ->
                                StrictTVar m InboundGovernorObservableState
-> PrunePolicy ntnAddr (STM m)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m InboundGovernorObservableState
-> PrunePolicy peerAddr (STM m)
Diffusion.Policies.prunePolicy StrictTVar m InboundGovernorObservableState
serverStateVar,
                          cmConnectionsLimits :: AcceptedConnectionsLimit
cmConnectionsLimits   = AcceptedConnectionsLimit
daAcceptedConnectionsLimit,
                          cmTimeWaitTimeout :: DiffTime
cmTimeWaitTimeout     = DiffTime
daTimeWaitTimeout,
                          cmOutboundIdleTimeout :: DiffTime
cmOutboundIdleTimeout = DiffTime
daProtocolIdleTimeout
                        }

                    connectionHandler
                      :: NodeToNodeConnectionHandler
                          InitiatorResponderMode
                          ntnFd ntnAddr ntnVersion ntnVersionData
                          m ()
                    connectionHandler :: NodeToNodeConnectionHandler
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  m
  ()
connectionHandler =
                      Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
-> SingMuxMode 'InitiatorResponderMode
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        'InitiatorResponderMode ntnAddr ByteString m () ())
-> (ThreadId m, RethrowPolicy)
-> NodeToNodeConnectionHandler
     'InitiatorResponderMode
     ntnFd
     ntnAddr
     ntnVersion
     ntnVersionData
     m
     ()
forall peerAddr (muxMode :: MuxMode) socket versionNumber
       versionData (m :: * -> *) a b.
(MonadAsync m, MonadCatch m, MonadFork m, MonadLabelledSTM m,
 MonadThrow (STM m), MonadTime m, MonadTimer m, MonadMask m,
 Ord versionNumber, Show peerAddr, Typeable peerAddr) =>
Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
-> SingMuxMode muxMode
-> HandshakeArguments
     (ConnectionId peerAddr) versionNumber versionData m
-> Versions
     versionNumber
     versionData
     (OuroborosBundle muxMode peerAddr ByteString m a b)
-> (ThreadId m, RethrowPolicy)
-> MuxConnectionHandler
     muxMode socket peerAddr versionNumber versionData ByteString m a b
makeConnectionHandler
                         Tracer m (WithMuxBearer (ConnectionId ntnAddr) MuxTrace)
dtMuxTracer
                         SingMuxMode 'InitiatorResponderMode
SingInitiatorResponderMode
                         HandshakeArguments
  (ConnectionId ntnAddr) ntnVersion ntnVersionData m
diNtnHandshakeArguments
                         Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle
     'InitiatorResponderMode ntnAddr ByteString m () ())
daApplicationInitiatorResponderMode
                         (ThreadId m
mainThreadId, RethrowPolicy
rethrowPolicy RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<> RethrowPolicy
daRethrowPolicy)

                NodeToNodeConnectionManagerArguments
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  m
  ()
-> NodeToNodeConnectionHandler
     'InitiatorResponderMode
     ntnFd
     ntnAddr
     ntnVersion
     ntnVersionData
     m
     ()
-> (HandleError 'InitiatorResponderMode ntnVersion
    -> HandleErrorType)
-> InResponderMode
     'InitiatorResponderMode
     (ControlChannel
        m
        (NewConnection
           ntnAddr
           (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())))
-> (ConnectionManager
      'InitiatorResponderMode
      ntnFd
      ntnAddr
      (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
      (HandleError 'InitiatorResponderMode ntnVersion)
      m
    -> m Void)
-> m Void
forall (muxMode :: MuxMode) peerAddr socket handlerTrace handle
       handleError version (m :: * -> *) a.
(Monad m, MonadLabelledSTM m, MonadTraceSTM m, MonadFork m,
 MonadAsync m, MonadEvaluate m, MonadFix m, MonadMask m,
 MonadMonotonicTime m, MonadThrow (STM m), MonadTimer m,
 Ord peerAddr, Show peerAddr, Typeable peerAddr) =>
ConnectionManagerArguments
  handlerTrace socket peerAddr handle handleError version m
-> ConnectionHandler
     muxMode handlerTrace socket peerAddr handle handleError version m
-> (handleError -> HandleErrorType)
-> InResponderMode
     muxMode (ControlChannel m (NewConnection peerAddr handle))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m a)
-> m a
withConnectionManager
                  NodeToNodeConnectionManagerArguments
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  m
  ()
connectionManagerArguments
                  NodeToNodeConnectionHandler
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  m
  ()
connectionHandler
                  HandleError 'InitiatorResponderMode ntnVersion -> HandleErrorType
forall (muxMode :: MuxMode) versionNumber.
HandleError muxMode versionNumber -> HandleErrorType
classifyHandleError
                  (ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
-> InResponderMode
     'InitiatorResponderMode
     (ControlChannel
        m
        (NewConnection
           ntnAddr
           (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())))
forall (mode :: MuxMode) a.
(HasResponder mode ~ 'True) =>
a -> InResponderMode mode a
InResponderMode ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
controlChannel)
                  ((ConnectionManager
    'InitiatorResponderMode
    ntnFd
    ntnAddr
    (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
    (HandleError 'InitiatorResponderMode ntnVersion)
    m
  -> m Void)
 -> m Void)
-> (ConnectionManager
      'InitiatorResponderMode
      ntnFd
      ntnAddr
      (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
      (HandleError 'InitiatorResponderMode ntnVersion)
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \(ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager
                        :: NodeToNodeConnectionManager
                             InitiatorResponderMode ntnFd ntnAddr ntnVersion m ()
                     ) -> do
                  ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
-> m ()
forall (mode :: MuxMode) x.
NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersion m x
-> m ()
diInstallSigUSR1Handler ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager
                  --
                  -- peer state actions
                  --
                  -- Peer state actions run a job pool in the background which
                  -- tracks threads forked by 'PeerStateActions'
                  --

                  PeerStateActionsArguments
  'InitiatorResponderMode ntnFd ntnAddr ntnVersion m () ()
-> (PeerStateActions
      ntnAddr
      (PeerConnectionHandle
         'InitiatorResponderMode ntnAddr ByteString m () ())
      m
    -> m Void)
-> m Void
forall (muxMode :: MuxMode) socket peerAddr versionNumber
       (m :: * -> *) a b x.
(MonadAsync m, MonadCatch m, MonadLabelledSTM m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), HasInitiator muxMode ~ 'True,
 Typeable versionNumber, Show versionNumber, Ord peerAddr,
 Typeable peerAddr, Show peerAddr) =>
PeerStateActionsArguments
  muxMode socket peerAddr versionNumber m a b
-> (PeerStateActions
      peerAddr (PeerConnectionHandle muxMode peerAddr ByteString m a b) m
    -> m x)
-> m x
withPeerStateActions
                    PeerStateActionsArguments :: forall (muxMode :: MuxMode) socket peerAddr versionNumber
       (m :: * -> *) a b.
Tracer m (PeerSelectionActionsTrace peerAddr)
-> DiffTime
-> DiffTime
-> MuxConnectionManager
     muxMode socket peerAddr versionNumber ByteString m a b
-> PeerStateActionsArguments
     muxMode socket peerAddr versionNumber m a b
PeerStateActionsArguments {
                        spsTracer :: Tracer m (PeerSelectionActionsTrace ntnAddr)
spsTracer = Tracer m (PeerSelectionActionsTrace ntnAddr)
dtPeerSelectionActionsTracer,
                        spsDeactivateTimeout :: DiffTime
spsDeactivateTimeout = DiffTime
Diffusion.Policies.deactivateTimeout,
                        spsCloseConnectionTimeout :: DiffTime
spsCloseConnectionTimeout =
                          DiffTime
Diffusion.Policies.closeConnectionTimeout,
                        spsConnectionManager :: ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
spsConnectionManager = ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager
                      }
                    ((PeerStateActions
    ntnAddr
    (PeerConnectionHandle
       'InitiatorResponderMode ntnAddr ByteString m () ())
    m
  -> m Void)
 -> m Void)
-> (PeerStateActions
      ntnAddr
      (PeerConnectionHandle
         'InitiatorResponderMode ntnAddr ByteString m () ())
      m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \(PeerStateActions
  ntnAddr
  (PeerConnectionHandle
     'InitiatorResponderMode ntnAddr ByteString m () ())
  m
peerStateActions
                          :: NodeToNodePeerStateActions
                               InitiatorResponderMode ntnAddr m ()) ->

                    --
                    -- Run peer selection (p2p governor)
                    --

                    Tracer m (TraceLocalRootPeers ntnAddr resolverError)
-> Tracer m TracePublicRootPeers
-> (IP -> PortNumber -> ntnAddr)
-> DNSActions resolver resolverError m
-> STM m PeerSelectionTargets
-> STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
-> STM m [RelayAccessPoint]
-> PeerStateActions
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ())
     m
-> (NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime)))
-> (Maybe (Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle
            'InitiatorResponderMode ntnAddr ByteString m () ())
         m
    -> m Void)
-> m Void
forall peeraddr peerconn resolver exception (m :: * -> *) a.
(MonadAsync m, MonadDelay m, MonadThrow m, Ord peeraddr,
 Exception exception, Eq (Async m Void)) =>
Tracer m (TraceLocalRootPeers peeraddr exception)
-> Tracer m TracePublicRootPeers
-> (IP -> PortNumber -> peeraddr)
-> DNSActions resolver exception m
-> STM m PeerSelectionTargets
-> STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
-> STM m [RelayAccessPoint]
-> PeerStateActions peeraddr peerconn m
-> (NumberOfPeers -> m (Maybe (Set peeraddr, DiffTime)))
-> (Maybe (Async m Void)
    -> PeerSelectionActions peeraddr peerconn m -> m a)
-> m a
withPeerSelectionActions
                      Tracer m (TraceLocalRootPeers ntnAddr resolverError)
dtTraceLocalRootPeersTracer
                      Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer
                      IP -> PortNumber -> ntnAddr
diNtnToPeerAddr
                      (LookupReqs -> DNSActions resolver resolverError m
diDnsActions LookupReqs
lookupReqs)
                      (StrictTVar m PeerSelectionTargets -> STM m PeerSelectionTargets
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar)
                      STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
daReadLocalRootPeers
                      STM m [RelayAccessPoint]
daReadPublicRootPeers
                      PeerStateActions
  ntnAddr
  (PeerConnectionHandle
     'InitiatorResponderMode ntnAddr ByteString m () ())
  m
peerStateActions
                      NumberOfPeers -> m (Maybe (Set ntnAddr, DiffTime))
requestLedgerPeers
                      ((Maybe (Async m Void)
  -> PeerSelectionActions
       ntnAddr
       (PeerConnectionHandle
          'InitiatorResponderMode ntnAddr ByteString m () ())
       m
  -> m Void)
 -> m Void)
-> (Maybe (Async m Void)
    -> PeerSelectionActions
         ntnAddr
         (PeerConnectionHandle
            'InitiatorResponderMode ntnAddr ByteString m () ())
         m
    -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \Maybe (Async m Void)
mbLocalPeerRootProviderThread
                        (PeerSelectionActions
  ntnAddr
  (PeerConnectionHandle
     'InitiatorResponderMode ntnAddr ByteString m () ())
  m
peerSelectionActions
                           :: NodeToNodePeerSelectionActions
                                InitiatorResponderMode ntnAddr m ()) ->

                      m Void -> (Async m Void -> m Void) -> m Void
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                        (Tracer m (TracePeerSelection ntnAddr)
-> Tracer
     m
     (DebugPeerSelection
        ntnAddr
        (PeerConnectionHandle
           'InitiatorResponderMode ntnAddr ByteString m () ()))
-> Tracer m PeerSelectionCounters
-> StdGen
-> PeerSelectionActions
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ())
     m
-> PeerSelectionPolicy ntnAddr m
-> m Void
forall (m :: * -> *) peeraddr peerconn.
(MonadAsync m, MonadLabelledSTM m, MonadMask m, MonadTime m,
 MonadTimer m, Ord peeraddr) =>
Tracer m (TracePeerSelection peeraddr)
-> Tracer m (DebugPeerSelection peeraddr peerconn)
-> Tracer m PeerSelectionCounters
-> StdGen
-> PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> m Void
Governor.peerSelectionGovernor
                          Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
                          Tracer
  m
  (DebugPeerSelection
     ntnAddr
     (PeerConnectionHandle
        'InitiatorResponderMode ntnAddr ByteString m () ()))
dtDebugPeerSelectionInitiatorResponderTracer
                          Tracer m PeerSelectionCounters
dtTracePeerSelectionCounters
                          StdGen
fuzzRng
                          PeerSelectionActions
  ntnAddr
  (PeerConnectionHandle
     'InitiatorResponderMode ntnAddr ByteString m () ())
  m
peerSelectionActions
                          (StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m ntnAddr
-> PeerSelectionPolicy ntnAddr m
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m peerAddr
-> PeerSelectionPolicy peerAddr m
Diffusion.Policies.simplePeerSelectionPolicy
                            StrictTVar m StdGen
policyRngVar (StrictTVar m ChurnMode -> STM m ChurnMode
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m ChurnMode
churnModeVar) PeerMetrics m ntnAddr
daPeerMetrics))
                        ((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 ->
                        Tracer m (InitializationTracer ntnAddr ntcAddr)
-> Snocket m ntnFd ntnAddr
-> [Either ntnFd ntnAddr]
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void)
-> m Void
forall (m :: * -> *) ntnFd ntnAddr ntcAddr a.
(MonadThrow m, Typeable ntnAddr, Show ntnAddr) =>
Tracer m (InitializationTracer ntnAddr ntcAddr)
-> Snocket m ntnFd ntnAddr
-> [Either ntnFd ntnAddr]
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a)
-> m a
withSockets Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer Snocket m ntnFd ntnAddr
diNtnSnocket
                                    ( [Maybe (Either ntnFd ntnAddr)] -> [Either ntnFd ntnAddr]
forall a. [Maybe a] -> [a]
catMaybes
                                        [ Maybe (Either ntnFd ntnAddr)
daIPv4Address
                                        , Maybe (Either ntnFd ntnAddr)
daIPv6Address
                                        ]
                                    )
                                    ((NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void)
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \NonEmpty ntnFd
sockets NonEmpty ntnAddr
addresses -> do
                          --
                          -- Run server
                          --
                          Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (NonEmpty ntnAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
NonEmpty ntnAddr -> InitializationTracer ntnAddr ntcAddr
RunServer NonEmpty ntnAddr
addresses)
                          m Void -> (Async m Void -> m Void) -> m Void
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                            (ServerArguments
  'InitiatorResponderMode ntnFd ntnAddr ntnVersion ByteString m () ()
-> m Void
forall (muxMode :: MuxMode) socket peerAddr versionNumber
       (m :: * -> *) a b.
(MonadAsync m, MonadCatch m, MonadEvaluate m, MonadLabelledSTM m,
 MonadMask m, MonadThrow (STM m), MonadTime m, MonadTimer m,
 HasResponder muxMode ~ 'True, Ord peerAddr, Show peerAddr) =>
ServerArguments
  muxMode socket peerAddr versionNumber ByteString m a b
-> m Void
Server.run
                              ServerArguments :: forall (muxMode :: MuxMode) socket peerAddr versionNumber bytes
       (m :: * -> *) a b.
NonEmpty socket
-> Snocket m socket peerAddr
-> Tracer m (ServerTrace peerAddr)
-> Tracer m (RemoteTransitionTrace peerAddr)
-> Tracer m (InboundGovernorTrace peerAddr)
-> AcceptedConnectionsLimit
-> MuxConnectionManager
     muxMode socket peerAddr versionNumber bytes m a b
-> DiffTime
-> ServerControlChannel muxMode peerAddr bytes m a b
-> StrictTVar m InboundGovernorObservableState
-> ServerArguments
     muxMode socket peerAddr versionNumber bytes m a b
ServerArguments {
                                  serverSockets :: NonEmpty ntnFd
serverSockets               = NonEmpty ntnFd
sockets,
                                  serverSnocket :: Snocket m ntnFd ntnAddr
serverSnocket               = Snocket m ntnFd ntnAddr
diNtnSnocket,
                                  serverTracer :: Tracer m (ServerTrace ntnAddr)
serverTracer                = Tracer m (ServerTrace ntnAddr)
dtServerTracer,
                                  serverTrTracer :: Tracer m (RemoteTransitionTrace ntnAddr)
serverTrTracer              = Tracer m (RemoteTransitionTrace ntnAddr)
dtInboundGovernorTransitionTracer,
                                  serverInboundGovernorTracer :: Tracer m (InboundGovernorTrace ntnAddr)
serverInboundGovernorTracer = Tracer m (InboundGovernorTrace ntnAddr)
dtInboundGovernorTracer,
                                  serverConnectionLimits :: AcceptedConnectionsLimit
serverConnectionLimits      = AcceptedConnectionsLimit
daAcceptedConnectionsLimit,
                                  serverConnectionManager :: ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
serverConnectionManager     = ConnectionManager
  'InitiatorResponderMode
  ntnFd
  ntnAddr
  (Handle 'InitiatorResponderMode ntnAddr ByteString m () ())
  (HandleError 'InitiatorResponderMode ntnVersion)
  m
connectionManager,
                                  serverInboundIdleTimeout :: DiffTime
serverInboundIdleTimeout    = DiffTime
daProtocolIdleTimeout,
                                  serverControlChannel :: ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
serverControlChannel        = ControlChannel
  m
  (NewConnection
     ntnAddr
     (Handle 'InitiatorResponderMode ntnAddr ByteString m () ()))
controlChannel,
                                  serverObservableStateVar :: StrictTVar m InboundGovernorObservableState
serverObservableStateVar    = StrictTVar m InboundGovernorObservableState
observableStateVar
                                })
                                ((Async m Void -> m Void) -> m Void)
-> (Async m Void -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
serverThread ->
                                  m Void -> (Async m Void -> m Void) -> m Void
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
Async.withAsync
                                    (Tracer m (TracePeerSelection ntnAddr)
-> PeerMetrics m ntnAddr
-> StrictTVar m ChurnMode
-> StdGen
-> STM m FetchMode
-> PeerSelectionTargets
-> StrictTVar m PeerSelectionTargets
-> m Void
forall (m :: * -> *) peeraddr.
(MonadSTM m, MonadMonotonicTime m, MonadDelay m) =>
Tracer m (TracePeerSelection peeraddr)
-> PeerMetrics m peeraddr
-> StrictTVar m ChurnMode
-> StdGen
-> STM m FetchMode
-> PeerSelectionTargets
-> StrictTVar m PeerSelectionTargets
-> m Void
Governor.peerChurnGovernor
                                      Tracer m (TracePeerSelection ntnAddr)
dtTracePeerSelectionTracer
                                      PeerMetrics m ntnAddr
daPeerMetrics
                                      StrictTVar m ChurnMode
churnModeVar
                                      StdGen
churnRng
                                      STM m FetchMode
daBlockFetchMode
                                      PeerSelectionTargets
daPeerSelectionTargets
                                      StrictTVar m PeerSelectionTargets
peerSelectionTargetsVar)
                                    ((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 (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
Async.waitAny
                                        (Maybe (Async m Void) -> [Async m Void]
forall a. Maybe a -> [a]
maybeToList Maybe (Async m Void)
mbLocalPeerRootProviderThread
                                        [Async m Void] -> [Async m Void] -> [Async m Void]
forall a. [a] -> [a] -> [a]
++ [ Async m Void
serverThread
                                           , Async m Void
governorThread
                                           , Async m Void
ledgerPeerThread
                                           , Async m Void
churnGovernorThread
                                           ])

    Concurrently m Void -> m Void
forall (m :: * -> *) a. Concurrently m a -> m a
Async.runConcurrently
      (Concurrently m Void -> m Void) -> Concurrently m Void -> m Void
forall a b. (a -> b) -> a -> b
$ [Concurrently m Void] -> Concurrently m Void
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      ([Concurrently m Void] -> Concurrently m Void)
-> [Concurrently m Void] -> Concurrently m Void
forall a b. (a -> b) -> a -> b
$ m Void -> Concurrently m Void
forall (m :: * -> *) a. m a -> Concurrently m a
Async.Concurrently (m Void -> Concurrently m Void)
-> [m Void] -> [Concurrently m Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          ( m Void
remoteThread
          m Void -> [m Void] -> [m Void]
forall a. a -> [a] -> [a]
: Maybe (m Void) -> [m Void]
forall a. Maybe a -> [a]
maybeToList Maybe (m Void)
localThread
          )

  where
    (StdGen
ledgerPeersRng, StdGen
rng1) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
diRng
    (StdGen
policyRng,      StdGen
rng2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng1
    (StdGen
churnRng,       StdGen
rng3) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng2
    (StdGen
fuzzRng,        StdGen
rng4) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng3
    (StdGen
ntnInbgovRng,   StdGen
ntcInbgovRng) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng4

    -- 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).
    rethrowPolicy :: RethrowPolicy
rethrowPolicy =
      RethrowPolicy_ -> RethrowPolicy
RethrowPolicy (RethrowPolicy_ -> RethrowPolicy)
-> RethrowPolicy_ -> RethrowPolicy
forall a b. (a -> b) -> a -> b
$ \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


-- | Main entry point for data diffusion service.  It allows to:
--
-- * connect to upstream peers;
-- * accept connection from downstream peers, if run in
--  'InitiatorAndResponderDiffusionMode'.
-- * runs a local service which allows to use node-to-client protocol to obtain
--   information from the running system.  This is used by 'cardano-cli' or
--   a wallet and a like local services.
--
run
    :: Tracers RemoteAddress NodeToNodeVersion
               LocalAddress  NodeToClientVersion
               IO
    -> TracersExtra RemoteAddress NodeToNodeVersion   NodeToNodeVersionData
                    LocalAddress  NodeToClientVersion NodeToClientVersionData
                    IOException IO
    -> Arguments Socket      RemoteAddress
                 LocalSocket LocalAddress
    -> ArgumentsExtra IO
    -> Applications
         RemoteAddress NodeToNodeVersion   NodeToNodeVersionData
         LocalAddress  NodeToClientVersion NodeToClientVersionData
         IO
    -> ApplicationsExtra RemoteAddress IO
    -> IO Void
run :: Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> TracersExtra
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IOException
     IO
-> Arguments Socket SockAddr LocalSocket LocalAddress
-> ArgumentsExtra IO
-> Applications
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ApplicationsExtra SockAddr IO
-> IO Void
run Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
tracersExtra Arguments Socket SockAddr LocalSocket LocalAddress
args ArgumentsExtra IO
argsExtra Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
apps ApplicationsExtra SockAddr IO
appsExtra = do
    -- 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 -> IO Void) -> IO Void -> IO Void
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\SomeException
e -> Tracer IO (InitializationTracer SockAddr LocalAddress)
-> InitializationTracer SockAddr LocalAddress -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> Tracer IO (InitializationTracer SockAddr LocalAddress)
forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (InitializationTracer ntnAddr ntcAddr)
dtDiffusionInitializationTracer Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers) (SomeException -> InitializationTracer SockAddr LocalAddress
forall ntnAddr ntcAddr.
SomeException -> InitializationTracer ntnAddr ntcAddr
DiffusionErrored SomeException
e)
               IO () -> IO Void -> IO Void
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO Void
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e)
         (IO Void -> IO Void) -> IO Void -> IO Void
forall a b. (a -> b) -> a -> b
$ (IOManager -> IO Void) -> IO Void
WithIOManager
withIOManager ((IOManager -> IO Void) -> IO Void)
-> (IOManager -> IO Void) -> IO Void
forall a b. (a -> b) -> a -> b
$ \IOManager
iocp -> do
             let diNtnSnocket :: SocketSnocket
                 diNtnSnocket :: SocketSnocket
diNtnSnocket = IOManager -> SocketSnocket
Snocket.socketSnocket IOManager
iocp

                 diNtcSnocket :: LocalSnocket
                 diNtcSnocket :: LocalSnocket
diNtcSnocket = IOManager -> LocalSnocket
Snocket.localSnocket IOManager
iocp

                 diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId SockAddr) NodeToNodeVersion NodeToNodeVersionData IO
diNtnHandshakeArguments =
                   HandshakeArguments :: forall connectionId vNumber vData (m :: * -> *).
Tracer
  m
  (WithMuxBearer
     connectionId (TraceSendRecv (Handshake vNumber Term)))
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> ProtocolTimeLimits (Handshake vNumber Term)
-> HandshakeArguments connectionId vNumber vData m
HandshakeArguments {
                       haHandshakeTracer :: Tracer
  IO
  (WithMuxBearer
     (ConnectionId SockAddr)
     (TraceSendRecv (Handshake NodeToNodeVersion Term)))
haHandshakeTracer = Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId SockAddr)
        (TraceSendRecv (Handshake NodeToNodeVersion Term)))
forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntnAddr ntnVersion)
dtHandshakeTracer Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers,
                       haHandshakeCodec :: Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
haHandshakeCodec  = Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure IO ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToNodeVersion Term) DeserialiseFailure m ByteString
NodeToNode.nodeToNodeHandshakeCodec,
                       haVersionDataCodec :: VersionDataCodec Term NodeToNodeVersion NodeToNodeVersionData
haVersionDataCodec =
                         (NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData)
-> VersionDataCodec Term NodeToNodeVersion NodeToNodeVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec
                           NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
NodeToNode.nodeToNodeCodecCBORTerm,
                       haAcceptVersion :: NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
haAcceptVersion = NodeToNodeVersionData
-> NodeToNodeVersionData -> Accept NodeToNodeVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion,
                       haTimeLimits :: ProtocolTimeLimits (Handshake NodeToNodeVersion Term)
haTimeLimits = ProtocolTimeLimits (Handshake NodeToNodeVersion Term)
forall k (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
timeLimitsHandshake
                     }
                 diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId LocalAddress)
  NodeToClientVersion
  NodeToClientVersionData
  IO
diNtcHandshakeArguments =
                   HandshakeArguments :: forall connectionId vNumber vData (m :: * -> *).
Tracer
  m
  (WithMuxBearer
     connectionId (TraceSendRecv (Handshake vNumber Term)))
-> Codec (Handshake vNumber Term) DeserialiseFailure m ByteString
-> VersionDataCodec Term vNumber vData
-> (vData -> vData -> Accept vData)
-> ProtocolTimeLimits (Handshake vNumber Term)
-> HandshakeArguments connectionId vNumber vData m
HandshakeArguments {
                       haHandshakeTracer :: Tracer
  IO
  (WithMuxBearer
     (ConnectionId LocalAddress)
     (TraceSendRecv (Handshake NodeToClientVersion Term)))
haHandshakeTracer  = Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> Tracer
     IO
     (WithMuxBearer
        (ConnectionId LocalAddress)
        (TraceSendRecv (Handshake NodeToClientVersion Term)))
forall ntnAddr ntnVersion ntcAddr ntcVersion (m :: * -> *).
Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> Tracer m (HandshakeTr ntcAddr ntcVersion)
dtLocalHandshakeTracer Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers,
                       haHandshakeCodec :: Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
haHandshakeCodec   = Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  IO
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (Handshake NodeToClientVersion Term)
  DeserialiseFailure
  m
  ByteString
NodeToClient.nodeToClientHandshakeCodec,
                       haVersionDataCodec :: VersionDataCodec Term NodeToClientVersion NodeToClientVersionData
haVersionDataCodec =
                         (NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData)
-> VersionDataCodec
     Term NodeToClientVersion NodeToClientVersionData
forall vNumber vData.
(vNumber -> CodecCBORTerm Text vData)
-> VersionDataCodec Term vNumber vData
cborTermVersionDataCodec
                           NodeToClientVersion -> CodecCBORTerm Text NodeToClientVersionData
NodeToClient.nodeToClientCodecCBORTerm,
                       haAcceptVersion :: NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
haAcceptVersion = NodeToClientVersionData
-> NodeToClientVersionData -> Accept NodeToClientVersionData
forall v. Acceptable v => v -> v -> Accept v
acceptableVersion,
                       haTimeLimits :: ProtocolTimeLimits (Handshake NodeToClientVersion Term)
haTimeLimits = ProtocolTimeLimits (Handshake NodeToClientVersion Term)
forall k (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake
                     }

                 diInstallSigUSR1Handler
                   :: forall mode x.
                      NodeToNodeConnectionManager mode Socket RemoteAddress NodeToNodeVersion IO x
                   -> IO ()
#ifdef POSIX
                 diInstallSigUSR1Handler :: NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
-> IO ()
diInstallSigUSR1Handler = \NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
connectionManager -> do
                   Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler
                     Signal
Signals.sigUSR1
                     (IO () -> Handler
Signals.Catch
                       (do Map SockAddr AbstractState
state <- NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
-> IO (Map SockAddr AbstractState)
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> m (Map peerAddr AbstractState)
readState NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
connectionManager
                           Tracer
  IO
  (ConnectionManagerTrace
     SockAddr
     (ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
-> ConnectionManagerTrace
     SockAddr
     (ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData)
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
-> Tracer
     IO
     (ConnectionManagerTrace
        SockAddr
        (ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData))
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer
     m
     (ConnectionManagerTrace
        ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData))
dtConnectionManagerTracer TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
tracersExtra)
                                     (Map SockAddr AbstractState
-> ConnectionManagerTrace
     SockAddr
     (ConnectionHandlerTrace NodeToNodeVersion NodeToNodeVersionData)
forall peerAddr handlerTrace.
Map peerAddr AbstractState
-> ConnectionManagerTrace peerAddr handlerTrace
TrState Map SockAddr AbstractState
state)
                       )
                     )
                     Maybe SignalSet
forall a. Maybe a
Nothing
                   () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
                 diInstallSigUSR1Handler = \_ -> pure ()
#endif

             let diNtnDomainResolver :: LookupReqs -> [DomainAccessPoint]
                                     -> IO (Map DomainAccessPoint (Set Socket.SockAddr))
                 diNtnDomainResolver :: LookupReqs
-> [DomainAccessPoint] -> IO (Map DomainAccessPoint (Set SockAddr))
diNtnDomainResolver LookupReqs
lr =
                   Tracer IO TracePublicRootPeers
-> ResolvConf
-> DNSActions Resolver IOException IO
-> [DomainAccessPoint]
-> IO (Map DomainAccessPoint (Set SockAddr))
forall exception resolver (m :: * -> *).
(MonadThrow m, MonadAsync m, Exception exception) =>
Tracer m TracePublicRootPeers
-> ResolvConf
-> DNSActions resolver exception m
-> [DomainAccessPoint]
-> m (Map DomainAccessPoint (Set SockAddr))
resolveDomainAccessPoint
                     (TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
-> Tracer IO TracePublicRootPeers
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  m
-> Tracer m TracePublicRootPeers
dtTracePublicRootPeersTracer TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
tracersExtra)
                     ResolvConf
DNS.defaultResolvConf
                     (LookupReqs -> DNSActions Resolver IOException IO
ioDNSActions LookupReqs
lr)

             StdGen
diRng <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
             Interfaces
  Socket
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalSocket
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  Resolver
  IOException
  IO
-> Tracers
     SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> TracersExtra
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IOException
     IO
-> Arguments Socket SockAddr LocalSocket LocalAddress
-> ArgumentsExtra IO
-> Applications
     SockAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ApplicationsExtra SockAddr IO
-> IO Void
forall (m :: * -> *) ntnFd ntnAddr ntnVersion ntnVersionData ntcFd
       ntcAddr ntcVersion ntcVersionData resolver resolverError.
(MonadAsync m, MonadEvaluate m, MonadFix m, MonadFork m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m,
 MonadThrow (STM m), MonadTime m, MonadTimer m, Eq (Async m Void),
 Typeable ntnAddr, Ord ntnAddr, Show ntnAddr, Typeable ntnVersion,
 Ord ntnVersion, Show ntnVersion, Typeable ntcAddr, Ord ntcAddr,
 Show ntcAddr, Ord ntcVersion, Exception resolverError) =>
Interfaces
  ntnFd
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcFd
  ntcAddr
  ntcVersion
  ntcVersionData
  resolver
  resolverError
  m
-> Tracers ntnAddr ntnVersion ntcAddr ntcVersion m
-> TracersExtra
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     resolverError
     m
-> Arguments ntnFd ntnAddr ntcFd ntcAddr
-> ArgumentsExtra m
-> Applications
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     m
-> ApplicationsExtra ntnAddr m
-> m Void
runM
               Interfaces :: forall ntnFd ntnAddr ntnVersion ntnVersionData ntcFd ntcAddr
       ntcVersion ntcVersionData resolver resolverError (m :: * -> *).
Snocket m ntnFd ntnAddr
-> HandshakeArguments
     (ConnectionId ntnAddr) ntnVersion ntnVersionData m
-> (ntnAddr -> Maybe AddressType)
-> (ntnVersion -> ntnVersionData -> DataFlow)
-> (IP -> PortNumber -> ntnAddr)
-> (LookupReqs
    -> [DomainAccessPoint] -> m (Map DomainAccessPoint (Set ntnAddr)))
-> Snocket m ntcFd ntcAddr
-> HandshakeArguments
     (ConnectionId ntcAddr) ntcVersion ntcVersionData m
-> (ntcFd -> m FileDescriptor)
-> StdGen
-> (forall (mode :: MuxMode) x.
    NodeToNodeConnectionManager mode ntnFd ntnAddr ntnVersion m x
    -> m ())
-> (LookupReqs -> DNSActions resolver resolverError m)
-> Interfaces
     ntnFd
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcFd
     ntcAddr
     ntcVersion
     ntcVersionData
     resolver
     resolverError
     m
Interfaces {
                 SocketSnocket
diNtnSnocket :: SocketSnocket
diNtnSnocket :: SocketSnocket
diNtnSnocket,
                 HandshakeArguments
  (ConnectionId SockAddr) NodeToNodeVersion NodeToNodeVersionData IO
diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId SockAddr) NodeToNodeVersion NodeToNodeVersionData IO
diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId SockAddr) NodeToNodeVersion NodeToNodeVersionData IO
diNtnHandshakeArguments,
                 diNtnAddressType :: SockAddr -> Maybe AddressType
diNtnAddressType = SockAddr -> Maybe AddressType
socketAddressType,
                 diNtnDataFlow :: NodeToNodeVersion -> NodeToNodeVersionData -> DataFlow
diNtnDataFlow = NodeToNodeVersion -> NodeToNodeVersionData -> DataFlow
nodeDataFlow,
                 diNtnToPeerAddr :: IP -> PortNumber -> SockAddr
diNtnToPeerAddr = ((IP, PortNumber) -> SockAddr) -> IP -> PortNumber -> SockAddr
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (IP, PortNumber) -> SockAddr
IP.toSockAddr,
                 LookupReqs
-> [DomainAccessPoint] -> IO (Map DomainAccessPoint (Set SockAddr))
diNtnDomainResolver :: LookupReqs
-> [DomainAccessPoint] -> IO (Map DomainAccessPoint (Set SockAddr))
diNtnDomainResolver :: LookupReqs
-> [DomainAccessPoint] -> IO (Map DomainAccessPoint (Set SockAddr))
diNtnDomainResolver,

                 LocalSnocket
diNtcSnocket :: LocalSnocket
diNtcSnocket :: LocalSnocket
diNtcSnocket,
                 HandshakeArguments
  (ConnectionId LocalAddress)
  NodeToClientVersion
  NodeToClientVersionData
  IO
diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId LocalAddress)
  NodeToClientVersion
  NodeToClientVersionData
  IO
diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId LocalAddress)
  NodeToClientVersion
  NodeToClientVersionData
  IO
diNtcHandshakeArguments,
                 diNtcGetFileDescriptor :: LocalSocket -> IO FileDescriptor
diNtcGetFileDescriptor = LocalSocket -> IO FileDescriptor
localSocketFileDescriptor,

                 StdGen
diRng :: StdGen
diRng :: StdGen
diRng,
                 forall (mode :: MuxMode) x.
NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
-> IO ()
diInstallSigUSR1Handler :: forall (mode :: MuxMode) x.
NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
-> IO ()
diInstallSigUSR1Handler :: forall (mode :: MuxMode) x.
NodeToNodeConnectionManager
  mode Socket SockAddr NodeToNodeVersion IO x
-> IO ()
diInstallSigUSR1Handler,
                 diDnsActions :: LookupReqs -> DNSActions Resolver IOException IO
diDnsActions = LookupReqs -> DNSActions Resolver IOException IO
ioDNSActions
               }
               Tracers
  SockAddr NodeToNodeVersion LocalAddress NodeToClientVersion IO
tracers TracersExtra
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  IO
tracersExtra Arguments Socket SockAddr LocalSocket LocalAddress
args ArgumentsExtra IO
argsExtra Applications
  SockAddr
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
apps ApplicationsExtra SockAddr IO
appsExtra


--
-- Data flow
--

-- | For Node-To-Node protocol, any connection which negotiated at least
-- 'NodeToNodeV_9' version and did not declared 'InitiatorOnlyDiffusionMode'
-- will run in 'Duplex' mode.   All connections from lower versions or one that
-- declared themselves as 'InitiatorOnly' will run in 'UnidirectionalMode'
--
nodeDataFlow :: NodeToNodeVersion
             -> NodeToNodeVersionData
             -> DataFlow
nodeDataFlow :: NodeToNodeVersion -> NodeToNodeVersionData -> DataFlow
nodeDataFlow NodeToNodeVersion
v NodeToNodeVersionData { diffusionMode :: NodeToNodeVersionData -> DiffusionMode
diffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode }
                 | NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToNodeVersion
NodeToNodeV_10
                 = DataFlow
Duplex
nodeDataFlow NodeToNodeVersion
_ NodeToNodeVersionData
_ = DataFlow
Unidirectional


-- | For Node-To-Client protocol all connection are considered 'Unidirectional'.
--
localDataFlow :: ntcVersion
              -> ntcVersionData
              -> DataFlow
localDataFlow :: ntcVersion -> ntcVersionData -> DataFlow
localDataFlow ntcVersion
_ ntcVersionData
_ = DataFlow
Unidirectional


--
-- Socket utility functions
--

withSockets :: forall m ntnFd ntnAddr ntcAddr a.
               ( MonadThrow m
               , Typeable ntnAddr
               , Show     ntnAddr
               )
            => Tracer m (InitializationTracer ntnAddr ntcAddr)
            -> Snocket m ntnFd ntnAddr
            -> [Either ntnFd ntnAddr]
            -> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a)
            -> m a
withSockets :: Tracer m (InitializationTracer ntnAddr ntcAddr)
-> Snocket m ntnFd ntnAddr
-> [Either ntnFd ntnAddr]
-> (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a)
-> m a
withSockets Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer Snocket m ntnFd ntnAddr
sn [Either ntnFd ntnAddr]
addresses NonEmpty ntnFd -> NonEmpty ntnAddr -> m a
k = [(ntnFd, ntnAddr)] -> [Either ntnFd ntnAddr] -> m a
go [] [Either ntnFd ntnAddr]
addresses
  where
    go :: [(ntnFd, ntnAddr)] -> [Either ntnFd ntnAddr] -> m a
go ![(ntnFd, ntnAddr)]
acc (Either ntnFd ntnAddr
a : [Either ntnFd ntnAddr]
as) = Either ntnFd ntnAddr -> ((ntnFd, ntnAddr) -> m a) -> m a
withSocket Either ntnFd ntnAddr
a (\(ntnFd, ntnAddr)
sa -> [(ntnFd, ntnAddr)] -> [Either ntnFd ntnAddr] -> m a
go ((ntnFd, ntnAddr)
sa (ntnFd, ntnAddr) -> [(ntnFd, ntnAddr)] -> [(ntnFd, ntnAddr)]
forall a. a -> [a] -> [a]
: [(ntnFd, ntnAddr)]
acc) [Either ntnFd ntnAddr]
as)
    go []   []       = Failure ntnAddr -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (Failure ntnAddr
forall ntnAddr. Failure ntnAddr
NoSocket :: Failure ntnAddr)
    go ![(ntnFd, ntnAddr)]
acc []       =
      let acc' :: NonEmpty (ntnFd, ntnAddr)
acc' = [(ntnFd, ntnAddr)] -> NonEmpty (ntnFd, ntnAddr)
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([(ntnFd, ntnAddr)] -> [(ntnFd, ntnAddr)]
forall a. [a] -> [a]
reverse [(ntnFd, ntnAddr)]
acc)
      in (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a
k (NonEmpty ntnFd -> NonEmpty ntnAddr -> m a)
-> NonEmpty ntnFd -> NonEmpty ntnAddr -> m a
forall a b. (a -> b) -> a -> b
$! ((ntnFd, ntnAddr) -> ntnFd
forall a b. (a, b) -> a
fst ((ntnFd, ntnAddr) -> ntnFd)
-> NonEmpty (ntnFd, ntnAddr) -> NonEmpty ntnFd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ntnFd, ntnAddr)
acc')) (NonEmpty ntnAddr -> m a) -> NonEmpty ntnAddr -> m a
forall a b. (a -> b) -> a -> b
$! ((ntnFd, ntnAddr) -> ntnAddr
forall a b. (a, b) -> b
snd ((ntnFd, ntnAddr) -> ntnAddr)
-> NonEmpty (ntnFd, ntnAddr) -> NonEmpty ntnAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ntnFd, ntnAddr)
acc')

    withSocket :: Either ntnFd ntnAddr
               -> ((ntnFd, ntnAddr) -> m a)
               -> m a
    withSocket :: Either ntnFd ntnAddr -> ((ntnFd, ntnAddr) -> m a) -> m a
withSocket (Left ntnFd
sock) (ntnFd, ntnAddr) -> m a
f =
      m ntnFd -> (ntnFd -> m ()) -> (ntnFd -> m a) -> m a
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (ntnFd -> m ntnFd
forall (f :: * -> *) a. Applicative f => a -> f a
pure ntnFd
sock)
        (Snocket m ntnFd ntnAddr -> ntnFd -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m ntnFd ntnAddr
sn)
        ((ntnFd -> m a) -> m a) -> (ntnFd -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ntnFd
_sock -> do
          !ntnAddr
addr <- Snocket m ntnFd ntnAddr -> ntnFd -> m ntnAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr Snocket m ntnFd ntnAddr
sn ntnFd
sock
          (ntnFd, ntnAddr) -> m a
f (ntnFd
sock, ntnAddr
addr)
    withSocket (Right ntnAddr
addr) (ntnFd, ntnAddr) -> m a
f =
      m ntnFd -> (ntnFd -> m ()) -> (ntnFd -> m a) -> m a
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (do Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (ntnAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
CreatingServerSocket ntnAddr
addr)
            Snocket m ntnFd ntnAddr -> AddressFamily ntnAddr -> m ntnFd
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open Snocket m ntnFd ntnAddr
sn (Snocket m ntnFd ntnAddr -> ntnAddr -> AddressFamily ntnAddr
forall (m :: * -> *) fd addr.
Snocket m fd addr -> addr -> AddressFamily addr
Snocket.addrFamily Snocket m ntnFd ntnAddr
sn ntnAddr
addr))
        (Snocket m ntnFd ntnAddr -> ntnFd -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m ntnFd ntnAddr
sn)
        ((ntnFd -> m a) -> m a) -> (ntnFd -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ntnFd
sock -> do
          Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall a b. (a -> b) -> a -> b
$ ntnAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
ConfiguringServerSocket ntnAddr
addr
          Snocket m ntnFd ntnAddr -> ntnFd -> ntnAddr -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind Snocket m ntnFd ntnAddr
sn ntnFd
sock ntnAddr
addr
          Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall a b. (a -> b) -> a -> b
$ ntnAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
ListeningServerSocket ntnAddr
addr
          Snocket m ntnFd ntnAddr -> ntnFd -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.listen Snocket m ntnFd ntnAddr
sn ntnFd
sock
          Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall a b. (a -> b) -> a -> b
$ ntnAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntnAddr -> InitializationTracer ntnAddr ntcAddr
ServerSocketUp ntnAddr
addr
          (ntnFd, ntnAddr) -> m a
f (ntnFd
sock, ntnAddr
addr)


withLocalSocket :: forall ntnAddr ntcFd ntcAddr m a.
                   ( MonadThrow m
                     -- Win32 only constraints:
                   , Typeable ntnAddr
                   , Show     ntnAddr
                   )
                => Tracer m (InitializationTracer ntnAddr ntcAddr)
                -> (ntcFd -> m FileDescriptor)
                -> Snocket m ntcFd ntcAddr
                -> Either ntcFd ntcAddr
                -> (ntcFd -> m a)
                -> m a
withLocalSocket :: Tracer m (InitializationTracer ntnAddr ntcAddr)
-> (ntcFd -> m FileDescriptor)
-> Snocket m ntcFd ntcAddr
-> Either ntcFd ntcAddr
-> (ntcFd -> m a)
-> m a
withLocalSocket Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer ntcFd -> m FileDescriptor
getFileDescriptor Snocket m ntcFd ntcAddr
sn Either ntcFd ntcAddr
localAddress ntcFd -> m a
k =
  m (Either ntcFd (ntcFd, ntcAddr))
-> (Either ntcFd (ntcFd, ntcAddr) -> m ())
-> (Either ntcFd (ntcFd, ntcAddr) -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (
      case Either ntcFd ntcAddr
localAddress of
#if defined(mingw32_HOST_OS)
         -- Windows uses named pipes so can't take advantage of existing sockets
         Left _ -> traceWith tracer (UnsupportedReadySocketCase
                                       :: InitializationTracer ntnAddr ntcAddr)
                >> throwIO (UnsupportedReadySocket :: Failure ntnAddr)
#else
         Left ntcFd
sd -> do
             ntcAddr
addr <- Snocket m ntcFd ntcAddr -> ntcFd -> m ntcAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
Snocket.getLocalAddr Snocket m ntcFd ntcAddr
sn ntcFd
sd
             Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (ntcAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
UsingSystemdSocket ntcAddr
addr)
             Either ntcFd (ntcFd, ntcAddr) -> m (Either ntcFd (ntcFd, ntcAddr))
forall (m :: * -> *) a. Monad m => a -> m a
return (ntcFd -> Either ntcFd (ntcFd, ntcAddr)
forall a b. a -> Either a b
Left ntcFd
sd)
#endif
         Right ntcAddr
addr -> do
             Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall a b. (a -> b) -> a -> b
$ ntcAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
CreateSystemdSocketForSnocketPath ntcAddr
addr
             ntcFd
sd <- Snocket m ntcFd ntcAddr -> AddressFamily ntcAddr -> m ntcFd
forall (m :: * -> *) fd addr.
Snocket m fd addr -> AddressFamily addr -> m fd
Snocket.open Snocket m ntcFd ntcAddr
sn (Snocket m ntcFd ntcAddr -> ntcAddr -> AddressFamily ntcAddr
forall (m :: * -> *) fd addr.
Snocket m fd addr -> addr -> AddressFamily addr
Snocket.addrFamily Snocket m ntcFd ntcAddr
sn ntcAddr
addr)
             Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall a b. (a -> b) -> a -> b
$ ntcAddr -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> InitializationTracer ntnAddr ntcAddr
CreatedLocalSocket ntcAddr
addr
             Either ntcFd (ntcFd, ntcAddr) -> m (Either ntcFd (ntcFd, ntcAddr))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ntcFd, ntcAddr) -> Either ntcFd (ntcFd, ntcAddr)
forall a b. b -> Either a b
Right (ntcFd
sd, ntcAddr
addr))
    )
    -- We close the socket here, even if it was provided to us.
    (\case
      Right (ntcFd
sd, ntcAddr
_) -> Snocket m ntcFd ntcAddr -> ntcFd -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m ntcFd ntcAddr
sn ntcFd
sd
      Left   ntcFd
sd     -> Snocket m ntcFd ntcAddr -> ntcFd -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.close Snocket m ntcFd ntcAddr
sn ntcFd
sd
    )
    ((Either ntcFd (ntcFd, ntcAddr) -> m a) -> m a)
-> (Either ntcFd (ntcFd, ntcAddr) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \case
      -- unconfigured socket
      Right (ntcFd
sd, ntcAddr
addr) -> do
        Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> (FileDescriptor -> InitializationTracer ntnAddr ntcAddr)
-> FileDescriptor
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
ConfiguringLocalSocket ntcAddr
addr
           (FileDescriptor -> m ()) -> m FileDescriptor -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ntcFd -> m FileDescriptor
getFileDescriptor ntcFd
sd
        Snocket m ntcFd ntcAddr -> ntcFd -> ntcAddr -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
Snocket.bind Snocket m ntcFd ntcAddr
sn ntcFd
sd ntcAddr
addr
        Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> (FileDescriptor -> InitializationTracer ntnAddr ntcAddr)
-> FileDescriptor
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
ListeningLocalSocket ntcAddr
addr
           (FileDescriptor -> m ()) -> m FileDescriptor -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ntcFd -> m FileDescriptor
getFileDescriptor ntcFd
sd
        Snocket m ntcFd ntcAddr -> ntcFd -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
Snocket.listen Snocket m ntcFd ntcAddr
sn ntcFd
sd
        Tracer m (InitializationTracer ntnAddr ntcAddr)
-> InitializationTracer ntnAddr ntcAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InitializationTracer ntnAddr ntcAddr)
tracer (InitializationTracer ntnAddr ntcAddr -> m ())
-> (FileDescriptor -> InitializationTracer ntnAddr ntcAddr)
-> FileDescriptor
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
forall ntnAddr ntcAddr.
ntcAddr -> FileDescriptor -> InitializationTracer ntnAddr ntcAddr
LocalSocketUp ntcAddr
addr
           (FileDescriptor -> m ()) -> m FileDescriptor -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ntcFd -> m FileDescriptor
getFileDescriptor ntcFd
sd
        ntcFd -> m a
k ntcFd
sd

      -- pre-configured systemd socket
      Left ntcFd
sd -> ntcFd -> m a
k ntcFd
sd