{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Intended for qualified import
module Ouroboros.Consensus.Network.NodeToNode (
    -- * Handlers
    Handlers (..)
  , mkHandlers
    -- * Codecs
  , Codecs (..)
  , defaultCodecs
  , identityCodecs
    -- * Byte Limits
  , ByteLimits
  , byteLimits
  , noByteLimits
    -- * Tracers
  , Tracers
  , Tracers' (..)
  , nullTracers
  , showTracers
    -- * Applications
  , Apps (..)
  , ClientApp
  , ServerApp
  , mkApps
    -- ** Projections
  , initiator
  , initiatorAndResponder
    -- * Re-exports
  , ChainSyncTimeout (..)
  ) where

import           Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.CBOR.Read (DeserialiseFailure)
import qualified Control.Concurrent.Class.MonadSTM.Strict.TVar as TVar.Unchecked
import           Control.Monad.Class.MonadTime.SI (MonadTime)
import           Control.Monad.Class.MonadTimer.SI (MonadTimer)
import           Control.ResourceRegistry
import           Control.Tracer
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import           Data.Hashable (Hashable)
import           Data.Int (Int64)
import           Data.Map.Strict (Map)
import           Data.Void (Void)
import           Network.TypedProtocol.Codec
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config (DiffusionPipeliningSupport (..))
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                     (ChainSyncStateView (..))
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CsClient
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import           Ouroboros.Consensus.Node.ExitPolicy
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import qualified Ouroboros.Consensus.Node.Tracers as Node
import           Ouroboros.Consensus.NodeKernel
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import           Ouroboros.Consensus.Storage.Serialisation (SerialisedHeader)
import           Ouroboros.Consensus.Util (ShowProxy)
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Network.Block (Serialised (..), decodePoint,
                     decodeTip, encodePoint, encodeTip)
import           Ouroboros.Network.BlockFetch
import           Ouroboros.Network.BlockFetch.Client (BlockFetchClient,
                     blockFetchClient)
import           Ouroboros.Network.Channel
import           Ouroboros.Network.Context
import           Ouroboros.Network.DeltaQ
import           Ouroboros.Network.Driver
import           Ouroboros.Network.Driver.Limits
import           Ouroboros.Network.KeepAlive
import           Ouroboros.Network.Mux
import           Ouroboros.Network.NodeToNode
import           Ouroboros.Network.PeerSelection.PeerMetric.Type
                     (FetchedMetricsTracer, ReportPeerMetrics (..))
import qualified Ouroboros.Network.PeerSelection.PeerSharing as PSTypes
import           Ouroboros.Network.PeerSharing (PeerSharingController,
                     bracketPeerSharingClient, peerSharingClient,
                     peerSharingServer)
import           Ouroboros.Network.Protocol.BlockFetch.Codec
import           Ouroboros.Network.Protocol.BlockFetch.Server (BlockFetchServer,
                     blockFetchServerPeer)
import           Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch (..))
import           Ouroboros.Network.Protocol.ChainSync.ClientPipelined
import           Ouroboros.Network.Protocol.ChainSync.Codec
import           Ouroboros.Network.Protocol.ChainSync.PipelineDecision
import           Ouroboros.Network.Protocol.ChainSync.Server
import           Ouroboros.Network.Protocol.ChainSync.Type
import           Ouroboros.Network.Protocol.KeepAlive.Client
import           Ouroboros.Network.Protocol.KeepAlive.Codec
import           Ouroboros.Network.Protocol.KeepAlive.Server
import           Ouroboros.Network.Protocol.KeepAlive.Type
import           Ouroboros.Network.Protocol.PeerSharing.Client
                     (PeerSharingClient, peerSharingClientPeer)
import           Ouroboros.Network.Protocol.PeerSharing.Codec
                     (byteLimitsPeerSharing, codecPeerSharing,
                     codecPeerSharingId, timeLimitsPeerSharing)
import           Ouroboros.Network.Protocol.PeerSharing.Server
                     (PeerSharingServer, peerSharingServerPeer)
import           Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharing)
import           Ouroboros.Network.Protocol.TxSubmission2.Client
import           Ouroboros.Network.Protocol.TxSubmission2.Codec
import           Ouroboros.Network.Protocol.TxSubmission2.Server
import           Ouroboros.Network.Protocol.TxSubmission2.Type
import           Ouroboros.Network.TxSubmission.Inbound
import           Ouroboros.Network.TxSubmission.Mempool.Reader
                     (mapTxSubmissionMempoolReader)
import           Ouroboros.Network.TxSubmission.Outbound


{-------------------------------------------------------------------------------
  Handlers
-------------------------------------------------------------------------------}

-- | Protocol handlers for node-to-node (remote) communication
data Handlers m addr blk = Handlers {
      forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient
        :: ConnectionId addr
        -> IsBigLedgerPeer
        -> CsClient.DynamicEnv m blk
        -> ChainSyncClientPipelined (Header blk) (Point blk) (Tip blk) m
             CsClient.ChainSyncClientResult
        -- TODO: we should reconsider bundling these context parameters into a
        -- record, perhaps instead extending the protocol handler
        -- representation to support bracket-style initialisation so that we
        -- could have the closure include these and not need to be explicit
        -- about them here.

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer
        :: ConnectionId addr
        -> NodeToNodeVersion
        -> ChainDB.Follower m blk (ChainDB.WithPoint blk (SerialisedHeader blk))
        -> ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()

    -- TODO block fetch client does not have GADT view of the handlers.
    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> FetchedMetricsTracer m
        -> BlockFetchClient (Header blk) blk m ()

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer
        :: ConnectionId addr
        -> NodeToNodeVersion
        -> ResourceRegistry m
        -> BlockFetchServer (Serialised blk) (Point blk) m ()

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> ConnectionId addr
        -> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer
        :: NodeToNodeVersion
        -> ConnectionId addr
        -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> ConnectionId addr
        -> TVar.Unchecked.StrictTVar m (Map (ConnectionId addr) PeerGSV)
        -> KeepAliveInterval
        -> KeepAliveClient m ()

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion -> ConnectionId addr -> KeepAliveServer m ()
hKeepAliveServer
        :: NodeToNodeVersion
        -> ConnectionId addr
        -> KeepAliveServer m ()

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
hPeerSharingClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> ConnectionId addr
        -> PeerSharingController addr m
        -> m (PeerSharingClient addr m ())

    , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
hPeerSharingServer
        :: NodeToNodeVersion
        -> ConnectionId addr
        -> PeerSharingServer addr m
    }

mkHandlers ::
     forall m blk addrNTN addrNTC.
     ( IOLike m
     , MonadTime m
     , MonadTimer m
     , LedgerSupportsMempool blk
     , HasTxId (GenTx blk)
     , LedgerSupportsProtocol blk
     , Ord addrNTN
     , Hashable addrNTN
     )
  => NodeKernelArgs m addrNTN addrNTC blk
  -> NodeKernel     m addrNTN addrNTC blk
  -> Handlers       m addrNTN           blk
mkHandlers :: forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, MonadTime m, MonadTimer m, LedgerSupportsMempool blk,
 HasTxId (GenTx blk), LedgerSupportsProtocol blk, Ord addrNTN,
 Hashable addrNTN) =>
NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk -> Handlers m addrNTN blk
mkHandlers
      NodeKernelArgs {SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
$sel:chainSyncFutureCheck:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> SomeHeaderInFutureCheck m blk
chainSyncFutureCheck, m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
$sel:chainSyncHistoricityCheck:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck, StdGen
keepAliveRng :: StdGen
$sel:keepAliveRng:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> StdGen
keepAliveRng, MiniProtocolParameters
miniProtocolParameters :: MiniProtocolParameters
$sel:miniProtocolParameters:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> MiniProtocolParameters
miniProtocolParameters, DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
$sel:getDiffusionPipeliningSupport:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> DiffusionPipeliningSupport
getDiffusionPipeliningSupport}
      NodeKernel {ChainDB m blk
getChainDB :: ChainDB m blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB, Mempool m blk
getMempool :: Mempool m blk
$sel:getMempool:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> Mempool m blk
getMempool, TopLevelConfig blk
getTopLevelConfig :: TopLevelConfig blk
$sel:getTopLevelConfig:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> TopLevelConfig blk
getTopLevelConfig, $sel:getTracers:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers = Tracers m (ConnectionId addrNTN) addrNTC blk
tracers, PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI :: PeerSharingAPI addrNTN StdGen m
$sel:getPeerSharingAPI:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI, STM m GsmState
getGsmState :: STM m GsmState
$sel:getGsmState:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState} =
    Handlers {
        hChainSyncClient :: ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient = \ConnectionId addrNTN
peer IsBigLedgerPeer
_isBigLedgerpeer DynamicEnv m blk
dynEnv ->
          ConfigEnv m blk
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ConfigEnv m blk
-> DynamicEnv m blk -> Consensus ChainSyncClientPipelined blk m
CsClient.chainSyncClient
            CsClient.ConfigEnv {
                $sel:cfg:ConfigEnv :: TopLevelConfig blk
CsClient.cfg                     = TopLevelConfig blk
getTopLevelConfig
              , $sel:someHeaderInFutureCheck:ConfigEnv :: SomeHeaderInFutureCheck m blk
CsClient.someHeaderInFutureCheck = SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
              , $sel:historicityCheck:ConfigEnv :: HistoricityCheck m blk
CsClient.historicityCheck        = m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck (STM m GsmState -> m GsmState
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m GsmState
getGsmState)
              , $sel:chainDbView:ConfigEnv :: ChainDbView m blk
CsClient.chainDbView             =
                  ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ChainDB m blk -> ChainDbView m blk
CsClient.defaultChainDbView ChainDB m blk
getChainDB
              , $sel:mkPipelineDecision0:ConfigEnv :: MkPipelineDecision
CsClient.mkPipelineDecision0     = Word16 -> Word16 -> MkPipelineDecision
pipelineDecisionLowHighMark
                  (MiniProtocolParameters -> Word16
chainSyncPipeliningLowMark  MiniProtocolParameters
miniProtocolParameters)
                  (MiniProtocolParameters -> Word16
chainSyncPipeliningHighMark MiniProtocolParameters
miniProtocolParameters)
              , $sel:tracer:ConfigEnv :: Tracer m (TraceChainSyncClientEvent blk)
CsClient.tracer                  =
                  (TraceChainSyncClientEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers)
              , $sel:getDiffusionPipeliningSupport:ConfigEnv :: DiffusionPipeliningSupport
CsClient.getDiffusionPipeliningSupport = DiffusionPipeliningSupport
getDiffusionPipeliningSupport
              }
            DynamicEnv m blk
dynEnv
      , hChainSyncServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer = \ConnectionId addrNTN
peer NodeToNodeVersion
_version ->
          Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
forall (m :: * -> *) blk.
(IOLike m, HasHeader (Header blk)) =>
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
chainSyncHeadersServer
            ((TraceChainSyncServerEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
-> Tracer m (TraceChainSyncServerEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncServerEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceChainSyncServerEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
Node.chainSyncServerHeaderTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ChainDB m blk
getChainDB
      , hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient =
          NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
forall header block versionNumber (m :: * -> *).
(MonadSTM m, MonadThrow m, MonadTime m, MonadMonotonicTime m,
 HasHeader header, HasHeader block,
 HeaderHash header ~ HeaderHash block) =>
versionNumber
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> FetchClientContext header block m
-> ClientPipelined (BlockFetch block (Point block)) 'BFIdle m ()
blockFetchClient
      , hBlockFetchServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer = \ConnectionId addrNTN
peer NodeToNodeVersion
version ->
          Tracer m (TraceBlockFetchServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk, Typeable blk) =>
Tracer m (TraceBlockFetchServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
blockFetchServer
            ((TraceBlockFetchServerEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
-> Tracer m (TraceBlockFetchServerEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceBlockFetchServerEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
Node.blockFetchServerTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ChainDB m blk
getChainDB
            NodeToNodeVersion
version
      , hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient = \NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
peer ->
          Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
forall txid tx idx (m :: * -> *).
(Ord txid, Ord idx, MonadSTM m, MonadThrow m) =>
Tracer m (TraceTxSubmissionOutbound txid tx)
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> TxSubmissionClient txid tx m ()
txSubmissionOutbound
            ((TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
Node.txOutboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            (MiniProtocolParameters -> NumTxIdsToAck
txSubmissionMaxUnacked MiniProtocolParameters
miniProtocolParameters)
            ((Validated (GenTx blk) -> GenTx blk)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall (m :: * -> *) tx tx' txid idx.
MonadSTM m =>
(tx -> tx')
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (TxSubmissionMempoolReader
   (GenTxId blk) (Validated (GenTx blk)) TicketNo m
 -> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall a b. (a -> b) -> a -> b
$ Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk
getMempool)
            NodeToNodeVersion
version
            ControlMessageSTM m
controlMessageSTM
      , hTxSubmissionServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer = \NodeToNodeVersion
version ConnectionId addrNTN
peer ->
          Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
-> NodeToNodeVersion
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
forall txid tx idx (m :: * -> *).
(Ord txid, NoThunks txid, NoThunks tx, MonadSTM m, MonadThrow m,
 MonadDelay m) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolWriter txid tx idx m
-> NodeToNodeVersion
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInbound
            ((TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
Node.txInboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            (MiniProtocolParameters -> NumTxIdsToAck
txSubmissionMaxUnacked MiniProtocolParameters
miniProtocolParameters)
            ((Validated (GenTx blk) -> GenTx blk)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall (m :: * -> *) tx tx' txid idx.
MonadSTM m =>
(tx -> tx')
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (TxSubmissionMempoolReader
   (GenTxId blk) (Validated (GenTx blk)) TicketNo m
 -> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall a b. (a -> b) -> a -> b
$ Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk
getMempool)
            (Mempool m blk
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
forall blk (m :: * -> *).
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
getMempoolWriter Mempool m blk
getMempool)
            NodeToNodeVersion
version
      , hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient = \NodeToNodeVersion
_version -> Tracer m (TraceKeepAliveClient (ConnectionId addrNTN))
-> StdGen
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
forall (m :: * -> *) peer.
(MonadTimer m, Ord peer) =>
Tracer m (TraceKeepAliveClient peer)
-> StdGen
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
keepAliveClient (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer m (TraceKeepAliveClient (ConnectionId addrNTN))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
Node.keepAliveClientTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers) StdGen
keepAliveRng
      , hKeepAliveServer :: NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
hKeepAliveServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer
      , hPeerSharingClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingClient = \NodeToNodeVersion
_version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
_peer -> ControlMessageSTM m
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
forall (m :: * -> *) peer.
(Alternative (STM m), MonadMVar m, MonadSTM m, MonadThrow m) =>
ControlMessageSTM m
-> PeerSharingController peer m -> m (PeerSharingClient peer m ())
peerSharingClient ControlMessageSTM m
controlMessageSTM
      , hPeerSharingServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hPeerSharingServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> PeerSharingAPI addrNTN StdGen m -> PeerSharingServer addrNTN m
forall (m :: * -> *) peer s.
(MonadSTM m, MonadMonotonicTime m, Hashable peer, RandomGen s) =>
PeerSharingAPI peer s m -> PeerSharingServer peer m
peerSharingServer PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI
      }

{-------------------------------------------------------------------------------
  Codecs
-------------------------------------------------------------------------------}

-- | Node-to-node protocol codecs needed to run 'Handlers'.
data Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS = Codecs {
      forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec            :: Codec (ChainSync (Header blk) (Point blk) (Tip blk))           e m bCS
    , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised  :: Codec (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
    , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec           :: Codec (BlockFetch blk (Point blk))                             e m bBF
    , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised :: Codec (BlockFetch (Serialised blk) (Point blk))                e m bSBF
    , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec        :: Codec (TxSubmission2 (GenTxId blk) (GenTx blk))                e m bTX
    , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec KeepAlive e m bKA
cKeepAliveCodec            :: Codec KeepAlive                                                e m bKA
    , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec          :: Codec (PeerSharing addr)                                       e m bPS
    }

-- | Protocol codecs for the node-to-node protocols
defaultCodecs :: forall m blk addr.
                ( IOLike m
                , SerialiseNodeToNodeConstraints blk
                )
              => CodecConfig       blk
              -> BlockNodeToNodeVersion blk
              -> (NodeToNodeVersion -> addr -> CBOR.Encoding)
              -> (NodeToNodeVersion -> forall s . CBOR.Decoder s addr)
              -> NodeToNodeVersion
              -> Codecs blk addr DeserialiseFailure m
                   ByteString ByteString ByteString ByteString ByteString ByteString ByteString
defaultCodecs :: forall (m :: * -> *) blk addr.
(IOLike m, SerialiseNodeToNodeConstraints blk) =>
CodecConfig blk
-> BlockNodeToNodeVersion blk
-> (NodeToNodeVersion -> addr -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addr)
-> NodeToNodeVersion
-> Codecs
     blk
     addr
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
defaultCodecs CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version NodeToNodeVersion -> addr -> Encoding
encAddr NodeToNodeVersion -> forall s. Decoder s addr
decAddr NodeToNodeVersion
nodeToNodeVersion = Codecs {
      cChainSyncCodec :: Codec
  (ChainSync (Header blk) (Point blk) (Tip blk))
  DeserialiseFailure
  m
  ByteString
cChainSyncCodec =
        (Header blk -> Encoding)
-> (forall s. Decoder s (Header blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
     (ChainSync (Header blk) (Point blk) (Tip blk))
     DeserialiseFailure
     m
     ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
     (ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync
          Header blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Header blk)
forall s. Decoder s (Header blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
          ((HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall {k} (blk :: k).
(HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip   (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall {k} (blk :: k).
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip   (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))

    , cChainSyncCodecSerialised :: Codec
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
  DeserialiseFailure
  m
  ByteString
cChainSyncCodecSerialised =
        (SerialisedHeader blk -> Encoding)
-> (forall s. Decoder s (SerialisedHeader blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     DeserialiseFailure
     m
     ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
     (ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync
          SerialisedHeader blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (SerialisedHeader blk)
forall s. Decoder s (SerialisedHeader blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
          ((HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall {k} (blk :: k).
(HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip   (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall {k} (blk :: k).
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip   (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))

    , cBlockFetchCodec :: Codec (BlockFetch blk (Point blk)) DeserialiseFailure m ByteString
cBlockFetchCodec =
        (blk -> Encoding)
-> (forall s. Decoder s blk)
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> Codec
     (BlockFetch blk (Point blk)) DeserialiseFailure m ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
          blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s blk
forall s. Decoder s blk
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))

    , cBlockFetchCodecSerialised :: Codec
  (BlockFetch (Serialised blk) (Point blk))
  DeserialiseFailure
  m
  ByteString
cBlockFetchCodecSerialised =
        (Serialised blk -> Encoding)
-> (forall s. Decoder s (Serialised blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> Codec
     (BlockFetch (Serialised blk) (Point blk))
     DeserialiseFailure
     m
     ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
          Serialised blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Serialised blk)
forall s. Decoder s (Serialised blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))

    , cTxSubmission2Codec :: Codec
  (TxSubmission2 (GenTxId blk) (GenTx blk))
  DeserialiseFailure
  m
  ByteString
cTxSubmission2Codec =
        (GenTxId blk -> Encoding)
-> (forall s. Decoder s (GenTxId blk))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> Codec
     (TxSubmission2 (GenTxId blk) (GenTx blk))
     DeserialiseFailure
     m
     ByteString
forall txid tx (m :: * -> *).
MonadST m =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
codecTxSubmission2
          GenTxId blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (GenTxId blk)
forall s. Decoder s (GenTxId blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          GenTx blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec

    , cKeepAliveCodec :: Codec KeepAlive DeserialiseFailure m ByteString
cKeepAliveCodec = Codec KeepAlive DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec KeepAlive DeserialiseFailure m ByteString
codecKeepAlive_v2

    , cPeerSharingCodec :: Codec (PeerSharing addr) DeserialiseFailure m ByteString
cPeerSharingCodec = (addr -> Encoding)
-> (forall s. Decoder s addr)
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
forall (m :: * -> *) peerAddress.
MonadST m =>
(peerAddress -> Encoding)
-> (forall s. Decoder s peerAddress)
-> Codec (PeerSharing peerAddress) DeserialiseFailure m ByteString
codecPeerSharing (NodeToNodeVersion -> addr -> Encoding
encAddr NodeToNodeVersion
nodeToNodeVersion) (NodeToNodeVersion -> forall s. Decoder s addr
decAddr NodeToNodeVersion
nodeToNodeVersion)
    }
  where
    p :: Proxy blk
    p :: Proxy blk
p = Proxy blk
forall {k} (t :: k). Proxy t
Proxy

    enc :: SerialiseNodeToNode blk a => a -> Encoding
    enc :: forall a. SerialiseNodeToNode blk a => a -> Encoding
enc = CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version

    dec :: SerialiseNodeToNode blk a => forall s. Decoder s a
    dec :: forall a s. SerialiseNodeToNode blk a => Decoder s a
dec = CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version

-- | Identity codecs used in tests.
identityCodecs :: Monad m
               => Codecs blk addr CodecFailure m
                    (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
                    (AnyMessage (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
                    (AnyMessage (BlockFetch blk (Point blk)))
                    (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
                    (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
                    (AnyMessage KeepAlive)
                    (AnyMessage (PeerSharing addr))
identityCodecs :: forall (m :: * -> *) blk addr.
Monad m =>
Codecs
  blk
  addr
  CodecFailure
  m
  (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
  (AnyMessage
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
  (AnyMessage (BlockFetch blk (Point blk)))
  (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
  (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
  (AnyMessage KeepAlive)
  (AnyMessage (PeerSharing addr))
identityCodecs = Codecs {
      cChainSyncCodec :: Codec
  (ChainSync (Header blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
cChainSyncCodec            = Codec
  (ChainSync (Header blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2)
       (m :: * -> *).
Monad m =>
Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId
    , cChainSyncCodecSerialised :: Codec
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
cChainSyncCodecSerialised  = Codec
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2)
       (m :: * -> *).
Monad m =>
Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId
    , cBlockFetchCodec :: Codec
  (BlockFetch blk (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch blk (Point blk)))
cBlockFetchCodec           = Codec
  (BlockFetch blk (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch blk (Point blk)))
forall {k} {k1} (block :: k) (point :: k1) (m :: * -> *).
Monad m =>
Codec
  (BlockFetch block point)
  CodecFailure
  m
  (AnyMessage (BlockFetch block point))
codecBlockFetchId
    , cBlockFetchCodecSerialised :: Codec
  (BlockFetch (Serialised blk) (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
cBlockFetchCodecSerialised = Codec
  (BlockFetch (Serialised blk) (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
forall {k} {k1} (block :: k) (point :: k1) (m :: * -> *).
Monad m =>
Codec
  (BlockFetch block point)
  CodecFailure
  m
  (AnyMessage (BlockFetch block point))
codecBlockFetchId
    , cTxSubmission2Codec :: Codec
  (TxSubmission2 (GenTxId blk) (GenTx blk))
  CodecFailure
  m
  (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
cTxSubmission2Codec        = Codec
  (TxSubmission2 (GenTxId blk) (GenTx blk))
  CodecFailure
  m
  (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
forall {k} {k1} (txid :: k) (tx :: k1) (m :: * -> *).
Monad m =>
Codec
  (TxSubmission2 txid tx)
  CodecFailure
  m
  (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id
    , cKeepAliveCodec :: Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
cKeepAliveCodec            = Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
forall (m :: * -> *).
Monad m =>
Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId
    , cPeerSharingCodec :: Codec
  (PeerSharing addr) CodecFailure m (AnyMessage (PeerSharing addr))
cPeerSharingCodec          = Codec
  (PeerSharing addr) CodecFailure m (AnyMessage (PeerSharing addr))
forall {k} (peerAddress :: k) (m :: * -> *).
Monad m =>
Codec
  (PeerSharing peerAddress)
  CodecFailure
  m
  (AnyMessage (PeerSharing peerAddress))
codecPeerSharingId
    }

{-------------------------------------------------------------------------------
  Tracers
-------------------------------------------------------------------------------}

-- | A record of 'Tracer's for the different protocols.
type Tracers m peer blk e =
     Tracers'  peer blk e (Tracer m)

data Tracers' peer blk e f = Tracers {
      forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer            :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
    , forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer  :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
    , forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer           :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
    , forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
    , forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer        :: f (TraceLabelPeer peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
    , forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer            :: f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
    }

instance (forall a. Semigroup (f a)) => Semigroup (Tracers' peer blk e f) where
  Tracers' peer blk e f
l <> :: Tracers' peer blk e f
-> Tracers' peer blk e f -> Tracers' peer blk e f
<> Tracers' peer blk e f
r = Tracers {
        tChainSyncTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer            = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer
      , tChainSyncSerialisedTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer  = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv
            (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer
      , tBlockFetchTracer :: f (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer           = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer (TraceSendRecv (BlockFetch blk (Point blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer
      , tBlockFetchSerialisedTracer :: f (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer
      , tTxSubmission2Tracer :: f (TraceLabelPeer
     peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer        = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer
      , tKeepAliveTracer :: f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer            = (Tracers' peer blk e f
 -> f (TraceLabelPeer peer (TraceSendRecv KeepAlive)))
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer
      }
    where
      f :: forall a. Semigroup a
        => (Tracers' peer blk e f -> a)
        -> a
      f :: forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f -> a
prj = Tracers' peer blk e f -> a
prj Tracers' peer blk e f
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Tracers' peer blk e f -> a
prj Tracers' peer blk e f
r

-- | Use a 'nullTracer' for each protocol.
nullTracers :: Monad m => Tracers m peer blk e
nullTracers :: forall (m :: * -> *) peer blk e. Monad m => Tracers m peer blk e
nullTracers = Tracers {
      tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer            = Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer  = Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer           = Tracer
  m
  (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer        = Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tKeepAliveTracer :: Tracer m (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer            = Tracer m (TraceLabelPeer peer (TraceSendRecv KeepAlive))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    }

showTracers :: ( Show blk
               , Show peer
               , Show (Header blk)
               , Show (GenTx blk)
               , Show (GenTxId blk)
               , HasHeader blk
               , HasNestedContent Header blk
               )
            => Tracer m String -> Tracers m peer blk e
showTracers :: forall blk peer (m :: * -> *) e.
(Show blk, Show peer, Show (Header blk), Show (GenTx blk),
 Show (GenTxId blk), HasHeader blk, HasNestedContent Header blk) =>
Tracer m String -> Tracers m peer blk e
showTracers Tracer m String
tr = Tracers {
      tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer            = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer  = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer           = Tracer m String
-> Tracer
     m
     (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer        = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tKeepAliveTracer :: Tracer m (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer            = Tracer m String
-> Tracer m (TraceLabelPeer peer (TraceSendRecv KeepAlive))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    }

{-------------------------------------------------------------------------------
  Applications
-------------------------------------------------------------------------------}

-- | A node-to-node application
type ClientApp m addr bytes a =
     NodeToNodeVersion
  -> ExpandedInitiatorContext addr m
  -> Channel m bytes
  -> m (a, Maybe bytes)

type ServerApp m addr bytes a =
     NodeToNodeVersion
  -> ResponderContext addr
  -> Channel m bytes
  -> m (a, Maybe bytes)

-- | Applications for the node-to-node protocols
--
-- See 'Network.Mux.Types.MuxApplication'
data Apps m addr bCS bBF bTX bKA bPS a b = Apps {
      -- | Start a chain sync client that communicates with the given upstream
      -- node.
      forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bCS a
aChainSyncClient     :: ClientApp m addr bCS a

      -- | Start a chain sync server.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bCS b
aChainSyncServer     :: ServerApp m addr bCS b

      -- | Start a block fetch client that communicates with the given
      -- upstream node.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bBF a
aBlockFetchClient    :: ClientApp m addr bBF a

      -- | Start a block fetch server.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bBF b
aBlockFetchServer    :: ServerApp m addr bBF b

      -- | Start a transaction submission v2 client that communicates with the
      -- given upstream node.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bTX a
aTxSubmission2Client :: ClientApp m addr bTX a

      -- | Start a transaction submission v2 server.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bTX b
aTxSubmission2Server :: ServerApp m addr bTX b

      -- | Start a keep-alive client.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bKA a
aKeepAliveClient     :: ClientApp m addr bKA a

      -- | Start a keep-alive server.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bKA b
aKeepAliveServer     :: ServerApp m addr bKA b

      -- | Start a peer-sharing client.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bPS a
aPeerSharingClient   :: ClientApp m addr bPS a

      -- | Start a peer-sharing server.
    , forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bPS b
aPeerSharingServer   :: ServerApp m addr bPS b
    }


-- | Per mini-protocol byte limits;  For each mini-protocol they provide
-- per-state byte size limits, i.e. how much data can arrive from the network.
--
-- They don't depend on the instantiation of the protocol parameters (which
-- block type is used, etc.), hence the use of 'RankNTypes'.
--
data ByteLimits bCS bBF bTX bKA = ByteLimits {
      forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall header point tip.
   ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync     :: forall header point tip.
                         ProtocolSizeLimits
                           (ChainSync  header point tip)
                           bCS

    , forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall block point.
   ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch    :: forall block point.
                         ProtocolSizeLimits
                           (BlockFetch block point)
                           bBF

    , forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2 :: forall txid tx.
                         ProtocolSizeLimits
                           (TxSubmission2 txid tx)
                           bTX

    , forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA -> ProtocolSizeLimits KeepAlive bKA
blKeepAlive     :: ProtocolSizeLimits
                           KeepAlive
                           bKA

    }

noByteLimits :: ByteLimits bCS bBF bTX bKA
noByteLimits :: forall bCS bBF bTX bKA. ByteLimits bCS bBF bTX bKA
noByteLimits = ByteLimits {
    blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync     = (bCS -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bCS
forall {k} {k1} {k2} bytes (header :: k) (point :: k1) (tip :: k2).
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync     (Word -> bCS -> Word
forall a b. a -> b -> a
const Word
0)
  , blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch    = (bBF -> Word) -> ProtocolSizeLimits (BlockFetch block point) bBF
forall {k} {k1} bytes (block :: k) (point :: k1).
(bytes -> Word)
-> ProtocolSizeLimits (BlockFetch block point) bytes
byteLimitsBlockFetch    (Word -> bBF -> Word
forall a b. a -> b -> a
const Word
0)
  , blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2 = (bTX -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall {k} {k1} bytes (txid :: k) (tx :: k1).
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 (Word -> bTX -> Word
forall a b. a -> b -> a
const Word
0)
  , blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
blKeepAlive     = (bKA -> Word) -> ProtocolSizeLimits KeepAlive bKA
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive     (Word -> bKA -> Word
forall a b. a -> b -> a
const Word
0)
  }

byteLimits :: ByteLimits ByteString ByteString ByteString ByteString
byteLimits :: ByteLimits ByteString ByteString ByteString ByteString
byteLimits = ByteLimits {
      blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) ByteString
blChainSync     = (ByteString -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) ByteString
forall {k} {k1} {k2} bytes (header :: k) (point :: k1) (tip :: k2).
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync     ByteString -> Word
size
    , blBlockFetch :: forall block point.
ProtocolSizeLimits (BlockFetch block point) ByteString
blBlockFetch    = (ByteString -> Word)
-> ProtocolSizeLimits (BlockFetch block point) ByteString
forall {k} {k1} bytes (block :: k) (point :: k1).
(bytes -> Word)
-> ProtocolSizeLimits (BlockFetch block point) bytes
byteLimitsBlockFetch    ByteString -> Word
size
    , blTxSubmission2 :: forall txid tx.
ProtocolSizeLimits (TxSubmission2 txid tx) ByteString
blTxSubmission2 = (ByteString -> Word)
-> ProtocolSizeLimits (TxSubmission2 txid tx) ByteString
forall {k} {k1} bytes (txid :: k) (tx :: k1).
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 ByteString -> Word
size
    , blKeepAlive :: ProtocolSizeLimits KeepAlive ByteString
blKeepAlive     = (ByteString -> Word) -> ProtocolSizeLimits KeepAlive ByteString
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive     ByteString -> Word
size
    }
  where
    size :: ByteString -> Word
    size :: ByteString -> Word
size = (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word)
         (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length

-- | Construct the 'NetworkApplication' for the node-to-node protocols
mkApps ::
     forall m addrNTN addrNTC blk e bCS bBF bTX bKA bPS.
     ( IOLike m
     , MonadTimer m
     , Ord addrNTN
     , Exception e
     , LedgerSupportsProtocol blk
     , ShowProxy blk
     , ShowProxy (Header blk)
     , ShowProxy (TxId (GenTx blk))
     , ShowProxy (GenTx blk)
     )
  => NodeKernel m addrNTN addrNTC blk -- ^ Needed for bracketing only
  -> Tracers m (ConnectionId addrNTN) blk e
  -> (NodeToNodeVersion -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS)
  -> ByteLimits bCS bBF bTX bKA
  -> m ChainSyncTimeout
  -> CsClient.ChainSyncLoPBucketConfig
  -> CsClient.CSJConfig
  -> ReportPeerMetrics m (ConnectionId addrNTN)
  -> Handlers m addrNTN blk
  -> Apps m addrNTN bCS bBF bTX bKA bPS NodeToNodeInitiatorResult ()
mkApps :: forall (m :: * -> *) addrNTN addrNTC blk e bCS bBF bTX bKA bPS.
(IOLike m, MonadTimer m, Ord addrNTN, Exception e,
 LedgerSupportsProtocol blk, ShowProxy blk, ShowProxy (Header blk),
 ShowProxy (TxId (GenTx blk)), ShowProxy (GenTx blk)) =>
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) blk e
-> (NodeToNodeVersion
    -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS)
-> ByteLimits bCS bBF bTX bKA
-> m ChainSyncTimeout
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m addrNTN blk
-> Apps m addrNTN bCS bBF bTX bKA bPS NodeToNodeInitiatorResult ()
mkApps NodeKernel m addrNTN addrNTC blk
kernel Tracers {Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch blk (Point blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tChainSyncTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tBlockFetchTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchSerialisedTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tKeepAliveTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tKeepAliveTracer :: Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
..} NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs ByteLimits {ProtocolSizeLimits KeepAlive bKA
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall header point tip.
   ProtocolSizeLimits (ChainSync header point tip) bCS
blBlockFetch :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall block point.
   ProtocolSizeLimits (BlockFetch block point) bBF
blTxSubmission2 :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blKeepAlive :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA -> ProtocolSizeLimits KeepAlive bKA
blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
..} m ChainSyncTimeout
genChainSyncTimeout ChainSyncLoPBucketConfig
lopBucketConfig CSJConfig
csjConfig ReportPeerMetrics {Tracer
  (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
Tracer
  (STM m)
  (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportHeader :: Tracer
  (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
reportFetch :: Tracer
  (STM m)
  (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportHeader :: forall (m :: * -> *) peerAddr.
ReportPeerMetrics m peerAddr
-> Tracer (STM m) (TraceLabelPeer peerAddr (SlotNo, Time))
reportFetch :: forall (m :: * -> *) peerAddr.
ReportPeerMetrics m peerAddr
-> Tracer
     (STM m) (TraceLabelPeer peerAddr (SizeInBytes, SlotNo, Time))
..} Handlers {NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hBlockFetchClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hTxSubmissionClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hKeepAliveClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion -> ConnectionId addr -> KeepAliveServer m ()
hPeerSharingClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
hPeerSharingServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
hChainSyncClient :: ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveServer :: NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
hPeerSharingClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
..} =
    Apps {ServerApp m addrNTN bCS ()
ServerApp m addrNTN bBF ()
ServerApp m addrNTN bTX ()
ServerApp m addrNTN bKA ()
ServerApp m addrNTN bPS ()
ClientApp m addrNTN bCS NodeToNodeInitiatorResult
ClientApp m addrNTN bBF NodeToNodeInitiatorResult
ClientApp m addrNTN bTX NodeToNodeInitiatorResult
ClientApp m addrNTN bKA NodeToNodeInitiatorResult
ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncServer :: ServerApp m addrNTN bCS ()
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingServer :: ServerApp m addrNTN bPS ()
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncServer :: ServerApp m addrNTN bCS ()
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingServer :: ServerApp m addrNTN bPS ()
..}
  where
    NodeKernel { DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
$sel:getDiffusionPipeliningSupport:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> DiffusionPipeliningSupport
getDiffusionPipeliningSupport } = NodeKernel m addrNTN addrNTC blk
kernel

    aChainSyncClient
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addrNTN m
      -> Channel m bCS
      -> m (NodeToNodeInitiatorResult, Maybe bCS)
    aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext {
                               eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId    = ConnectionId addrNTN
them,
                               eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage  = ControlMessageSTM m
controlMessageSTM,
                               eicIsBigLedgerPeer :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> IsBigLedgerPeer
eicIsBigLedgerPeer = IsBigLedgerPeer
isBigLedgerPeer
                             }
                             Channel m bCS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"ChainSyncClient"
      -- Note that it is crucial that we sync with the fetch client "outside"
      -- of registering the state for the sync client. This is needed to
      -- maintain a state invariant required by the block fetch logic: that for
      -- each candidate chain there is a corresponding block fetch client that
      -- can be used to fetch blocks for that chain.
      FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
-> ConnectionId addrNTN
-> m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall (m :: * -> *) a peer header block.
(MonadSTM m, MonadFork m, MonadCatch m, Ord peer) =>
FetchClientRegistry peer header block m -> peer -> m a -> m a
bracketSyncWithFetchClient
        (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel) ConnectionId addrNTN
them (m (NodeToNodeInitiatorResult, Maybe bCS)
 -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$
        Tracer m (TraceChainSyncClientEvent blk)
-> ChainDbView m blk
-> StrictTVar
     m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
-> STM m GsmState
-> ConnectionId addrNTN
-> NodeToNodeVersion
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> DiffusionPipeliningSupport
-> (ChainSyncStateView m blk
    -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall (m :: * -> *) peer blk a.
(IOLike m, Ord peer, LedgerSupportsProtocol blk, MonadTimer m) =>
Tracer m (TraceChainSyncClientEvent blk)
-> ChainDbView m blk
-> StrictTVar m (Map peer (ChainSyncClientHandle m blk))
-> STM m GsmState
-> peer
-> NodeToNodeVersion
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> DiffusionPipeliningSupport
-> (ChainSyncStateView m blk -> m a)
-> m a
CsClient.bracketChainSyncClient
            ((TraceChainSyncClientEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) (Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer (NodeKernel m addrNTN addrNTC blk
-> Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers NodeKernel m addrNTN addrNTC blk
kernel)))
            (ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ChainDB m blk -> ChainDbView m blk
CsClient.defaultChainDbView (NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB NodeKernel m addrNTN addrNTC blk
kernel))
            (NodeKernel m addrNTN addrNTC blk
-> StrictTVar
     m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> StrictTVar
     m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
getChainSyncHandles NodeKernel m addrNTN addrNTC blk
kernel)
            (NodeKernel m addrNTN addrNTC blk -> STM m GsmState
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState       NodeKernel m addrNTN addrNTC blk
kernel)
            ConnectionId addrNTN
them
            NodeToNodeVersion
version
            ChainSyncLoPBucketConfig
lopBucketConfig
            CSJConfig
csjConfig
            DiffusionPipeliningSupport
getDiffusionPipeliningSupport
            ((ChainSyncStateView m blk
  -> m (NodeToNodeInitiatorResult, Maybe bCS))
 -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> (ChainSyncStateView m blk
    -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \ChainSyncStateView m blk
csState -> do
              ChainSyncTimeout
chainSyncTimeout <- m ChainSyncTimeout
genChainSyncTimeout
              (ChainSyncClientResult
r, Maybe bCS
trailing) <-
                Tracer
  m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
-> ProtocolSizeLimits
     (ChainSync (Header blk) (Point blk) (Tip blk)) bCS
-> ProtocolTimeLimits
     (ChainSync (Header blk) (Point blk) (Tip blk))
-> Channel m bCS
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadTimer m,
 MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
                  ((TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
     m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer)
                  (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
                  ProtocolSizeLimits
  (ChainSync (Header blk) (Point blk) (Tip blk)) bCS
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync
                  (ChainSyncTimeout
-> ProtocolTimeLimits
     (ChainSync (Header blk) (Point blk) (Tip blk))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
chainSyncTimeout)
                  Channel m bCS
channel
                  (PeerPipelined
   (ChainSync (Header blk) (Point blk) (Tip blk))
   'AsClient
   'StIdle
   m
   ChainSyncClientResult
 -> m (ChainSyncClientResult, Maybe bCS))
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncClientPipelined
  (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClientPipelined header point tip m a
-> ClientPipelined (ChainSync header point tip) 'StIdle m a
chainSyncClientPeerPipelined
                  (ChainSyncClientPipelined
   (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
 -> PeerPipelined
      (ChainSync (Header blk) (Point blk) (Tip blk))
      'AsClient
      'StIdle
      m
      ChainSyncClientResult)
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
forall a b. (a -> b) -> a -> b
$ ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient
                      ConnectionId addrNTN
them
                      IsBigLedgerPeer
isBigLedgerPeer
                      CsClient.DynamicEnv {
                          NodeToNodeVersion
version :: NodeToNodeVersion
$sel:version:DynamicEnv :: NodeToNodeVersion
CsClient.version
                        , ControlMessageSTM m
controlMessageSTM :: ControlMessageSTM m
$sel:controlMessageSTM:DynamicEnv :: ControlMessageSTM m
CsClient.controlMessageSTM
                        , $sel:headerMetricsTracer:DynamicEnv :: HeaderMetricsTracer m
CsClient.headerMetricsTracer = ConnectionId addrNTN
-> (SlotNo, Time)
-> TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them ((SlotNo, Time)
 -> TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
-> Tracer
     (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
-> HeaderMetricsTracer m
forall a' a. (a' -> a) -> Tracer (STM m) a -> Tracer (STM m) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
reportHeader
                        , $sel:setCandidate:DynamicEnv :: AnchoredFragment (Header blk) -> STM m ()
CsClient.setCandidate = ChainSyncStateView m blk
-> AnchoredFragment (Header blk) -> STM m ()
forall (m :: * -> *) blk.
ChainSyncStateView m blk
-> AnchoredFragment (Header blk) -> STM m ()
csvSetCandidate ChainSyncStateView m blk
csState
                        , $sel:idling:DynamicEnv :: Idling m
CsClient.idling = ChainSyncStateView m blk -> Idling m
forall (m :: * -> *) blk. ChainSyncStateView m blk -> Idling m
csvIdling ChainSyncStateView m blk
csState
                        , $sel:loPBucket:DynamicEnv :: LoPBucket m
CsClient.loPBucket = ChainSyncStateView m blk -> LoPBucket m
forall (m :: * -> *) blk. ChainSyncStateView m blk -> LoPBucket m
csvLoPBucket ChainSyncStateView m blk
csState
                        , $sel:setLatestSlot:DynamicEnv :: WithOrigin SlotNo -> STM m ()
CsClient.setLatestSlot = ChainSyncStateView m blk -> WithOrigin SlotNo -> STM m ()
forall (m :: * -> *) blk.
ChainSyncStateView m blk -> WithOrigin SlotNo -> STM m ()
csvSetLatestSlot ChainSyncStateView m blk
csState
                        , $sel:jumping:DynamicEnv :: Jumping m blk
CsClient.jumping = ChainSyncStateView m blk -> Jumping m blk
forall (m :: * -> *) blk. ChainSyncStateView m blk -> Jumping m blk
csvJumping ChainSyncStateView m blk
csState
                        }
              (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainSyncClientResult -> NodeToNodeInitiatorResult
ChainSyncInitiatorResult ChainSyncClientResult
r, Maybe bCS
trailing)

    aChainSyncServer
      :: NodeToNodeVersion
      -> ResponderContext addrNTN
      -> Channel m bCS
      -> m ((), Maybe bCS)
    aChainSyncServer :: ServerApp m addrNTN bCS ()
aChainSyncServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bCS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"ChainSyncServer"
      ChainSyncTimeout
chainSyncTimeout <- m ChainSyncTimeout
genChainSyncTimeout
      (ResourceRegistry m
 -> m (Follower m blk (WithPoint blk (SerialisedHeader blk))))
-> (Follower m blk (WithPoint blk (SerialisedHeader blk)) -> m ())
-> (Follower m blk (WithPoint blk (SerialisedHeader blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall (m :: * -> *) a r.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> (a -> m ()) -> (a -> m r) -> m r
bracketWithPrivateRegistry
        (ChainDB m blk
-> ChainType
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (SerialisedHeader blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> ChainType
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (SerialisedHeader blk)))
chainSyncHeaderServerFollower
           (NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB NodeKernel m addrNTN addrNTC blk
kernel)
           ( case DiffusionPipeliningSupport
getDiffusionPipeliningSupport of
              DiffusionPipeliningSupport
DiffusionPipeliningOn  -> ChainType
ChainDB.TentativeChain
              DiffusionPipeliningSupport
DiffusionPipeliningOff -> ChainType
ChainDB.SelectedChain
           )
        )
        Follower m blk (WithPoint blk (SerialisedHeader blk)) -> m ()
forall (m :: * -> *) blk a. Follower m blk a -> m ()
ChainDB.followerClose
        ((Follower m blk (WithPoint blk (SerialisedHeader blk))
  -> m ((), Maybe bCS))
 -> m ((), Maybe bCS))
-> (Follower m blk (WithPoint blk (SerialisedHeader blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \Follower m blk (WithPoint blk (SerialisedHeader blk))
flr ->
          Tracer
  m
  (TraceSendRecv
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bCS
-> ProtocolSizeLimits
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) bCS
-> ProtocolTimeLimits
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
-> Channel m bCS
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
            ((TraceSendRecv
   (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv
         (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer)
            (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bCS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
            ProtocolSizeLimits
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) bCS
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync
            (ChainSyncTimeout
-> ProtocolTimeLimits
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
chainSyncTimeout)
            Channel m bCS
channel
            (Peer
   (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
   'AsServer
   'NonPipelined
   'StIdle
   m
   ()
 -> m ((), Maybe bCS))
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Server (ChainSync header point tip) 'NonPipelined 'StIdle m a
chainSyncServerPeer
            (ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
 -> Peer
      (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
      'AsServer
      'NonPipelined
      'StIdle
      m
      ())
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
forall a b. (a -> b) -> a -> b
$ ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer ConnectionId addrNTN
them NodeToNodeVersion
version Follower m blk (WithPoint blk (SerialisedHeader blk))
flr

    aBlockFetchClient
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addrNTN m
      -> Channel m bBF
      -> m (NodeToNodeInitiatorResult, Maybe bBF)
    aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext {
                                eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId   = ConnectionId addrNTN
them,
                                eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
                              }
                              Channel m bBF
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchClient"
      FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
-> NodeToNodeVersion
-> ConnectionId addrNTN
-> (FetchClientContext (Header blk) blk m
    -> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall (m :: * -> *) a peer header block version.
(MonadFork m, MonadMask m, MonadTimer m, Ord peer) =>
FetchClientRegistry peer header block m
-> version
-> peer
-> (FetchClientContext header block m -> m a)
-> m a
bracketFetchClient (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel) NodeToNodeVersion
version
                         ConnectionId addrNTN
them ((FetchClientContext (Header blk) blk m
  -> m (NodeToNodeInitiatorResult, Maybe bBF))
 -> m (NodeToNodeInitiatorResult, Maybe bBF))
-> (FetchClientContext (Header blk) blk m
    -> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall a b. (a -> b) -> a -> b
$ \FetchClientContext (Header blk) blk m
clientCtx -> do
        ((), Maybe bBF
trailing) <- Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
-> Codec (BlockFetch blk (Point blk)) e m bBF
-> ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
-> ProtocolTimeLimits (BlockFetch blk (Point blk))
-> Channel m bBF
-> PeerPipelined
     (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadTimer m,
 MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
          ((TraceSendRecv (BlockFetch blk (Point blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (BlockFetch blk (Point blk))
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceSendRecv (BlockFetch blk (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer)
          (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (BlockFetch blk (Point blk)) e m bBF
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
          ProtocolTimeLimits (BlockFetch blk (Point blk))
forall {k} {k1} (block :: k) (point :: k1).
ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
          Channel m bBF
channel
          (PeerPipelined (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
 -> m ((), Maybe bBF))
-> PeerPipelined
     (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM
                              (ConnectionId addrNTN
-> (SizeInBytes, SlotNo, Time)
-> TraceLabelPeer
     (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them ((SizeInBytes, SlotNo, Time)
 -> TraceLabelPeer
      (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
-> Tracer
     (STM m)
     (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
-> FetchedMetricsTracer m
forall a' a. (a' -> a) -> Tracer (STM m) a -> Tracer (STM m) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  (STM m)
  (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportFetch) FetchClientContext (Header blk) blk m
clientCtx
        (NodeToNodeInitiatorResult, Maybe bBF)
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bBF
trailing)

    aBlockFetchServer
      :: NodeToNodeVersion
      -> ResponderContext addrNTN
      -> Channel m bBF
      -> m ((), Maybe bBF)
    aBlockFetchServer :: ServerApp m addrNTN bBF ()
aBlockFetchServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bBF
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchServer"
      (ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
withRegistry ((ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF))
-> (ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry m
registry ->
        Tracer m (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bBF
-> ProtocolSizeLimits (BlockFetch (Serialised blk) (Point blk)) bBF
-> ProtocolTimeLimits (BlockFetch (Serialised blk) (Point blk))
-> Channel m bBF
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
-> m ((), Maybe bBF)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
          ((TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
     m (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer)
          (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bBF
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits (BlockFetch (Serialised blk) (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
          ProtocolTimeLimits (BlockFetch (Serialised blk) (Point blk))
forall {k} {k1} (block :: k) (point :: k1).
ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
          Channel m bBF
channel
          (Peer
   (BlockFetch (Serialised blk) (Point blk))
   'AsServer
   'NonPipelined
   'BFIdle
   m
   ()
 -> m ((), Maybe bBF))
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
-> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ BlockFetchServer (Serialised blk) (Point blk) m ()
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
forall block point (m :: * -> *) a.
Functor m =>
BlockFetchServer block point m a
-> Server (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchServerPeer
          (BlockFetchServer (Serialised blk) (Point blk) m ()
 -> Peer
      (BlockFetch (Serialised blk) (Point blk))
      'AsServer
      'NonPipelined
      'BFIdle
      m
      ())
-> BlockFetchServer (Serialised blk) (Point blk) m ()
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
forall a b. (a -> b) -> a -> b
$ ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer ConnectionId addrNTN
them NodeToNodeVersion
version ResourceRegistry m
registry

    aTxSubmission2Client
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addrNTN m
      -> Channel m bTX
      -> m (NodeToNodeInitiatorResult, Maybe bTX)
    aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext {
                                   eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId   = ConnectionId addrNTN
them,
                                   eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
                                 }
                                 Channel m bTX
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionClient"
      ((), Maybe bTX
trailing) <- Tracer
  m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
-> ProtocolSizeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
-> ProtocolTimeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> Channel m bTX
-> Peer
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsClient
     'NonPipelined
     'StInit
     m
     ()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        ((TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tTxSubmission2Tracer)
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
        ProtocolTimeLimits (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
forall {k} {k1} (txid :: k) (tx :: k1).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
        Channel m bTX
channel
        (TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
-> Peer
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsClient
     'NonPipelined
     'StInit
     m
     ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Client (TxSubmission2 txid tx) 'NonPipelined 'StInit m a
txSubmissionClientPeer (NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them))
      (NodeToNodeInitiatorResult, Maybe bTX)
-> m (NodeToNodeInitiatorResult, Maybe bTX)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bTX
trailing)

    aTxSubmission2Server
      :: NodeToNodeVersion
      -> ResponderContext addrNTN
      -> Channel m bTX
      -> m ((), Maybe bTX)
    aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aTxSubmission2Server NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bTX
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionServer"
      Tracer
  m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
-> ProtocolSizeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
-> ProtocolTimeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> Channel m bTX
-> PeerPipelined
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsServer
     'StInit
     m
     ()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadTimer m,
 MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
        ((TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tTxSubmission2Tracer)
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
        ProtocolTimeLimits (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
forall {k} {k1} (txid :: k) (tx :: k1).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
        Channel m bTX
channel
        (TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
-> PeerPipelined
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsServer
     'StInit
     m
     ()
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> ServerPipelined (TxSubmission2 txid tx) 'StInit m a
txSubmissionServerPeerPipelined (NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionServer NodeToNodeVersion
version ConnectionId addrNTN
them))

    aKeepAliveClient
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addrNTN m
      -> Channel m bKA
      -> m (NodeToNodeInitiatorResult, Maybe bKA)
    aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext {
                               eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId   = ConnectionId addrNTN
them,
                               eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
                             }
                             Channel m bKA
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveClient"
      let kacApp :: StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA)
kacApp = \StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
dqCtx ->
                       Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive e m bKA
-> ProtocolSizeLimits KeepAlive bKA
-> ProtocolTimeLimits KeepAlive
-> Channel m bKA
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
                         (ConnectionId addrNTN
-> TraceSendRecv KeepAlive
-> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv KeepAlive
 -> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer
     m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer m (TraceSendRecv KeepAlive)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
tKeepAliveTracer)
                         (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec KeepAlive e m bKA
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
                         ProtocolSizeLimits KeepAlive bKA
blKeepAlive
                         ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
                         Channel m bKA
channel
                         (Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
 -> m ((), Maybe bKA))
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall a b. (a -> b) -> a -> b
$ KeepAliveClient m ()
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientPeer
                         (KeepAliveClient m ()
 -> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ())
-> KeepAliveClient m ()
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
dqCtx
                             (DiffTime -> KeepAliveInterval
KeepAliveInterval DiffTime
10)

      ((), Maybe bKA
trailing) <- FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
-> ConnectionId addrNTN
-> (StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
    -> m ((), Maybe bKA))
-> m ((), Maybe bKA)
forall (m :: * -> *) a peer header block.
(MonadSTM m, MonadFork m, MonadMask m, Ord peer) =>
FetchClientRegistry peer header block m
-> peer -> (StrictTVar m (Map peer PeerGSV) -> m a) -> m a
bracketKeepAliveClient (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel) ConnectionId addrNTN
them StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA)
kacApp
      (NodeToNodeInitiatorResult, Maybe bKA)
-> m (NodeToNodeInitiatorResult, Maybe bKA)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bKA
trailing)

    aKeepAliveServer
      :: NodeToNodeVersion
      -> ResponderContext addrNTN
      -> Channel m bKA
      -> m ((), Maybe bKA)
    aKeepAliveServer :: ServerApp m addrNTN bKA ()
aKeepAliveServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bKA
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveServer"
      Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive e m bKA
-> ProtocolSizeLimits KeepAlive bKA
-> ProtocolTimeLimits KeepAlive
-> Channel m bKA
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        (ConnectionId addrNTN
-> TraceSendRecv KeepAlive
-> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv KeepAlive
 -> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer
     m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer m (TraceSendRecv KeepAlive)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
tKeepAliveTracer)
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec KeepAlive e m bKA
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
        ((bKA -> Word) -> ProtocolSizeLimits KeepAlive bKA
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive (Word -> bKA -> Word
forall a b. a -> b -> a
const Word
0)) -- TODO: Real Bytelimits, see #1727
        ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
        Channel m bKA
channel
        (Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
 -> m ((), Maybe bKA))
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Server KeepAlive 'NonPipelined 'StClient m a
keepAliveServerPeer
        (KeepAliveServer m ()
 -> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ())
-> KeepAliveServer m ()
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer


    aPeerSharingClient
      :: NodeToNodeVersion
      -> ExpandedInitiatorContext addrNTN m
      -> Channel m bPS
      -> m (NodeToNodeInitiatorResult, Maybe bPS)
    aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext {
                                 eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId   = ConnectionId addrNTN
them,
                                 eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
                               }
                               Channel m bPS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingClient"
      PeerSharingRegistry addrNTN m
-> addrNTN
-> (PeerSharingController addrNTN m
    -> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall peer (m :: * -> *) a.
(Ord peer, MonadSTM m, MonadThrow m) =>
PeerSharingRegistry peer m
-> peer -> (PeerSharingController peer m -> m a) -> m a
bracketPeerSharingClient (NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
getPeerSharingRegistry NodeKernel m addrNTN addrNTC blk
kernel) (ConnectionId addrNTN -> addrNTN
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId addrNTN
them)
        ((PeerSharingController addrNTN m
  -> m (NodeToNodeInitiatorResult, Maybe bPS))
 -> m (NodeToNodeInitiatorResult, Maybe bPS))
-> (PeerSharingController addrNTN m
    -> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall a b. (a -> b) -> a -> b
$ \PeerSharingController addrNTN m
controller -> do
          PeerSharingClient addrNTN m ()
psClient <- NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them PeerSharingController addrNTN m
controller
          ((), Maybe bPS
trailing) <- Tracer m (TraceSendRecv (PeerSharing addrNTN))
-> Codec (PeerSharing addrNTN) e m bPS
-> ProtocolSizeLimits (PeerSharing addrNTN) bPS
-> ProtocolTimeLimits (PeerSharing addrNTN)
-> Channel m bPS
-> Peer (PeerSharing addrNTN) 'AsClient 'NonPipelined 'StIdle m ()
-> m ((), Maybe bPS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
            -- TODO: add tracer
            Tracer m (TraceSendRecv (PeerSharing addrNTN))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
            (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (PeerSharing addrNTN) e m bPS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
            ((bPS -> Word) -> ProtocolSizeLimits (PeerSharing addrNTN) bPS
forall {k} (peerAddress :: k) bytes.
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing (Word -> bPS -> Word
forall a b. a -> b -> a
const Word
0))
            ProtocolTimeLimits (PeerSharing addrNTN)
forall {k} (peerAddress :: k).
ProtocolTimeLimits (PeerSharing peerAddress)
timeLimitsPeerSharing
            Channel m bPS
channel
            (PeerSharingClient addrNTN m ()
-> Peer (PeerSharing addrNTN) 'AsClient 'NonPipelined 'StIdle m ()
forall (m :: * -> *) peerAddress a.
Monad m =>
PeerSharingClient peerAddress m a
-> Client (PeerSharing peerAddress) 'NonPipelined 'StIdle m a
peerSharingClientPeer PeerSharingClient addrNTN m ()
psClient)
          (NodeToNodeInitiatorResult, Maybe bPS)
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bPS
trailing)

    aPeerSharingServer
      :: NodeToNodeVersion
      -> ResponderContext addrNTN
      -> Channel m bPS
      -> m ((), Maybe bPS)
    aPeerSharingServer :: ServerApp m addrNTN bPS ()
aPeerSharingServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bPS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingServer"
      Tracer m (TraceSendRecv (PeerSharing addrNTN))
-> Codec (PeerSharing addrNTN) e m bPS
-> ProtocolSizeLimits (PeerSharing addrNTN) bPS
-> ProtocolTimeLimits (PeerSharing addrNTN)
-> Channel m bPS
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
-> m ((), Maybe bPS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        -- TODO: add tracer
        Tracer m (TraceSendRecv (PeerSharing addrNTN))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (PeerSharing addrNTN) e m bPS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
        ((bPS -> Word) -> ProtocolSizeLimits (PeerSharing addrNTN) bPS
forall {k} (peerAddress :: k) bytes.
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing (Word -> bPS -> Word
forall a b. a -> b -> a
const Word
0))
        ProtocolTimeLimits (PeerSharing addrNTN)
forall {k} (peerAddress :: k).
ProtocolTimeLimits (PeerSharing peerAddress)
timeLimitsPeerSharing
        Channel m bPS
channel
        (Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
 -> m ((), Maybe bPS))
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
-> m ((), Maybe bPS)
forall a b. (a -> b) -> a -> b
$ PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ()
peerSharingServerPeer
        (PeerSharingServer addrNTN m
 -> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ())
-> PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hPeerSharingServer NodeToNodeVersion
version ConnectionId addrNTN
them

{-------------------------------------------------------------------------------
  Projections from 'Apps'
-------------------------------------------------------------------------------}

-- | A projection from 'NetworkApplication' to a client-side
-- 'OuroborosApplication' for the node-to-node protocols.
--
-- Implementation note: network currently doesn't enable protocols conditional
-- on the protocol version, but it eventually may; this is why @_version@ is
-- currently unused.
initiator ::
     MiniProtocolParameters
  -> NodeToNodeVersion
  -> PSTypes.PeerSharing
  -> Apps m addr b b b b b a c
  -> OuroborosBundleWithExpandedCtx 'InitiatorMode addr b m a Void
initiator :: forall (m :: * -> *) addr b a c.
MiniProtocolParameters
-> NodeToNodeVersion
-> PeerSharing
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx 'InitiatorMode addr b m a Void
initiator MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version PeerSharing
ownPeerSharing Apps {ServerApp m addr b c
ClientApp m addr b a
aChainSyncClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bCS a
aChainSyncServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bCS b
aBlockFetchClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bBF a
aBlockFetchServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bBF b
aTxSubmission2Client :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bTX a
aTxSubmission2Server :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bTX b
aKeepAliveClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bKA a
aKeepAliveServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bKA b
aPeerSharingClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bPS a
aPeerSharingServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bPS b
aChainSyncClient :: ClientApp m addr b a
aChainSyncServer :: ServerApp m addr b c
aBlockFetchClient :: ClientApp m addr b a
aBlockFetchServer :: ServerApp m addr b c
aTxSubmission2Client :: ClientApp m addr b a
aTxSubmission2Server :: ServerApp m addr b c
aKeepAliveClient :: ClientApp m addr b a
aKeepAliveServer :: ServerApp m addr b c
aPeerSharingClient :: ClientApp m addr b a
aPeerSharingServer :: ServerApp m addr b c
..} =
    MiniProtocolParameters
-> NodeToNodeProtocols
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall (muxMode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocolParameters
-> NodeToNodeProtocols
     muxMode initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
      MiniProtocolParameters
miniProtocolParameters
      -- TODO: currently consensus is using 'ConnectionId' for its 'peer' type.
      -- This is currently ok, as we might accept multiple connections from the
      -- same ip address, however this will change when we will switch to
      -- p2p-governor & connection-manager.  Then consensus can use peer's ip
      -- address & port number, rather than 'ConnectionId' (which is
      -- a quadruple uniquely determining a connection).
      (NodeToNodeProtocols {
          chainSyncProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  Void
chainSyncProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
          blockFetchProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  Void
blockFetchProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
          txSubmissionProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  Void
txSubmissionProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
          keepAliveProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  Void
keepAliveProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
          peerSharingProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  Void
peerSharingProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx)))
        })
      NodeToNodeVersion
version
      PeerSharing
ownPeerSharing

-- | A bi-directional network application.
--
-- Implementation note: network currently doesn't enable protocols conditional
-- on the protocol version, but it eventually may; this is why @_version@ is
-- currently unused.
initiatorAndResponder ::
     MiniProtocolParameters
  -> NodeToNodeVersion
  -> PSTypes.PeerSharing
  -> Apps m addr b b b b b a c
  -> OuroborosBundleWithExpandedCtx 'InitiatorResponderMode addr b m a c
initiatorAndResponder :: forall (m :: * -> *) addr b a c.
MiniProtocolParameters
-> NodeToNodeVersion
-> PeerSharing
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr b m a c
initiatorAndResponder MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version PeerSharing
ownPeerSharing Apps {ServerApp m addr b c
ClientApp m addr b a
aChainSyncClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bCS a
aChainSyncServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bCS b
aBlockFetchClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bBF a
aBlockFetchServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bBF b
aTxSubmission2Client :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bTX a
aTxSubmission2Server :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bTX b
aKeepAliveClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bKA a
aKeepAliveServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bKA b
aPeerSharingClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bPS a
aPeerSharingServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bPS b
aChainSyncClient :: ClientApp m addr b a
aChainSyncServer :: ServerApp m addr b c
aBlockFetchClient :: ClientApp m addr b a
aBlockFetchServer :: ServerApp m addr b c
aTxSubmission2Client :: ClientApp m addr b a
aTxSubmission2Server :: ServerApp m addr b c
aKeepAliveClient :: ClientApp m addr b a
aKeepAliveServer :: ServerApp m addr b c
aPeerSharingClient :: ClientApp m addr b a
aPeerSharingServer :: ServerApp m addr b c
..} =
    MiniProtocolParameters
-> NodeToNodeProtocols
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
forall (muxMode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocolParameters
-> NodeToNodeProtocols
     muxMode initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
      MiniProtocolParameters
miniProtocolParameters
      (NodeToNodeProtocols {
          chainSyncProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  c
chainSyncProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
              ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
              ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aChainSyncServer NodeToNodeVersion
version ResponderContext addr
responderCtx))),
          blockFetchProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  c
blockFetchProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
              ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
              ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aBlockFetchServer NodeToNodeVersion
version ResponderContext addr
responderCtx))),
          txSubmissionProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  c
txSubmissionProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
              ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
              ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aTxSubmission2Server NodeToNodeVersion
version ResponderContext addr
responderCtx))),
          keepAliveProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  c
keepAliveProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
              ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
              ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aKeepAliveServer NodeToNodeVersion
version ResponderContext addr
responderCtx))),

          peerSharingProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr m)
  (ResponderContext addr)
  b
  m
  a
  c
peerSharingProtocol =
            (MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
              ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
              ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aPeerSharingServer NodeToNodeVersion
version ResponderContext addr
responderCtx)))
        })
      NodeToNodeVersion
version
      PeerSharing
ownPeerSharing