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

-- | 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           Codec.CBOR.Encoding (Encoding)
import           Codec.CBOR.Read (DeserialiseFailure)
import           Control.Monad.Class.MonadTime (MonadTime)
import           Control.Monad.Class.MonadTimer (MonadTimer)
import           Control.Tracer
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import           Data.Int (Int64)
import           Data.Map.Strict (Map)
import           Data.Void (Void)

import           Network.TypedProtocol.Codec

import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
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.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, HeaderMetricsTracer,
                     ReportPeerMetrics (..))
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.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

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
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.Util (ShowProxy)
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Consensus.Util.ResourceRegistry

import           Ouroboros.Consensus.Storage.Serialisation (SerialisedHeader)

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

-- | Protocol handlers for node-to-node (remote) communication
data Handlers m peer blk = Handlers {
      Handlers m peer blk
-> peer
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient
        :: peer
        -> NodeToNodeVersion
        -> ControlMessageSTM m
        -> HeaderMetricsTracer m
        -> StrictTVar m (AnchoredFragment (Header blk))
        -> ChainSyncClientPipelined (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
        -- TODO: we should consider either bundling these context parameters
        -- into a record, or 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.

    , Handlers m peer blk
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer
        :: 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.
    , Handlers m peer blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> FetchedMetricsTracer m
        -> BlockFetchClient (Header blk) blk m ()

    , Handlers m peer blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer
        :: NodeToNodeVersion
        -> ResourceRegistry m
        -> BlockFetchServer (Serialised blk) (Point blk) m ()

    , Handlers m peer blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> peer
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> peer
        -> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()

    , Handlers m peer blk
-> NodeToNodeVersion
-> peer
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer
        :: NodeToNodeVersion
        -> peer
        -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()

    , Handlers m peer blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient
        :: NodeToNodeVersion
        -> ControlMessageSTM m
        -> peer
        -> StrictTVar m (Map peer PeerGSV)
        -> KeepAliveInterval
        -> KeepAliveClient m ()

    , Handlers m peer blk
-> NodeToNodeVersion -> peer -> KeepAliveServer m ()
hKeepAliveServer
        :: NodeToNodeVersion
        -> peer
        -> KeepAliveServer m ()
    }

mkHandlers
  :: forall m blk remotePeer localPeer.
     ( IOLike m
     , MonadTime m
     , MonadTimer m
     , LedgerSupportsMempool blk
     , HasTxId (GenTx blk)
     , LedgerSupportsProtocol blk
     , Ord remotePeer
     )
  => NodeKernelArgs m remotePeer localPeer blk
  -> NodeKernel     m remotePeer localPeer blk
  -> Handlers       m remotePeer           blk
mkHandlers :: NodeKernelArgs m remotePeer localPeer blk
-> NodeKernel m remotePeer localPeer blk
-> Handlers m remotePeer blk
mkHandlers
      NodeKernelArgs {StdGen
$sel:keepAliveRng:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> StdGen
keepAliveRng :: StdGen
keepAliveRng, MiniProtocolParameters
$sel:miniProtocolParameters:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> MiniProtocolParameters
miniProtocolParameters :: MiniProtocolParameters
miniProtocolParameters}
      NodeKernel {ChainDB m blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB :: ChainDB m blk
getChainDB, Mempool m blk TicketNo
$sel:getMempool:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> Mempool m blk TicketNo
getMempool :: Mempool m blk TicketNo
getMempool, TopLevelConfig blk
$sel:getTopLevelConfig:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> TopLevelConfig blk
getTopLevelConfig :: TopLevelConfig blk
getTopLevelConfig, $sel:getTracers:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk
-> Tracers m remotePeer localPeer blk
getTracers = Tracers m remotePeer localPeer blk
tracers} =
    Handlers :: forall (m :: * -> *) peer blk.
(peer
 -> NodeToNodeVersion
 -> ControlMessageSTM m
 -> HeaderMetricsTracer m
 -> StrictTVar m (AnchoredFragment (Header blk))
 -> ChainSyncClientPipelined
      (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult)
-> (NodeToNodeVersion
    -> Follower m blk (WithPoint blk (SerialisedHeader blk))
    -> ChainSyncServer
         (SerialisedHeader blk) (Point blk) (Tip blk) m ())
-> (NodeToNodeVersion
    -> ControlMessageSTM m
    -> FetchedMetricsTracer m
    -> BlockFetchClient (Header blk) blk m ())
-> (NodeToNodeVersion
    -> ResourceRegistry m
    -> BlockFetchServer (Serialised blk) (Point blk) m ())
-> (NodeToNodeVersion
    -> ControlMessageSTM m
    -> peer
    -> TxSubmissionClient (GenTxId blk) (GenTx blk) m ())
-> (NodeToNodeVersion
    -> peer
    -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
-> (NodeToNodeVersion
    -> ControlMessageSTM m
    -> peer
    -> StrictTVar m (Map peer PeerGSV)
    -> KeepAliveInterval
    -> KeepAliveClient m ())
-> (NodeToNodeVersion -> peer -> KeepAliveServer m ())
-> Handlers m peer blk
Handlers {
        hChainSyncClient :: remotePeer
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient = \remotePeer
peer ->
          MkPipelineDecision
-> Tracer m (TraceChainSyncClientEvent blk)
-> TopLevelConfig blk
-> ChainDbView m blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
MkPipelineDecision
-> Tracer m (TraceChainSyncClientEvent blk)
-> TopLevelConfig blk
-> ChainDbView m blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> Consensus ChainSyncClientPipelined blk m
chainSyncClient
            (Word32 -> Word32 -> MkPipelineDecision
pipelineDecisionLowHighMark
              (MiniProtocolParameters -> Word32
chainSyncPipeliningLowMark  MiniProtocolParameters
miniProtocolParameters)
              (MiniProtocolParameters -> Word32
chainSyncPipeliningHighMark MiniProtocolParameters
miniProtocolParameters))
            ((TraceChainSyncClientEvent blk
 -> TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> Tracer
     m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
peer) (Tracers m remotePeer localPeer blk
-> Tracer
     m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer Tracers m remotePeer localPeer blk
tracers))
            TopLevelConfig blk
getTopLevelConfig
            (ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ChainDB m blk -> ChainDbView m blk
defaultChainDbView ChainDB m blk
getChainDB)
      , hChainSyncServer :: NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer = \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
            (Tracers m remotePeer localPeer blk
-> Tracer m (TraceChainSyncServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceChainSyncServerEvent blk)
Node.chainSyncServerHeaderTracer Tracers m remotePeer localPeer 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 (m :: * -> *).
(MonadSTM m, MonadThrow m, MonadTime m, HasHeader header,
 HasHeader block, HeaderHash header ~ HeaderHash block) =>
NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> FetchClientContext header block m
-> PeerPipelined
     (BlockFetch block (Point block)) 'AsClient 'BFIdle m ()
blockFetchClient
      , hBlockFetchServer :: NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer = \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
            (Tracers m remotePeer localPeer blk
-> Tracer m (TraceBlockFetchServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceBlockFetchServerEvent blk)
Node.blockFetchServerTracer Tracers m remotePeer localPeer blk
tracers)
            ChainDB m blk
getChainDB
            NodeToNodeVersion
version
      , hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient = \NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM remotePeer
peer ->
          Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
-> Word16
-> 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)
-> Word16
-> TxSubmissionMempoolReader txid tx idx m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> TxSubmissionClient txid tx m ()
txSubmissionOutbound
            ((TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
peer) (Tracers m remotePeer localPeer blk
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (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 remotePeer localPeer blk
tracers))
            (MiniProtocolParameters -> Word16
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 TicketNo
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk TicketNo
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk TicketNo
getMempool)
            NodeToNodeVersion
version
            ControlMessageSTM m
controlMessageSTM
      , hTxSubmissionServer :: NodeToNodeVersion
-> remotePeer
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer = \NodeToNodeVersion
version remotePeer
peer ->
          Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> Word16
-> 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) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> Word16
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolWriter txid tx idx m
-> NodeToNodeVersion
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInbound
            ((TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
peer) (Tracers m remotePeer localPeer blk
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (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 remotePeer localPeer blk
tracers))
            (MiniProtocolParameters -> Word16
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 TicketNo
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk TicketNo
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk TicketNo
getMempool)
            (Mempool m blk TicketNo
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
forall blk (m :: * -> *).
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk TicketNo
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
getMempoolWriter Mempool m blk TicketNo
getMempool)
            NodeToNodeVersion
version
      , hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> StrictTVar m (Map remotePeer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient = \NodeToNodeVersion
_version -> Tracer m (TraceKeepAliveClient remotePeer)
-> StdGen
-> ControlMessageSTM m
-> remotePeer
-> StrictTVar m (Map remotePeer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
forall (m :: * -> *) peer.
(MonadSTM m, MonadMonotonicTime m, MonadTimer m, Ord peer) =>
Tracer m (TraceKeepAliveClient peer)
-> StdGen
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
keepAliveClient (Tracers m remotePeer localPeer blk
-> Tracer m (TraceKeepAliveClient remotePeer)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
Node.keepAliveClientTracer Tracers m remotePeer localPeer blk
tracers) StdGen
keepAliveRng
      , hKeepAliveServer :: NodeToNodeVersion -> remotePeer -> KeepAliveServer m ()
hKeepAliveServer = \NodeToNodeVersion
_version remotePeer
_peer -> KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer
      }

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

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

-- | Protocol codecs for the node-to-node protocols
defaultCodecs :: forall m blk. (IOLike m, SerialiseNodeToNodeConstraints blk)
              => CodecConfig       blk
              -> BlockNodeToNodeVersion blk
              -> NodeToNodeVersion
              -> Codecs blk DeserialiseFailure m
                   ByteString ByteString ByteString ByteString ByteString ByteString
defaultCodecs :: CodecConfig blk
-> BlockNodeToNodeVersion blk
-> NodeToNodeVersion
-> Codecs
     blk
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
defaultCodecs CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version NodeToNodeVersion
_nodeToNodeVersion = Codecs :: forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
-> Codec (BlockFetch blk (Point blk)) e m bBF
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
-> Codec KeepAlive e m bKA
-> Codecs blk e m bCS bSCS bBF bSBF bTX bKA
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
          forall s. Decoder s (Header blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(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 block.
(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 blk. (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 blk.
(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
          forall s. Decoder s (SerialisedHeader blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(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 block.
(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 blk. (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 blk.
(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
          forall s. Decoder s blk
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(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 block.
(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
          forall s. Decoder s (Serialised blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(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 block.
(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
          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
          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
    }
  where
    p :: Proxy blk
    p :: Proxy blk
p = Proxy blk
forall k (t :: k). Proxy t
Proxy

    enc :: SerialiseNodeToNode blk a => a -> Encoding
    enc :: 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 s. 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 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)
identityCodecs :: Codecs
  blk
  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)
identityCodecs = Codecs :: forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
-> Codec (BlockFetch blk (Point blk)) e m bBF
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
-> Codec KeepAlive e m bKA
-> Codecs blk e m bCS bSCS bBF bSBF bTX bKA
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 k1 k2 k3 (header :: k1) (point :: k2) (tip :: k3)
       (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 k1 k2 k3 (header :: k1) (point :: k2) (tip :: k3)
       (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 k1 k2 (block :: k1) (point :: k2) (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 k1 k2 (block :: k1) (point :: k2) (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 k1 k2 (txid :: k1) (tx :: k2) (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
    }

{-------------------------------------------------------------------------------
  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 {
      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))))
    , 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))))
    , Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer           :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
    , Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
    , Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer        :: f (TraceLabelPeer peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
    }

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 :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracers' peer blk e f
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
      }
    where
      f :: forall a. Semigroup a
        => (Tracers' peer blk e f -> a)
        -> a
      f :: (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 :: Tracers m peer blk e
nullTracers = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracers' peer blk e f
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
    }

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 :: Tracer m String -> Tracers m peer blk e
showTracers Tracer m String
tr = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracers' peer blk e f
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
    }

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

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

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

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

      -- | Start a chain sync server.
    , Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bCS a
aChainSyncServer     :: ServerApp m peer bCS a

      -- | Start a block fetch client that communicates with the given
      -- upstream node.
    , Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bBF a
aBlockFetchClient    :: ClientApp m peer bBF a

      -- | Start a block fetch server.
    , Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bBF a
aBlockFetchServer    :: ServerApp m peer bBF a

      -- | Start a transaction submission v2 client that communicates with the
      -- given upstream node.
    , Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bTX a
aTxSubmission2Client :: ClientApp m peer bTX a

      -- | Start a transaction submission v2 server.
    , Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bTX a
aTxSubmission2Server :: ServerApp m peer bTX a

      -- | Start a keep-alive client.
    , Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bKA a
aKeepAliveClient     :: ClientApp m peer bKA a

      -- | Start a keep-alive server.
    , Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bKA a
aKeepAliveServer     :: ServerApp m peer bKA a
    }


-- | 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 {
      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

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

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

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

    }

noByteLimits :: ByteLimits bCS bBF bTX bKA
noByteLimits :: ByteLimits bCS bBF bTX bKA
noByteLimits = ByteLimits :: forall bCS bBF bTX bKA.
(forall header point tip.
 ProtocolSizeLimits (ChainSync header point tip) bCS)
-> (forall block point.
    ProtocolSizeLimits (BlockFetch block point) bBF)
-> (forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX)
-> ProtocolSizeLimits KeepAlive bKA
-> ByteLimits bCS bBF bTX bKA
ByteLimits {
    blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync     = (bCS -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bCS
forall k1 k2 k3 bytes (header :: k1) (point :: k2) (tip :: k3).
(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 k1 k2 bytes (block :: k1) (point :: k2).
(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 k1 k2 bytes (txid :: k1) (tx :: k2).
(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 :: forall bCS bBF bTX bKA.
(forall header point tip.
 ProtocolSizeLimits (ChainSync header point tip) bCS)
-> (forall block point.
    ProtocolSizeLimits (BlockFetch block point) bBF)
-> (forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX)
-> ProtocolSizeLimits KeepAlive bKA
-> ByteLimits bCS bBF bTX bKA
ByteLimits {
      blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) ByteString
blChainSync     = (ByteString -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) ByteString
forall k1 k2 k3 bytes (header :: k1) (point :: k2) (tip :: k3).
(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 k1 k2 bytes (block :: k1) (point :: k2).
(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 k1 k2 bytes (txid :: k1) (tx :: k2).
(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 remotePeer localPeer blk e bCS bBF bTX bKA.
     ( IOLike m
     , MonadTimer m
     , Ord remotePeer
     , Exception e
     , LedgerSupportsProtocol blk
     , ShowProxy blk
     , ShowProxy (Header blk)
     , ShowProxy (TxId (GenTx blk))
     , ShowProxy (GenTx blk)
     )
  => NodeKernel m remotePeer localPeer blk -- ^ Needed for bracketing only
  -> Tracers m remotePeer blk e
  -> (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA)
  -> ByteLimits bCS bBF bTX bKA
  -> m ChainSyncTimeout
  -> ReportPeerMetrics m remotePeer
  -> Handlers m remotePeer blk
  -> Apps m remotePeer bCS bBF bTX bKA ()
mkApps :: NodeKernel m remotePeer localPeer blk
-> Tracers m remotePeer blk e
-> (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA)
-> ByteLimits bCS bBF bTX bKA
-> m ChainSyncTimeout
-> ReportPeerMetrics m remotePeer
-> Handlers m remotePeer blk
-> Apps m remotePeer bCS bBF bTX bKA ()
mkApps NodeKernel m remotePeer localPeer blk
kernel Tracers {Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceSendRecv (BlockFetch blk (Point blk))))
Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceSendRecv (BlockFetch blk (Point blk))))
tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tTxSubmission2Tracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tBlockFetchSerialisedTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tChainSyncSerialisedTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
..} NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
mkCodecs ByteLimits {ProtocolSizeLimits KeepAlive bKA
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blKeepAlive :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA -> ProtocolSizeLimits KeepAlive bKA
blTxSubmission2 :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blBlockFetch :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall block point.
   ProtocolSizeLimits (BlockFetch block point) bBF
blChainSync :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall header point tip.
   ProtocolSizeLimits (ChainSync header point tip) bCS
..} m ChainSyncTimeout
genChainSyncTimeout ReportPeerMetrics {Tracer (STM m) (TraceLabelPeer remotePeer (SlotNo, Time))
Tracer (STM m) (TraceLabelPeer remotePeer (Word32, 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 (Word32, SlotNo, Time))
reportFetch :: Tracer (STM m) (TraceLabelPeer remotePeer (Word32, SlotNo, Time))
reportHeader :: Tracer (STM m) (TraceLabelPeer remotePeer (SlotNo, Time))
..} Handlers {remotePeer
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
NodeToNodeVersion
-> remotePeer
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
NodeToNodeVersion -> remotePeer -> KeepAliveServer m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> StrictTVar m (Map remotePeer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hKeepAliveServer :: NodeToNodeVersion -> remotePeer -> KeepAliveServer m ()
hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> StrictTVar m (Map remotePeer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hTxSubmissionServer :: NodeToNodeVersion
-> remotePeer
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hBlockFetchServer :: NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hChainSyncServer :: NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncClient :: remotePeer
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hKeepAliveServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion -> peer -> KeepAliveServer m ()
hKeepAliveClient :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hTxSubmissionServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion
-> peer
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> peer
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hBlockFetchServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchClient :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hChainSyncServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncClient :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> peer
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
..} =
    Apps :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
ClientApp m peer bCS a
-> ServerApp m peer bCS a
-> ClientApp m peer bBF a
-> ServerApp m peer bBF a
-> ClientApp m peer bTX a
-> ServerApp m peer bTX a
-> ClientApp m peer bKA a
-> ServerApp m peer bKA a
-> Apps m peer bCS bBF bTX bKA a
Apps {NodeToNodeVersion
-> remotePeer -> Channel m bCS -> m ((), Maybe bCS)
NodeToNodeVersion
-> remotePeer -> Channel m bBF -> m ((), Maybe bBF)
NodeToNodeVersion
-> remotePeer -> Channel m bTX -> m ((), Maybe bTX)
NodeToNodeVersion
-> remotePeer -> Channel m bKA -> m ((), Maybe bKA)
NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bCS
-> m ((), Maybe bCS)
NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bBF
-> m ((), Maybe bBF)
NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bTX
-> m ((), Maybe bTX)
NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bKA
-> m ((), Maybe bKA)
aKeepAliveServer :: NodeToNodeVersion
-> remotePeer -> Channel m bKA -> m ((), Maybe bKA)
aKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bKA
-> m ((), Maybe bKA)
aTxSubmission2Server :: NodeToNodeVersion
-> remotePeer -> Channel m bTX -> m ((), Maybe bTX)
aTxSubmission2Client :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bTX
-> m ((), Maybe bTX)
aBlockFetchServer :: NodeToNodeVersion
-> remotePeer -> Channel m bBF -> m ((), Maybe bBF)
aBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bBF
-> m ((), Maybe bBF)
aChainSyncServer :: NodeToNodeVersion
-> remotePeer -> Channel m bCS -> m ((), Maybe bCS)
aChainSyncClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bCS
-> m ((), Maybe bCS)
aKeepAliveServer :: NodeToNodeVersion
-> remotePeer -> Channel m bKA -> m ((), Maybe bKA)
aKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bKA
-> m ((), Maybe bKA)
aTxSubmission2Server :: NodeToNodeVersion
-> remotePeer -> Channel m bTX -> m ((), Maybe bTX)
aTxSubmission2Client :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bTX
-> m ((), Maybe bTX)
aBlockFetchServer :: NodeToNodeVersion
-> remotePeer -> Channel m bBF -> m ((), Maybe bBF)
aBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bBF
-> m ((), Maybe bBF)
aChainSyncServer :: NodeToNodeVersion
-> remotePeer -> Channel m bCS -> m ((), Maybe bCS)
aChainSyncClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bCS
-> m ((), Maybe bCS)
..}
  where
    aChainSyncClient
      :: NodeToNodeVersion
      -> ControlMessageSTM m
      -> remotePeer
      -> Channel m bCS
      -> m ((), Maybe bCS)
    aChainSyncClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bCS
-> m ((), Maybe bCS)
aChainSyncClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM remotePeer
them 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 remotePeer (Header blk) blk m
-> remotePeer -> m ((), Maybe bCS) -> m ((), Maybe bCS)
forall (m :: * -> *) a peer header block.
(MonadThrow m, MonadSTM m, MonadFork m, Ord peer) =>
FetchClientRegistry peer header block m -> peer -> m a -> m a
bracketSyncWithFetchClient
        (NodeKernel m remotePeer localPeer blk
-> FetchClientRegistry remotePeer (Header blk) blk m
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk
-> FetchClientRegistry remotePeer (Header blk) blk m
getFetchClientRegistry NodeKernel m remotePeer localPeer blk
kernel) remotePeer
them (m ((), Maybe bCS) -> m ((), Maybe bCS))
-> m ((), Maybe bCS) -> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$
        Tracer m (TraceChainSyncClientEvent blk)
-> ChainDbView m blk
-> StrictTVar
     m (Map remotePeer (StrictTVar m (AnchoredFragment (Header blk))))
-> remotePeer
-> NodeToNodeVersion
-> (StrictTVar m (AnchoredFragment (Header blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall (m :: * -> *) peer blk a.
(IOLike m, Ord peer, BlockSupportsProtocol blk,
 LedgerSupportsProtocol blk) =>
Tracer m (TraceChainSyncClientEvent blk)
-> ChainDbView m blk
-> StrictTVar
     m (Map peer (StrictTVar m (AnchoredFragment (Header blk))))
-> peer
-> NodeToNodeVersion
-> (StrictTVar m (AnchoredFragment (Header blk)) -> m a)
-> m a
bracketChainSyncClient
            ((TraceChainSyncClientEvent blk
 -> TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> Tracer
     m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) (Tracers' remotePeer localPeer blk (Tracer m)
-> Tracer
     m (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer (NodeKernel m remotePeer localPeer blk
-> Tracers' remotePeer localPeer blk (Tracer m)
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk
-> Tracers m remotePeer localPeer blk
getTracers NodeKernel m remotePeer localPeer blk
kernel)))
            (ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ChainDB m blk -> ChainDbView m blk
defaultChainDbView (NodeKernel m remotePeer localPeer blk -> ChainDB m blk
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB NodeKernel m remotePeer localPeer blk
kernel))
            (NodeKernel m remotePeer localPeer blk
-> StrictTVar
     m (Map remotePeer (StrictTVar m (AnchoredFragment (Header blk))))
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk
-> StrictTVar
     m (Map remotePeer (StrictTVar m (AnchoredFragment (Header blk))))
getNodeCandidates NodeKernel m remotePeer localPeer blk
kernel)
            remotePeer
them
            NodeToNodeVersion
version ((StrictTVar m (AnchoredFragment (Header blk))
  -> m ((), Maybe bCS))
 -> m ((), Maybe bCS))
-> (StrictTVar m (AnchoredFragment (Header blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \StrictTVar m (AnchoredFragment (Header blk))
varCandidate -> do
              ChainSyncTimeout
chainSyncTimeout <- m ChainSyncTimeout
genChainSyncTimeout
              (ChainSyncClientResult
_, 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, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 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
      remotePeer
      (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
     m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     remotePeer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer)
                  (Codecs blk e m bCS bCS bBF bBF bTX bKA
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
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 k1 k2 k3 (header :: k1) (point :: k2) (tip :: k3).
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
-> PeerPipelined (ChainSync header point tip) 'AsClient '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
$ remotePeer
-> NodeToNodeVersion
-> ControlMessageSTM m
-> HeaderMetricsTracer m
-> StrictTVar m (AnchoredFragment (Header blk))
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient remotePeer
them NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM
                      (remotePeer
-> (SlotNo, Time) -> TraceLabelPeer remotePeer (SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them ((SlotNo, Time) -> TraceLabelPeer remotePeer (SlotNo, Time))
-> Tracer (STM m) (TraceLabelPeer remotePeer (SlotNo, Time))
-> HeaderMetricsTracer m
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer (STM m) (TraceLabelPeer remotePeer (SlotNo, Time))
reportHeader)
                      StrictTVar m (AnchoredFragment (Header blk))
varCandidate
              ((), Maybe bCS) -> m ((), Maybe bCS)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Maybe bCS
trailing)

    aChainSyncServer
      :: NodeToNodeVersion
      -> remotePeer
      -> Channel m bCS
      -> m ((), Maybe bCS)
    aChainSyncServer :: NodeToNodeVersion
-> remotePeer -> Channel m bCS -> m ((), Maybe bCS)
aChainSyncServer NodeToNodeVersion
version remotePeer
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.
(IOLike 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 remotePeer localPeer blk -> ChainDB m blk
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB NodeKernel m remotePeer localPeer blk
kernel)
           ( if NodeToNodeVersion -> Bool
isPipeliningEnabled NodeToNodeVersion
version
             then ChainType
ChainDB.TentativeChain
             else 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
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeerWithLimits
            ((TraceSendRecv
   (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
 -> TraceLabelPeer
      remotePeer
      (TraceSendRecv
         (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceSendRecv
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     remotePeer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer)
            (Codecs blk e m bCS bCS bBF bBF bTX bKA
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bCS
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
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 k1 k2 k3 (header :: k1) (point :: k2) (tip :: k3).
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
chainSyncTimeout)
            Channel m bCS
channel
            (Peer
   (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
   'AsServer
   'StIdle
   m
   ()
 -> m ((), Maybe bCS))
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     '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
     'StIdle
     m
     ()
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer
            (ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
 -> Peer
      (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
      'AsServer
      'StIdle
      m
      ())
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'StIdle
     m
     ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer NodeToNodeVersion
version Follower m blk (WithPoint blk (SerialisedHeader blk))
flr

    aBlockFetchClient
      :: NodeToNodeVersion
      -> ControlMessageSTM m
      -> remotePeer
      -> Channel m bBF
      -> m ((), Maybe bBF)
    aBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bBF
-> m ((), Maybe bBF)
aBlockFetchClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM remotePeer
them Channel m bBF
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchClient"
      FetchClientRegistry remotePeer (Header blk) blk m
-> NodeToNodeVersion
-> remotePeer
-> (FetchClientContext (Header blk) blk m -> m ((), Maybe bBF))
-> m ((), Maybe bBF)
forall (m :: * -> *) a peer header block.
(MonadThrow m, MonadSTM m, MonadFork m, MonadMask m, Ord peer) =>
FetchClientRegistry peer header block m
-> NodeToNodeVersion
-> peer
-> (FetchClientContext header block m -> m a)
-> m a
bracketFetchClient (NodeKernel m remotePeer localPeer blk
-> FetchClientRegistry remotePeer (Header blk) blk m
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk
-> FetchClientRegistry remotePeer (Header blk) blk m
getFetchClientRegistry NodeKernel m remotePeer localPeer blk
kernel) NodeToNodeVersion
version remotePeer
them ((FetchClientContext (Header blk) blk m -> m ((), Maybe bBF))
 -> m ((), Maybe bBF))
-> (FetchClientContext (Header blk) blk m -> m ((), Maybe bBF))
-> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ \FetchClientContext (Header blk) blk m
clientCtx ->
        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, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 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
      remotePeer (TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer (TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceSendRecv (BlockFetch blk (Point blk))
-> TraceLabelPeer
     remotePeer (TraceSendRecv (BlockFetch blk (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) Tracer
  m
  (TraceLabelPeer
     remotePeer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer)
          (Codecs blk e m bCS bCS bBF bBF bTX bKA
-> Codec (BlockFetch blk (Point blk)) e m bBF
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
          ProtocolTimeLimits (BlockFetch blk (Point blk))
forall k1 k2 (block :: k1) (point :: k2).
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
                              (remotePeer
-> (Word32, SlotNo, Time)
-> TraceLabelPeer remotePeer (Word32, SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them ((Word32, SlotNo, Time)
 -> TraceLabelPeer remotePeer (Word32, SlotNo, Time))
-> Tracer
     (STM m) (TraceLabelPeer remotePeer (Word32, SlotNo, Time))
-> FetchedMetricsTracer m
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer (STM m) (TraceLabelPeer remotePeer (Word32, SlotNo, Time))
reportFetch) FetchClientContext (Header blk) blk m
clientCtx

    aBlockFetchServer
      :: NodeToNodeVersion
      -> remotePeer
      -> Channel m bBF
      -> m ((), Maybe bBF)
    aBlockFetchServer :: NodeToNodeVersion
-> remotePeer -> Channel m bBF -> m ((), Maybe bBF)
aBlockFetchServer NodeToNodeVersion
version remotePeer
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.
(IOLike 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 'BFIdle m ()
-> m ((), Maybe bBF)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeerWithLimits
          ((TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
 -> TraceLabelPeer
      remotePeer
      (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer
        (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
     m (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
-> TraceLabelPeer
     remotePeer
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer)
          (Codecs blk e m bCS bCS bBF bBF bTX bKA
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bBF
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
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 k1 k2 (block :: k1) (point :: k2).
ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
          Channel m bBF
channel
          (Peer
   (BlockFetch (Serialised blk) (Point blk)) 'AsServer 'BFIdle m ()
 -> m ((), Maybe bBF))
-> Peer
     (BlockFetch (Serialised blk) (Point blk)) 'AsServer '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 'BFIdle m ()
forall block point (m :: * -> *) a.
Functor m =>
BlockFetchServer block point m a
-> Peer (BlockFetch block point) 'AsServer 'BFIdle m a
blockFetchServerPeer
          (BlockFetchServer (Serialised blk) (Point blk) m ()
 -> Peer
      (BlockFetch (Serialised blk) (Point blk)) 'AsServer 'BFIdle m ())
-> BlockFetchServer (Serialised blk) (Point blk) m ()
-> Peer
     (BlockFetch (Serialised blk) (Point blk)) 'AsServer 'BFIdle m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer NodeToNodeVersion
version ResourceRegistry m
registry

    aTxSubmission2Client
      :: NodeToNodeVersion
      -> ControlMessageSTM m
      -> remotePeer
      -> Channel m bTX
      -> m ((), Maybe bTX)
    aTxSubmission2Client :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bTX
-> m ((), Maybe bTX)
aTxSubmission2Client NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM remotePeer
them Channel m bTX
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionClient"
      Tracer m (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
-> ProtocolSizeLimits (TxSubmission2 (GenTxId blk) (GenTx blk)) bTX
-> ProtocolTimeLimits (TxSubmission2 (GenTxId blk) (GenTx blk))
-> Channel m bTX
-> Peer
     (TxSubmission2 (GenTxId blk) (GenTx blk)) 'AsClient 'StInit m ()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        ((TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))
 -> TraceLabelPeer
      remotePeer
      (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer
        (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracer
     m (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))
-> TraceLabelPeer
     remotePeer
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer)
        (Codecs blk e m bCS bCS bBF bBF bTX bKA
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits (TxSubmission2 (GenTxId blk) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
        ProtocolTimeLimits (TxSubmission2 (GenTxId blk) (GenTx blk))
forall k1 k2 (txid :: k1) (tx :: k2).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
        Channel m bTX
channel
        (TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
-> Peer
     (TxSubmission2 (GenTxId blk) (GenTx blk)) 'AsClient 'StInit m ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StInit m a
txSubmissionClientPeer (NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM remotePeer
them))

    aTxSubmission2Server
      :: NodeToNodeVersion
      -> remotePeer
      -> Channel m bTX
      -> m ((), Maybe bTX)
    aTxSubmission2Server :: NodeToNodeVersion
-> remotePeer -> Channel m bTX -> m ((), Maybe bTX)
aTxSubmission2Server NodeToNodeVersion
version remotePeer
them Channel m bTX
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionServer"
      Tracer m (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
-> ProtocolSizeLimits (TxSubmission2 (GenTxId blk) (GenTx blk)) bTX
-> ProtocolTimeLimits (TxSubmission2 (GenTxId blk) (GenTx blk))
-> Channel m bTX
-> PeerPipelined
     (TxSubmission2 (GenTxId 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, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 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 (GenTxId blk) (GenTx blk))
 -> TraceLabelPeer
      remotePeer
      (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracer
     m
     (TraceLabelPeer
        remotePeer
        (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
-> Tracer
     m (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (remotePeer
-> TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))
-> TraceLabelPeer
     remotePeer
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer remotePeer
them) Tracer
  m
  (TraceLabelPeer
     remotePeer
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer)
        (Codecs blk e m bCS bCS bBF bBF bTX bKA
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits (TxSubmission2 (GenTxId blk) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
        ProtocolTimeLimits (TxSubmission2 (GenTxId blk) (GenTx blk))
forall k1 k2 (txid :: k1) (tx :: k2).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
        Channel m bTX
channel
        (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
-> PeerPipelined
     (TxSubmission2 (GenTxId blk) (GenTx blk)) 'AsServer 'StInit m ()
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> PeerPipelined (TxSubmission2 txid tx) 'AsServer 'StInit m a
txSubmissionServerPeerPipelined (NodeToNodeVersion
-> remotePeer
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer NodeToNodeVersion
version remotePeer
them))

    aKeepAliveClient
      :: NodeToNodeVersion
      -> ControlMessageSTM m
      -> remotePeer
      -> Channel m bKA
      -> m ((), Maybe bKA)
    aKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> Channel m bKA
-> m ((), Maybe bKA)
aKeepAliveClient NodeToNodeVersion
version ControlMessageSTM m
_controlMessageSTM remotePeer
them Channel m bKA
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveClient"
      let kacApp :: StrictTVar m (Map remotePeer PeerGSV) -> m ((), Maybe bKA)
kacApp = \StrictTVar m (Map remotePeer PeerGSV)
dqCtx ->
                       Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive e m bKA
-> ProtocolSizeLimits KeepAlive bKA
-> ProtocolTimeLimits KeepAlive
-> Channel m bKA
-> Peer KeepAlive 'AsClient 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeerWithLimits
                         Tracer m (TraceSendRecv KeepAlive)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                         (Codecs blk e m bCS bCS bBF bBF bTX bKA -> Codec KeepAlive e m bKA
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA -> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
mkCodecs NodeToNodeVersion
version))
                         ProtocolSizeLimits KeepAlive bKA
blKeepAlive
                         ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
                         Channel m bKA
channel
                         (Peer KeepAlive 'AsClient 'StClient m () -> m ((), Maybe bKA))
-> Peer KeepAlive 'AsClient 'StClient m () -> m ((), Maybe bKA)
forall a b. (a -> b) -> a -> b
$ KeepAliveClient m () -> Peer KeepAlive 'AsClient 'StClient m ()
forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Peer KeepAlive 'AsClient 'StClient m a
keepAliveClientPeer
                         (KeepAliveClient m () -> Peer KeepAlive 'AsClient 'StClient m ())
-> KeepAliveClient m () -> Peer KeepAlive 'AsClient 'StClient m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ControlMessageSTM m
-> remotePeer
-> StrictTVar m (Map remotePeer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient NodeToNodeVersion
version (Proxy m -> ControlMessageSTM m
forall (m :: * -> *) (proxy :: (* -> *) -> *).
Applicative (STM m) =>
proxy m -> ControlMessageSTM m
continueForever (Proxy m
forall k (t :: k). Proxy t
Proxy :: Proxy m)) remotePeer
them StrictTVar m (Map remotePeer PeerGSV)
dqCtx
                             (DiffTime -> KeepAliveInterval
KeepAliveInterval DiffTime
10)

      FetchClientRegistry remotePeer (Header blk) blk m
-> remotePeer
-> (StrictTVar m (Map remotePeer PeerGSV) -> m ((), Maybe bKA))
-> m ((), Maybe bKA)
forall (m :: * -> *) a peer header block.
(MonadThrow m, 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 remotePeer localPeer blk
-> FetchClientRegistry remotePeer (Header blk) blk m
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk
-> FetchClientRegistry remotePeer (Header blk) blk m
getFetchClientRegistry NodeKernel m remotePeer localPeer blk
kernel) remotePeer
them StrictTVar m (Map remotePeer PeerGSV) -> m ((), Maybe bKA)
kacApp

    aKeepAliveServer
      :: NodeToNodeVersion
      -> remotePeer
      -> Channel m bKA
      -> m ((), Maybe bKA)
    aKeepAliveServer :: NodeToNodeVersion
-> remotePeer -> Channel m bKA -> m ((), Maybe bKA)
aKeepAliveServer NodeToNodeVersion
version remotePeer
_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 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
 MonadMonotonicTime m, MonadTimer m,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps,
 Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        Tracer m (TraceSendRecv KeepAlive)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        (Codecs blk e m bCS bCS bBF bBF bTX bKA -> Codec KeepAlive e m bKA
forall blk e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA.
Codecs blk e m bCS bSCS bBF bSBF bTX bKA -> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA
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 'StClient m () -> m ((), Maybe bKA))
-> Peer KeepAlive 'AsServer 'StClient m () -> m ((), Maybe bKA)
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m () -> Peer KeepAlive 'AsServer 'StClient m ()
forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Peer KeepAlive 'AsServer 'StClient m a
keepAliveServerPeer
        (KeepAliveServer m () -> Peer KeepAlive 'AsServer 'StClient m ())
-> KeepAliveServer m () -> Peer KeepAlive 'AsServer 'StClient m ()
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer

{-------------------------------------------------------------------------------
  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
  -> Apps m (ConnectionId peer) b b b b a
  -> OuroborosBundle 'InitiatorMode peer b m a Void
initiator :: MiniProtocolParameters
-> NodeToNodeVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosBundle 'InitiatorMode peer b m a Void
initiator MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version Apps {ClientApp m (ConnectionId peer) b a
ServerApp m (ConnectionId peer) b a
aKeepAliveServer :: ServerApp m (ConnectionId peer) b a
aKeepAliveClient :: ClientApp m (ConnectionId peer) b a
aTxSubmission2Server :: ServerApp m (ConnectionId peer) b a
aTxSubmission2Client :: ClientApp m (ConnectionId peer) b a
aBlockFetchServer :: ServerApp m (ConnectionId peer) b a
aBlockFetchClient :: ClientApp m (ConnectionId peer) b a
aChainSyncServer :: ServerApp m (ConnectionId peer) b a
aChainSyncClient :: ClientApp m (ConnectionId peer) b a
aKeepAliveServer :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bKA a
aKeepAliveClient :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bKA a
aTxSubmission2Server :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bTX a
aTxSubmission2Client :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bTX a
aBlockFetchServer :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bBF a
aBlockFetchClient :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bBF a
aChainSyncServer :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bCS a
aChainSyncClient :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bCS a
..} =
    MiniProtocolParameters
-> (ConnectionId peer
    -> STM m ControlMessage
    -> NodeToNodeProtocols 'InitiatorMode b m a Void)
-> NodeToNodeVersion
-> OuroborosBundle 'InitiatorMode peer b m a Void
forall addr (m :: * -> *) (muxMode :: MuxMode) bytes a b.
MiniProtocolParameters
-> (ConnectionId addr
    -> STM m ControlMessage -> NodeToNodeProtocols muxMode bytes m a b)
-> NodeToNodeVersion
-> OuroborosBundle muxMode addr 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 consenus can use peer's ip
      -- address & port number, rather than 'ConnectionId' (which is
      -- a quadruple uniquely determinaing a connection).
      (\ConnectionId peer
them STM m ControlMessage
controlMessageSTM -> NodeToNodeProtocols :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> NodeToNodeProtocols appType bytes m a b
NodeToNodeProtocols {
          chainSyncProtocol :: RunMiniProtocol 'InitiatorMode b m a Void
chainSyncProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'InitiatorMode b m a Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
InitiatorProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aChainSyncClient NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))),
          blockFetchProtocol :: RunMiniProtocol 'InitiatorMode b m a Void
blockFetchProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'InitiatorMode b m a Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
InitiatorProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aBlockFetchClient NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))),
          txSubmissionProtocol :: RunMiniProtocol 'InitiatorMode b m a Void
txSubmissionProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'InitiatorMode b m a Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
InitiatorProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aTxSubmission2Client NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))),
          keepAliveProtocol :: RunMiniProtocol 'InitiatorMode b m a Void
keepAliveProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'InitiatorMode b m a Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
InitiatorProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aKeepAliveClient NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them)))
        })
      NodeToNodeVersion
version

-- | A bi-directional network applicaiton.
--
-- 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
  -> Apps m (ConnectionId peer) b b b b a
  -> OuroborosBundle 'InitiatorResponderMode peer b m a a
initiatorAndResponder :: MiniProtocolParameters
-> NodeToNodeVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosBundle 'InitiatorResponderMode peer b m a a
initiatorAndResponder MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version Apps {ClientApp m (ConnectionId peer) b a
ServerApp m (ConnectionId peer) b a
aKeepAliveServer :: ServerApp m (ConnectionId peer) b a
aKeepAliveClient :: ClientApp m (ConnectionId peer) b a
aTxSubmission2Server :: ServerApp m (ConnectionId peer) b a
aTxSubmission2Client :: ClientApp m (ConnectionId peer) b a
aBlockFetchServer :: ServerApp m (ConnectionId peer) b a
aBlockFetchClient :: ClientApp m (ConnectionId peer) b a
aChainSyncServer :: ServerApp m (ConnectionId peer) b a
aChainSyncClient :: ClientApp m (ConnectionId peer) b a
aKeepAliveServer :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bKA a
aKeepAliveClient :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bKA a
aTxSubmission2Server :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bTX a
aTxSubmission2Client :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bTX a
aBlockFetchServer :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bBF a
aBlockFetchClient :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bBF a
aChainSyncServer :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ServerApp m peer bCS a
aChainSyncClient :: forall (m :: * -> *) peer bCS bBF bTX bKA a.
Apps m peer bCS bBF bTX bKA a -> ClientApp m peer bCS a
..} =
    MiniProtocolParameters
-> (ConnectionId peer
    -> STM m ControlMessage
    -> NodeToNodeProtocols 'InitiatorResponderMode b m a a)
-> NodeToNodeVersion
-> OuroborosBundle 'InitiatorResponderMode peer b m a a
forall addr (m :: * -> *) (muxMode :: MuxMode) bytes a b.
MiniProtocolParameters
-> (ConnectionId addr
    -> STM m ControlMessage -> NodeToNodeProtocols muxMode bytes m a b)
-> NodeToNodeVersion
-> OuroborosBundle muxMode addr bytes m a b
nodeToNodeProtocols
      MiniProtocolParameters
miniProtocolParameters
      (\ConnectionId peer
them STM m ControlMessage
controlMessageSTM -> NodeToNodeProtocols :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> NodeToNodeProtocols appType bytes m a b
NodeToNodeProtocols {
          chainSyncProtocol :: RunMiniProtocol 'InitiatorResponderMode b m a a
chainSyncProtocol =
            (MuxPeer b m a
-> MuxPeer b m a -> RunMiniProtocol 'InitiatorResponderMode b m a a
forall bytes (m :: * -> *) a b.
MuxPeer bytes m a
-> MuxPeer bytes m b
-> RunMiniProtocol 'InitiatorResponderMode bytes m a b
InitiatorAndResponderProtocol
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aChainSyncClient NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ServerApp m (ConnectionId peer) b a
aChainSyncServer NodeToNodeVersion
version                   ConnectionId peer
them))),
          blockFetchProtocol :: RunMiniProtocol 'InitiatorResponderMode b m a a
blockFetchProtocol =
            (MuxPeer b m a
-> MuxPeer b m a -> RunMiniProtocol 'InitiatorResponderMode b m a a
forall bytes (m :: * -> *) a b.
MuxPeer bytes m a
-> MuxPeer bytes m b
-> RunMiniProtocol 'InitiatorResponderMode bytes m a b
InitiatorAndResponderProtocol
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aBlockFetchClient NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ServerApp m (ConnectionId peer) b a
aBlockFetchServer NodeToNodeVersion
version                   ConnectionId peer
them))),
          txSubmissionProtocol :: RunMiniProtocol 'InitiatorResponderMode b m a a
txSubmissionProtocol =
            (MuxPeer b m a
-> MuxPeer b m a -> RunMiniProtocol 'InitiatorResponderMode b m a a
forall bytes (m :: * -> *) a b.
MuxPeer bytes m a
-> MuxPeer bytes m b
-> RunMiniProtocol 'InitiatorResponderMode bytes m a b
InitiatorAndResponderProtocol
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aTxSubmission2Client NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ServerApp m (ConnectionId peer) b a
aTxSubmission2Server NodeToNodeVersion
version                   ConnectionId peer
them))),
          keepAliveProtocol :: RunMiniProtocol 'InitiatorResponderMode b m a a
keepAliveProtocol =
            (MuxPeer b m a
-> MuxPeer b m a -> RunMiniProtocol 'InitiatorResponderMode b m a a
forall bytes (m :: * -> *) a b.
MuxPeer bytes m a
-> MuxPeer bytes m b
-> RunMiniProtocol 'InitiatorResponderMode bytes m a b
InitiatorAndResponderProtocol
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ClientApp m (ConnectionId peer) b a
aKeepAliveClient NodeToNodeVersion
version STM m ControlMessage
controlMessageSTM ConnectionId peer
them))
              ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (ServerApp m (ConnectionId peer) b a
aKeepAliveServer NodeToNodeVersion
version                   ConnectionId peer
them)))
        })
      NodeToNodeVersion
version