{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Consensus.Network.NodeToNode (
Handlers (..)
, mkHandlers
, Codecs (..)
, defaultCodecs
, identityCodecs
, ByteLimits
, byteLimits
, noByteLimits
, Tracers
, Tracers' (..)
, nullTracers
, showTracers
, Apps (..)
, ClientApp
, ServerApp
, mkApps
, initiator
, initiatorAndResponder
, ChainSyncTimeout (..)
) where
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.CBOR.Read (DeserialiseFailure)
import qualified Control.Concurrent.Class.MonadSTM.Strict.TVar as TVar.Unchecked
import Control.Monad.Class.MonadTime.SI (MonadTime)
import Control.Monad.Class.MonadTimer.SI (MonadTimer)
import Control.Tracer
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import Data.Void (Void)
import Network.TypedProtocol.Codec
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
(ChainSyncStateView (..))
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CsClient
import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import Ouroboros.Consensus.Node.ExitPolicy
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Node.Serialisation
import qualified Ouroboros.Consensus.Node.Tracers as Node
import Ouroboros.Consensus.NodeKernel
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import Ouroboros.Consensus.Storage.Serialisation (SerialisedHeader)
import Ouroboros.Consensus.Util (ShowProxy)
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.Orphans ()
import Ouroboros.Consensus.Util.ResourceRegistry
import Ouroboros.Network.Block (Serialised (..), decodePoint,
decodeTip, encodePoint, encodeTip)
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.BlockFetch.Client (BlockFetchClient,
blockFetchClient)
import Ouroboros.Network.Channel
import Ouroboros.Network.Context
import Ouroboros.Network.DeltaQ
import Ouroboros.Network.Driver
import Ouroboros.Network.Driver.Limits
import Ouroboros.Network.KeepAlive
import Ouroboros.Network.Mux
import Ouroboros.Network.NodeToNode
import Ouroboros.Network.NodeToNode.Version (isPipeliningEnabled)
import Ouroboros.Network.PeerSelection.PeerMetric.Type
(FetchedMetricsTracer, ReportPeerMetrics (..))
import qualified Ouroboros.Network.PeerSelection.PeerSharing as PSTypes
import Ouroboros.Network.PeerSharing (PeerSharingController,
bracketPeerSharingClient, peerSharingClient,
peerSharingServer)
import Ouroboros.Network.Protocol.BlockFetch.Codec
import Ouroboros.Network.Protocol.BlockFetch.Server (BlockFetchServer,
blockFetchServerPeer)
import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch (..))
import Ouroboros.Network.Protocol.ChainSync.ClientPipelined
import Ouroboros.Network.Protocol.ChainSync.Codec
import Ouroboros.Network.Protocol.ChainSync.PipelineDecision
import Ouroboros.Network.Protocol.ChainSync.Server
import Ouroboros.Network.Protocol.ChainSync.Type
import Ouroboros.Network.Protocol.KeepAlive.Client
import Ouroboros.Network.Protocol.KeepAlive.Codec
import Ouroboros.Network.Protocol.KeepAlive.Server
import Ouroboros.Network.Protocol.KeepAlive.Type
import Ouroboros.Network.Protocol.PeerSharing.Client
(PeerSharingClient, peerSharingClientPeer)
import Ouroboros.Network.Protocol.PeerSharing.Codec
(byteLimitsPeerSharing, codecPeerSharing,
codecPeerSharingId, timeLimitsPeerSharing)
import Ouroboros.Network.Protocol.PeerSharing.Server
(PeerSharingServer, peerSharingServerPeer)
import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharing)
import Ouroboros.Network.Protocol.TxSubmission2.Client
import Ouroboros.Network.Protocol.TxSubmission2.Codec
import Ouroboros.Network.Protocol.TxSubmission2.Server
import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.TxSubmission.Inbound
import Ouroboros.Network.TxSubmission.Mempool.Reader
(mapTxSubmissionMempoolReader)
import Ouroboros.Network.TxSubmission.Outbound
data Handlers m addr blk = Handlers {
forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient
:: ConnectionId addr
-> IsBigLedgerPeer
-> CsClient.DynamicEnv m blk
-> ChainSyncClientPipelined (Header blk) (Point blk) (Tip blk) m
CsClient.ChainSyncClientResult
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer
:: ConnectionId addr
-> NodeToNodeVersion
-> ChainDB.Follower m blk (ChainDB.WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient
:: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer
:: ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient
:: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer
:: NodeToNodeVersion
-> ConnectionId addr
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient
:: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TVar.Unchecked.StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion -> ConnectionId addr -> KeepAliveServer m ()
hKeepAliveServer
:: NodeToNodeVersion
-> ConnectionId addr
-> KeepAliveServer m ()
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
hPeerSharingClient
:: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
, forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
hPeerSharingServer
:: NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
}
mkHandlers ::
forall m blk addrNTN addrNTC.
( IOLike m
, MonadTime m
, MonadTimer m
, LedgerSupportsMempool blk
, HasTxId (GenTx blk)
, LedgerSupportsProtocol blk
, Ord addrNTN
, Hashable addrNTN
)
=> NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk
-> Handlers m addrNTN blk
mkHandlers :: forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, MonadTime m, MonadTimer m, LedgerSupportsMempool blk,
HasTxId (GenTx blk), LedgerSupportsProtocol blk, Ord addrNTN,
Hashable addrNTN) =>
NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk -> Handlers m addrNTN blk
mkHandlers
NodeKernelArgs {SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
$sel:chainSyncFutureCheck:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> SomeHeaderInFutureCheck m blk
chainSyncFutureCheck, m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
$sel:chainSyncHistoricityCheck:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck, StdGen
keepAliveRng :: StdGen
$sel:keepAliveRng:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> StdGen
keepAliveRng, MiniProtocolParameters
miniProtocolParameters :: MiniProtocolParameters
$sel:miniProtocolParameters:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> MiniProtocolParameters
miniProtocolParameters}
NodeKernel {ChainDB m blk
getChainDB :: ChainDB m blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB, Mempool m blk
getMempool :: Mempool m blk
$sel:getMempool:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> Mempool m blk
getMempool, TopLevelConfig blk
getTopLevelConfig :: TopLevelConfig blk
$sel:getTopLevelConfig:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> TopLevelConfig blk
getTopLevelConfig, $sel:getTracers:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers = Tracers m (ConnectionId addrNTN) addrNTC blk
tracers, PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI :: PeerSharingAPI addrNTN StdGen m
$sel:getPeerSharingAPI:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI, STM m GsmState
getGsmState :: STM m GsmState
$sel:getGsmState:NodeKernel :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState} =
Handlers {
hChainSyncClient :: ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient = \ConnectionId addrNTN
peer IsBigLedgerPeer
_isBigLedgerpeer DynamicEnv m blk
dynEnv ->
ConfigEnv m blk
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ConfigEnv m blk
-> DynamicEnv m blk -> Consensus ChainSyncClientPipelined blk m
CsClient.chainSyncClient
CsClient.ConfigEnv {
$sel:cfg:ConfigEnv :: TopLevelConfig blk
CsClient.cfg = TopLevelConfig blk
getTopLevelConfig
, $sel:someHeaderInFutureCheck:ConfigEnv :: SomeHeaderInFutureCheck m blk
CsClient.someHeaderInFutureCheck = SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
, $sel:historicityCheck:ConfigEnv :: HistoricityCheck m blk
CsClient.historicityCheck = m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck (STM m GsmState -> m GsmState
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m GsmState
getGsmState)
, $sel:chainDbView:ConfigEnv :: ChainDbView m blk
CsClient.chainDbView =
ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ChainDB m blk -> ChainDbView m blk
CsClient.defaultChainDbView ChainDB m blk
getChainDB
, $sel:mkPipelineDecision0:ConfigEnv :: MkPipelineDecision
CsClient.mkPipelineDecision0 = Word16 -> Word16 -> MkPipelineDecision
pipelineDecisionLowHighMark
(MiniProtocolParameters -> Word16
chainSyncPipeliningLowMark MiniProtocolParameters
miniProtocolParameters)
(MiniProtocolParameters -> Word16
chainSyncPipeliningHighMark MiniProtocolParameters
miniProtocolParameters)
, $sel:tracer:ConfigEnv :: Tracer m (TraceChainSyncClientEvent blk)
CsClient.tracer =
(TraceChainSyncClientEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers)
}
DynamicEnv m blk
dynEnv
, hChainSyncServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer = \ConnectionId addrNTN
peer NodeToNodeVersion
_version ->
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
forall (m :: * -> *) blk.
(IOLike m, HasHeader (Header blk)) =>
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
chainSyncHeadersServer
((TraceChainSyncServerEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
-> Tracer m (TraceChainSyncServerEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncServerEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncServerEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
Node.chainSyncServerHeaderTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
ChainDB m blk
getChainDB
, hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient =
NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
forall header block versionNumber (m :: * -> *).
(MonadSTM m, MonadThrow m, MonadTime m, MonadMonotonicTime m,
HasHeader header, HasHeader block,
HeaderHash header ~ HeaderHash block) =>
versionNumber
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> FetchClientContext header block m
-> PeerPipelined
(BlockFetch block (Point block)) 'AsClient 'BFIdle m ()
blockFetchClient
, hBlockFetchServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer = \ConnectionId addrNTN
peer NodeToNodeVersion
version ->
Tracer m (TraceBlockFetchServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk, Typeable blk) =>
Tracer m (TraceBlockFetchServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
blockFetchServer
((TraceBlockFetchServerEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
-> Tracer m (TraceBlockFetchServerEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceBlockFetchServerEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceBlockFetchServerEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
Node.blockFetchServerTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
ChainDB m blk
getChainDB
NodeToNodeVersion
version
, hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient = \NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
peer ->
Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
forall txid tx idx (m :: * -> *).
(Ord txid, Ord idx, MonadSTM m, MonadThrow m) =>
Tracer m (TraceTxSubmissionOutbound txid tx)
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> TxSubmissionClient txid tx m ()
txSubmissionOutbound
((TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
Node.txOutboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
(Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Word16 -> NumTxIdsToAck
forall a b. (a -> b) -> a -> b
$ 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
-> TxSubmissionMempoolReader
(GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
(GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk
getMempool)
NodeToNodeVersion
version
ControlMessageSTM m
controlMessageSTM
, hTxSubmissionServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer = \NodeToNodeVersion
version ConnectionId addrNTN
peer ->
Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
-> NodeToNodeVersion
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
forall txid tx idx (m :: * -> *).
(Ord txid, NoThunks txid, NoThunks tx, MonadSTM m, MonadThrow m,
MonadDelay m) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolWriter txid tx idx m
-> NodeToNodeVersion
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInbound
((TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
Node.txInboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
(Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Word16 -> NumTxIdsToAck
forall a b. (a -> b) -> a -> b
$ 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
-> TxSubmissionMempoolReader
(GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
(GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk
getMempool)
(Mempool m blk
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
forall blk (m :: * -> *).
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
getMempoolWriter Mempool m blk
getMempool)
NodeToNodeVersion
version
, hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient = \NodeToNodeVersion
_version -> Tracer m (TraceKeepAliveClient (ConnectionId addrNTN))
-> StdGen
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
forall (m :: * -> *) peer.
(MonadTimer m, Ord peer) =>
Tracer m (TraceKeepAliveClient peer)
-> StdGen
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
keepAliveClient (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer m (TraceKeepAliveClient (ConnectionId addrNTN))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
Node.keepAliveClientTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers) StdGen
keepAliveRng
, hKeepAliveServer :: NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
hKeepAliveServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer
, hPeerSharingClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingClient = \NodeToNodeVersion
_version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
_peer -> ControlMessageSTM m
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
forall (m :: * -> *) peer.
(Alternative (STM m), MonadMVar m, MonadSTM m, MonadThrow m) =>
ControlMessageSTM m
-> PeerSharingController peer m -> m (PeerSharingClient peer m ())
peerSharingClient ControlMessageSTM m
controlMessageSTM
, hPeerSharingServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hPeerSharingServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> PeerSharingAPI addrNTN StdGen m -> PeerSharingServer addrNTN m
forall (m :: * -> *) peer s.
(MonadSTM m, MonadMonotonicTime m, Hashable peer, RandomGen s) =>
PeerSharingAPI peer s m -> PeerSharingServer peer m
peerSharingServer PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI
}
data Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS = Codecs {
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec :: Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
, forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised :: Codec (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
, forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec :: Codec (BlockFetch blk (Point blk)) e m bBF
, forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised :: Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
, forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec :: Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
, forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec KeepAlive e m bKA
cKeepAliveCodec :: Codec KeepAlive e m bKA
, forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec :: Codec (PeerSharing addr) e m bPS
}
defaultCodecs :: forall m blk addr.
( IOLike m
, SerialiseNodeToNodeConstraints blk
)
=> CodecConfig blk
-> BlockNodeToNodeVersion blk
-> (NodeToNodeVersion -> addr -> CBOR.Encoding)
-> (NodeToNodeVersion -> forall s . CBOR.Decoder s addr)
-> NodeToNodeVersion
-> Codecs blk addr DeserialiseFailure m
ByteString ByteString ByteString ByteString ByteString ByteString ByteString
defaultCodecs :: forall (m :: * -> *) blk addr.
(IOLike m, SerialiseNodeToNodeConstraints blk) =>
CodecConfig blk
-> BlockNodeToNodeVersion blk
-> (NodeToNodeVersion -> addr -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addr)
-> NodeToNodeVersion
-> Codecs
blk
addr
DeserialiseFailure
m
ByteString
ByteString
ByteString
ByteString
ByteString
ByteString
ByteString
defaultCodecs CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version NodeToNodeVersion -> addr -> Encoding
encAddr NodeToNodeVersion -> forall s. Decoder s addr
decAddr NodeToNodeVersion
nodeToNodeVersion = Codecs {
cChainSyncCodec :: Codec
(ChainSync (Header blk) (Point blk) (Tip blk))
DeserialiseFailure
m
ByteString
cChainSyncCodec =
(Header blk -> Encoding)
-> (forall s. Decoder s (Header blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
(ChainSync (Header blk) (Point blk) (Tip blk))
DeserialiseFailure
m
ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
(ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync
Header blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
Decoder s (Header blk)
forall s. Decoder s (Header blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
((HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall {k} (blk :: k).
(HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall {k} (blk :: k).
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
, cChainSyncCodecSerialised :: Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
DeserialiseFailure
m
ByteString
cChainSyncCodecSerialised =
(SerialisedHeader blk -> Encoding)
-> (forall s. Decoder s (SerialisedHeader blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
DeserialiseFailure
m
ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
(ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync
SerialisedHeader blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
Decoder s (SerialisedHeader blk)
forall s. Decoder s (SerialisedHeader blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
((HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall {k} (blk :: k).
(HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall {k} (blk :: k).
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
, cBlockFetchCodec :: Codec (BlockFetch blk (Point blk)) DeserialiseFailure m ByteString
cBlockFetchCodec =
(blk -> Encoding)
-> (forall s. Decoder s blk)
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> Codec
(BlockFetch blk (Point blk)) DeserialiseFailure m ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
Decoder s blk
forall s. Decoder s blk
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
, cBlockFetchCodecSerialised :: Codec
(BlockFetch (Serialised blk) (Point blk))
DeserialiseFailure
m
ByteString
cBlockFetchCodecSerialised =
(Serialised blk -> Encoding)
-> (forall s. Decoder s (Serialised blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> Codec
(BlockFetch (Serialised blk) (Point blk))
DeserialiseFailure
m
ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
Serialised blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
Decoder s (Serialised blk)
forall s. Decoder s (Serialised blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
, cTxSubmission2Codec :: Codec
(TxSubmission2 (GenTxId blk) (GenTx blk))
DeserialiseFailure
m
ByteString
cTxSubmission2Codec =
(GenTxId blk -> Encoding)
-> (forall s. Decoder s (GenTxId blk))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> Codec
(TxSubmission2 (GenTxId blk) (GenTx blk))
DeserialiseFailure
m
ByteString
forall txid tx (m :: * -> *).
MonadST m =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
codecTxSubmission2
GenTxId blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
Decoder s (GenTxId blk)
forall s. Decoder s (GenTxId blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
GenTx blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
, cKeepAliveCodec :: Codec KeepAlive DeserialiseFailure m ByteString
cKeepAliveCodec = Codec KeepAlive DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec KeepAlive DeserialiseFailure m ByteString
codecKeepAlive_v2
, cPeerSharingCodec :: Codec (PeerSharing addr) DeserialiseFailure m ByteString
cPeerSharingCodec = (addr -> Encoding)
-> (forall s. Decoder s addr)
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
forall (m :: * -> *) peerAddress.
MonadST m =>
(peerAddress -> Encoding)
-> (forall s. Decoder s peerAddress)
-> Codec (PeerSharing peerAddress) DeserialiseFailure m ByteString
codecPeerSharing (NodeToNodeVersion -> addr -> Encoding
encAddr NodeToNodeVersion
nodeToNodeVersion) (NodeToNodeVersion -> forall s. Decoder s addr
decAddr NodeToNodeVersion
nodeToNodeVersion)
}
where
p :: Proxy blk
p :: Proxy blk
p = Proxy blk
forall {k} (t :: k). Proxy t
Proxy
enc :: SerialiseNodeToNode blk a => a -> Encoding
enc :: forall a. SerialiseNodeToNode blk a => a -> Encoding
enc = CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version
dec :: SerialiseNodeToNode blk a => forall s. Decoder s a
dec :: forall a s. SerialiseNodeToNode blk a => Decoder s a
dec = CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version
identityCodecs :: Monad m
=> Codecs blk addr CodecFailure m
(AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
(AnyMessage (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
(AnyMessage (BlockFetch blk (Point blk)))
(AnyMessage (BlockFetch (Serialised blk) (Point blk)))
(AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
(AnyMessage KeepAlive)
(AnyMessage (PeerSharing addr))
identityCodecs :: forall (m :: * -> *) blk addr.
Monad m =>
Codecs
blk
addr
CodecFailure
m
(AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
(AnyMessage
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
(AnyMessage (BlockFetch blk (Point blk)))
(AnyMessage (BlockFetch (Serialised blk) (Point blk)))
(AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
(AnyMessage KeepAlive)
(AnyMessage (PeerSharing addr))
identityCodecs = Codecs {
cChainSyncCodec :: Codec
(ChainSync (Header blk) (Point blk) (Tip blk))
CodecFailure
m
(AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
cChainSyncCodec = Codec
(ChainSync (Header blk) (Point blk) (Tip blk))
CodecFailure
m
(AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2)
(m :: * -> *).
Monad m =>
Codec
(ChainSync header point tip)
CodecFailure
m
(AnyMessage (ChainSync header point tip))
codecChainSyncId
, cChainSyncCodecSerialised :: Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
CodecFailure
m
(AnyMessage
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
cChainSyncCodecSerialised = Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
CodecFailure
m
(AnyMessage
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2)
(m :: * -> *).
Monad m =>
Codec
(ChainSync header point tip)
CodecFailure
m
(AnyMessage (ChainSync header point tip))
codecChainSyncId
, cBlockFetchCodec :: Codec
(BlockFetch blk (Point blk))
CodecFailure
m
(AnyMessage (BlockFetch blk (Point blk)))
cBlockFetchCodec = Codec
(BlockFetch blk (Point blk))
CodecFailure
m
(AnyMessage (BlockFetch blk (Point blk)))
forall {k} {k1} (block :: k) (point :: k1) (m :: * -> *).
Monad m =>
Codec
(BlockFetch block point)
CodecFailure
m
(AnyMessage (BlockFetch block point))
codecBlockFetchId
, cBlockFetchCodecSerialised :: Codec
(BlockFetch (Serialised blk) (Point blk))
CodecFailure
m
(AnyMessage (BlockFetch (Serialised blk) (Point blk)))
cBlockFetchCodecSerialised = Codec
(BlockFetch (Serialised blk) (Point blk))
CodecFailure
m
(AnyMessage (BlockFetch (Serialised blk) (Point blk)))
forall {k} {k1} (block :: k) (point :: k1) (m :: * -> *).
Monad m =>
Codec
(BlockFetch block point)
CodecFailure
m
(AnyMessage (BlockFetch block point))
codecBlockFetchId
, cTxSubmission2Codec :: Codec
(TxSubmission2 (GenTxId blk) (GenTx blk))
CodecFailure
m
(AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
cTxSubmission2Codec = Codec
(TxSubmission2 (GenTxId blk) (GenTx blk))
CodecFailure
m
(AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
forall {k} {k1} (txid :: k) (tx :: k1) (m :: * -> *).
Monad m =>
Codec
(TxSubmission2 txid tx)
CodecFailure
m
(AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id
, cKeepAliveCodec :: Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
cKeepAliveCodec = Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
forall (m :: * -> *).
Monad m =>
Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId
, cPeerSharingCodec :: Codec
(PeerSharing addr) CodecFailure m (AnyMessage (PeerSharing addr))
cPeerSharingCodec = Codec
(PeerSharing addr) CodecFailure m (AnyMessage (PeerSharing addr))
forall {k} (peerAddress :: k) (m :: * -> *).
Monad m =>
Codec
(PeerSharing peerAddress)
CodecFailure
m
(AnyMessage (PeerSharing peerAddress))
codecPeerSharingId
}
type Tracers m peer blk e =
Tracers' peer blk e (Tracer m)
data Tracers' peer blk e f = Tracers {
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer :: f (TraceLabelPeer peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
}
instance (forall a. Semigroup (f a)) => Semigroup (Tracers' peer blk e f) where
Tracers' peer blk e f
l <> :: Tracers' peer blk e f
-> Tracers' peer blk e f -> Tracers' peer blk e f
<> Tracers' peer blk e f
r = Tracers {
tChainSyncTracer :: f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer
, tChainSyncSerialisedTracer :: f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer
, tBlockFetchTracer :: f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk)))))
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer
, tBlockFetchSerialisedTracer :: f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))))
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer
, tTxSubmission2Tracer :: f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))))
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer
}
where
f :: forall a. Semigroup a
=> (Tracers' peer blk e f -> a)
-> a
f :: forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f -> a
prj = Tracers' peer blk e f -> a
prj Tracers' peer blk e f
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Tracers' peer blk e f -> a
prj Tracers' peer blk e f
r
nullTracers :: Monad m => Tracers m peer blk e
nullTracers :: forall (m :: * -> *) peer blk e. Monad m => Tracers m peer blk e
nullTracers = Tracers {
tChainSyncTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer = Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tChainSyncSerialisedTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer = Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tBlockFetchTracer :: Tracer
m
(TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer = Tracer
m
(TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tBlockFetchSerialisedTracer :: Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tTxSubmission2Tracer :: Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer = Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
showTracers :: ( Show blk
, Show peer
, Show (Header blk)
, Show (GenTx blk)
, Show (GenTxId blk)
, HasHeader blk
, HasNestedContent Header blk
)
=> Tracer m String -> Tracers m peer blk e
showTracers :: forall blk peer (m :: * -> *) e.
(Show blk, Show peer, Show (Header blk), Show (GenTx blk),
Show (GenTxId blk), HasHeader blk, HasNestedContent Header blk) =>
Tracer m String -> Tracers m peer blk e
showTracers Tracer m String
tr = Tracers {
tChainSyncTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tChainSyncSerialisedTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tBlockFetchTracer :: Tracer
m
(TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tBlockFetchSerialisedTracer :: Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tTxSubmission2Tracer :: Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
}
type ClientApp m addr bytes a =
NodeToNodeVersion
-> ExpandedInitiatorContext addr m
-> Channel m bytes
-> m (a, Maybe bytes)
type ServerApp m addr bytes a =
NodeToNodeVersion
-> ResponderContext addr
-> Channel m bytes
-> m (a, Maybe bytes)
data Apps m addr bCS bBF bTX bKA bPS a b = Apps {
forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bCS a
aChainSyncClient :: ClientApp m addr bCS a
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bCS b
aChainSyncServer :: ServerApp m addr bCS b
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bBF a
aBlockFetchClient :: ClientApp m addr bBF a
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bBF b
aBlockFetchServer :: ServerApp m addr bBF b
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bTX a
aTxSubmission2Client :: ClientApp m addr bTX a
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bTX b
aTxSubmission2Server :: ServerApp m addr bTX b
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bKA a
aKeepAliveClient :: ClientApp m addr bKA a
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bKA b
aKeepAliveServer :: ServerApp m addr bKA b
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bPS a
aPeerSharingClient :: ClientApp m addr bPS a
, forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bPS b
aPeerSharingServer :: ServerApp m addr bPS b
}
data ByteLimits bCS bBF bTX bKA = ByteLimits {
forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync :: forall header point tip.
ProtocolSizeLimits
(ChainSync header point tip)
bCS
, forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall block point.
ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch :: forall block point.
ProtocolSizeLimits
(BlockFetch block point)
bBF
, forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2 :: forall txid tx.
ProtocolSizeLimits
(TxSubmission2 txid tx)
bTX
, forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA -> ProtocolSizeLimits KeepAlive bKA
blKeepAlive :: ProtocolSizeLimits
KeepAlive
bKA
}
noByteLimits :: ByteLimits bCS bBF bTX bKA
noByteLimits :: forall bCS bBF bTX bKA. ByteLimits bCS bBF bTX bKA
noByteLimits = ByteLimits {
blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync = (bCS -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bCS
forall {k} {k1} {k2} bytes (header :: k) (point :: k1) (tip :: k2).
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync (Word -> bCS -> Word
forall a b. a -> b -> a
const Word
0)
, blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch = (bBF -> Word) -> ProtocolSizeLimits (BlockFetch block point) bBF
forall {k} {k1} bytes (block :: k) (point :: k1).
(bytes -> Word)
-> ProtocolSizeLimits (BlockFetch block point) bytes
byteLimitsBlockFetch (Word -> bBF -> Word
forall a b. a -> b -> a
const Word
0)
, blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2 = (bTX -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall {k} {k1} bytes (txid :: k) (tx :: k1).
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 (Word -> bTX -> Word
forall a b. a -> b -> a
const Word
0)
, blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
blKeepAlive = (bKA -> Word) -> ProtocolSizeLimits KeepAlive bKA
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive (Word -> bKA -> Word
forall a b. a -> b -> a
const Word
0)
}
byteLimits :: ByteLimits ByteString ByteString ByteString ByteString
byteLimits :: ByteLimits ByteString ByteString ByteString ByteString
byteLimits = ByteLimits {
blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) ByteString
blChainSync = (ByteString -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) ByteString
forall {k} {k1} {k2} bytes (header :: k) (point :: k1) (tip :: k2).
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync ByteString -> Word
size
, blBlockFetch :: forall block point.
ProtocolSizeLimits (BlockFetch block point) ByteString
blBlockFetch = (ByteString -> Word)
-> ProtocolSizeLimits (BlockFetch block point) ByteString
forall {k} {k1} bytes (block :: k) (point :: k1).
(bytes -> Word)
-> ProtocolSizeLimits (BlockFetch block point) bytes
byteLimitsBlockFetch ByteString -> Word
size
, blTxSubmission2 :: forall txid tx.
ProtocolSizeLimits (TxSubmission2 txid tx) ByteString
blTxSubmission2 = (ByteString -> Word)
-> ProtocolSizeLimits (TxSubmission2 txid tx) ByteString
forall {k} {k1} bytes (txid :: k) (tx :: k1).
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 ByteString -> Word
size
, blKeepAlive :: ProtocolSizeLimits KeepAlive ByteString
blKeepAlive = (ByteString -> Word) -> ProtocolSizeLimits KeepAlive ByteString
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive ByteString -> Word
size
}
where
size :: ByteString -> Word
size :: ByteString -> Word
size = (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word)
(Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
mkApps ::
forall m addrNTN addrNTC blk e bCS bBF bTX bKA bPS.
( IOLike m
, MonadTimer m
, Ord addrNTN
, Exception e
, LedgerSupportsProtocol blk
, ShowProxy blk
, ShowProxy (Header blk)
, ShowProxy (TxId (GenTx blk))
, ShowProxy (GenTx blk)
)
=> NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) blk e
-> (NodeToNodeVersion -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS)
-> ByteLimits bCS bBF bTX bKA
-> m ChainSyncTimeout
-> CsClient.ChainSyncLoPBucketConfig
-> CsClient.CSJConfig
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m addrNTN blk
-> Apps m addrNTN bCS bBF bTX bKA bPS NodeToNodeInitiatorResult ()
mkApps :: forall (m :: * -> *) addrNTN addrNTC blk e bCS bBF bTX bKA bPS.
(IOLike m, MonadTimer m, Ord addrNTN, Exception e,
LedgerSupportsProtocol blk, ShowProxy blk, ShowProxy (Header blk),
ShowProxy (TxId (GenTx blk)), ShowProxy (GenTx blk)) =>
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) blk e
-> (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS)
-> ByteLimits bCS bBF bTX bKA
-> m ChainSyncTimeout
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m addrNTN blk
-> Apps m addrNTN bCS bBF bTX bKA bPS NodeToNodeInitiatorResult ()
mkApps NodeKernel m addrNTN addrNTC blk
kernel Tracers {Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch blk (Point blk))))
Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tChainSyncTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tBlockFetchTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchSerialisedTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tChainSyncTracer :: Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tBlockFetchTracer :: Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchSerialisedTracer :: Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
..} NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs ByteLimits {ProtocolSizeLimits KeepAlive bKA
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blBlockFetch :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall block point.
ProtocolSizeLimits (BlockFetch block point) bBF
blTxSubmission2 :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blKeepAlive :: forall bCS bBF bTX bKA.
ByteLimits bCS bBF bTX bKA -> ProtocolSizeLimits KeepAlive bKA
blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
..} m ChainSyncTimeout
genChainSyncTimeout ChainSyncLoPBucketConfig
lopBucketConfig CSJConfig
csjConfig ReportPeerMetrics {Tracer
(STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
Tracer
(STM m)
(TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportHeader :: Tracer
(STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
reportFetch :: Tracer
(STM m)
(TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportHeader :: forall (m :: * -> *) peerAddr.
ReportPeerMetrics m peerAddr
-> Tracer (STM m) (TraceLabelPeer peerAddr (SlotNo, Time))
reportFetch :: forall (m :: * -> *) peerAddr.
ReportPeerMetrics m peerAddr
-> Tracer
(STM m) (TraceLabelPeer peerAddr (SizeInBytes, SlotNo, Time))
..} Handlers {NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
hBlockFetchClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hTxSubmissionClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
hKeepAliveClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion -> ConnectionId addr -> KeepAliveServer m ()
hPeerSharingClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
hPeerSharingServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
hChainSyncClient :: ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveServer :: NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
hPeerSharingClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
..} =
Apps {ServerApp m addrNTN bCS ()
ServerApp m addrNTN bBF ()
ServerApp m addrNTN bTX ()
ServerApp m addrNTN bKA ()
ServerApp m addrNTN bPS ()
ClientApp m addrNTN bCS NodeToNodeInitiatorResult
ClientApp m addrNTN bBF NodeToNodeInitiatorResult
ClientApp m addrNTN bTX NodeToNodeInitiatorResult
ClientApp m addrNTN bKA NodeToNodeInitiatorResult
ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncServer :: ServerApp m addrNTN bCS ()
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingServer :: ServerApp m addrNTN bPS ()
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncServer :: ServerApp m addrNTN bCS ()
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingServer :: ServerApp m addrNTN bPS ()
..}
where
aChainSyncClient
:: NodeToNodeVersion
-> ExpandedInitiatorContext addrNTN m
-> Channel m bCS
-> m (NodeToNodeInitiatorResult, Maybe bCS)
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext {
eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them,
eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM,
eicIsBigLedgerPeer :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> IsBigLedgerPeer
eicIsBigLedgerPeer = IsBigLedgerPeer
isBigLedgerPeer
}
Channel m bCS
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"ChainSyncClient"
FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
-> ConnectionId addrNTN
-> m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall (m :: * -> *) a peer header block.
(MonadSTM m, MonadFork m, MonadCatch m, Ord peer) =>
FetchClientRegistry peer header block m -> peer -> m a -> m a
bracketSyncWithFetchClient
(NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel) ConnectionId addrNTN
them (m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$
Tracer m (TraceChainSyncClientEvent blk)
-> ChainDbView m blk
-> StrictTVar
m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
-> STM m GsmState
-> ConnectionId addrNTN
-> NodeToNodeVersion
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> (ChainSyncStateView m blk
-> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall (m :: * -> *) peer blk a.
(IOLike m, Ord peer, LedgerSupportsProtocol blk, MonadTimer m) =>
Tracer m (TraceChainSyncClientEvent blk)
-> ChainDbView m blk
-> StrictTVar m (Map peer (ChainSyncClientHandle m blk))
-> STM m GsmState
-> peer
-> NodeToNodeVersion
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> (ChainSyncStateView m blk -> m a)
-> m a
CsClient.bracketChainSyncClient
((TraceChainSyncClientEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) (Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer (NodeKernel m addrNTN addrNTC blk
-> Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers NodeKernel m addrNTN addrNTC blk
kernel)))
(ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
ChainDB m blk -> ChainDbView m blk
CsClient.defaultChainDbView (NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB NodeKernel m addrNTN addrNTC blk
kernel))
(NodeKernel m addrNTN addrNTC blk
-> StrictTVar
m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> StrictTVar
m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
getChainSyncHandles NodeKernel m addrNTN addrNTC blk
kernel)
(NodeKernel m addrNTN addrNTC blk -> STM m GsmState
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState NodeKernel m addrNTN addrNTC blk
kernel)
ConnectionId addrNTN
them
NodeToNodeVersion
version
ChainSyncLoPBucketConfig
lopBucketConfig
CSJConfig
csjConfig
((ChainSyncStateView m blk
-> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS))
-> (ChainSyncStateView m blk
-> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \ChainSyncStateView m blk
csState -> do
ChainSyncTimeout
chainSyncTimeout <- m ChainSyncTimeout
genChainSyncTimeout
(ChainSyncClientResult
r, Maybe bCS
trailing) <-
Tracer
m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
-> ProtocolSizeLimits
(ChainSync (Header blk) (Point blk) (Tip blk)) bCS
-> ProtocolTimeLimits
(ChainSync (Header blk) (Point blk) (Tip blk))
-> Channel m bCS
-> PeerPipelined
(ChainSync (Header blk) (Point blk) (Tip blk))
'AsClient
'StIdle
m
ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM 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
(ConnectionId addrNTN)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer)
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits
(ChainSync (Header blk) (Point blk) (Tip blk)) bCS
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync
(ChainSyncTimeout
-> ProtocolTimeLimits
(ChainSync (Header blk) (Point blk) (Tip blk))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
chainSyncTimeout)
Channel m bCS
channel
(PeerPipelined
(ChainSync (Header blk) (Point blk) (Tip blk))
'AsClient
'StIdle
m
ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS))
-> PeerPipelined
(ChainSync (Header blk) (Point blk) (Tip blk))
'AsClient
'StIdle
m
ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
-> PeerPipelined
(ChainSync (Header blk) (Point blk) (Tip blk))
'AsClient
'StIdle
m
ChainSyncClientResult
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClientPipelined header point tip m a
-> 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
$ ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
(Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient
ConnectionId addrNTN
them
IsBigLedgerPeer
isBigLedgerPeer
CsClient.DynamicEnv {
NodeToNodeVersion
version :: NodeToNodeVersion
$sel:version:DynamicEnv :: NodeToNodeVersion
CsClient.version
, ControlMessageSTM m
controlMessageSTM :: ControlMessageSTM m
$sel:controlMessageSTM:DynamicEnv :: ControlMessageSTM m
CsClient.controlMessageSTM
, $sel:headerMetricsTracer:DynamicEnv :: HeaderMetricsTracer m
CsClient.headerMetricsTracer = ConnectionId addrNTN
-> (SlotNo, Time)
-> TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them ((SlotNo, Time)
-> TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
-> Tracer
(STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
-> HeaderMetricsTracer m
forall a' a. (a' -> a) -> Tracer (STM m) a -> Tracer (STM m) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
(STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
reportHeader
, $sel:setCandidate:DynamicEnv :: AnchoredFragment (Header blk) -> STM m ()
CsClient.setCandidate = ChainSyncStateView m blk
-> AnchoredFragment (Header blk) -> STM m ()
forall (m :: * -> *) blk.
ChainSyncStateView m blk
-> AnchoredFragment (Header blk) -> STM m ()
csvSetCandidate ChainSyncStateView m blk
csState
, $sel:idling:DynamicEnv :: Idling m
CsClient.idling = ChainSyncStateView m blk -> Idling m
forall (m :: * -> *) blk. ChainSyncStateView m blk -> Idling m
csvIdling ChainSyncStateView m blk
csState
, $sel:loPBucket:DynamicEnv :: LoPBucket m
CsClient.loPBucket = ChainSyncStateView m blk -> LoPBucket m
forall (m :: * -> *) blk. ChainSyncStateView m blk -> LoPBucket m
csvLoPBucket ChainSyncStateView m blk
csState
, $sel:setLatestSlot:DynamicEnv :: WithOrigin SlotNo -> STM m ()
CsClient.setLatestSlot = ChainSyncStateView m blk -> WithOrigin SlotNo -> STM m ()
forall (m :: * -> *) blk.
ChainSyncStateView m blk -> WithOrigin SlotNo -> STM m ()
csvSetLatestSlot ChainSyncStateView m blk
csState
, $sel:jumping:DynamicEnv :: Jumping m blk
CsClient.jumping = ChainSyncStateView m blk -> Jumping m blk
forall (m :: * -> *) blk. ChainSyncStateView m blk -> Jumping m blk
csvJumping ChainSyncStateView m blk
csState
}
(NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainSyncClientResult -> NodeToNodeInitiatorResult
ChainSyncInitiatorResult ChainSyncClientResult
r, Maybe bCS
trailing)
aChainSyncServer
:: NodeToNodeVersion
-> ResponderContext addrNTN
-> Channel m bCS
-> m ((), Maybe bCS)
aChainSyncServer :: ServerApp m addrNTN bCS ()
aChainSyncServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bCS
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"ChainSyncServer"
ChainSyncTimeout
chainSyncTimeout <- m ChainSyncTimeout
genChainSyncTimeout
(ResourceRegistry m
-> m (Follower m blk (WithPoint blk (SerialisedHeader blk))))
-> (Follower m blk (WithPoint blk (SerialisedHeader blk)) -> m ())
-> (Follower m blk (WithPoint blk (SerialisedHeader blk))
-> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall (m :: * -> *) a r.
(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 addrNTN addrNTC blk -> ChainDB m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB NodeKernel m addrNTN addrNTC blk
kernel)
( case NodeToNodeVersion -> WhetherReceivingTentativeBlocks
isPipeliningEnabled NodeToNodeVersion
version of
WhetherReceivingTentativeBlocks
ReceivingTentativeBlocks -> ChainType
ChainDB.TentativeChain
WhetherReceivingTentativeBlocks
NotReceivingTentativeBlocks -> 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),
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
(ConnectionId addrNTN)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
m
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer)
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bCS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) bCS
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync
(ChainSyncTimeout
-> ProtocolTimeLimits
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
forall {k} {k1} {k2} (header :: k) (point :: k1) (tip :: k2).
ChainSyncTimeout -> ProtocolTimeLimits (ChainSync header point tip)
timeLimitsChainSync ChainSyncTimeout
chainSyncTimeout)
Channel m bCS
channel
(Peer
(ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
'AsServer
'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
$ ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
(SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer ConnectionId addrNTN
them NodeToNodeVersion
version Follower m blk (WithPoint blk (SerialisedHeader blk))
flr
aBlockFetchClient
:: NodeToNodeVersion
-> ExpandedInitiatorContext addrNTN m
-> Channel m bBF
-> m (NodeToNodeInitiatorResult, Maybe bBF)
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext {
eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them,
eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
}
Channel m bBF
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchClient"
FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
-> NodeToNodeVersion
-> (NodeToNodeVersion -> WhetherReceivingTentativeBlocks)
-> ConnectionId addrNTN
-> (FetchClientContext (Header blk) blk m
-> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall (m :: * -> *) a peer header block version.
(MonadFork m, MonadMask m, MonadTimer m, Ord peer) =>
FetchClientRegistry peer header block m
-> version
-> (version -> WhetherReceivingTentativeBlocks)
-> peer
-> (FetchClientContext header block m -> m a)
-> m a
bracketFetchClient (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel) NodeToNodeVersion
version
NodeToNodeVersion -> WhetherReceivingTentativeBlocks
isPipeliningEnabled ConnectionId addrNTN
them ((FetchClientContext (Header blk) blk m
-> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF))
-> (FetchClientContext (Header blk) blk m
-> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall a b. (a -> b) -> a -> b
$ \FetchClientContext (Header blk) blk m
clientCtx -> do
((), Maybe bBF
trailing) <- Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
-> Codec (BlockFetch blk (Point blk)) e m bBF
-> ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
-> ProtocolTimeLimits (BlockFetch blk (Point blk))
-> Channel m bBF
-> PeerPipelined
(BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM 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
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (BlockFetch blk (Point blk))
-> TraceLabelPeer
(ConnectionId addrNTN) (TraceSendRecv (BlockFetch blk (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer)
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (BlockFetch blk (Point blk)) e m bBF
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
ProtocolTimeLimits (BlockFetch blk (Point blk))
forall {k} {k1} (block :: k) (point :: k1).
ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
Channel m bBF
channel
(PeerPipelined (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF))
-> PeerPipelined
(BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (Header blk) blk m ()
hBlockFetchClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM
(ConnectionId addrNTN
-> (SizeInBytes, SlotNo, Time)
-> TraceLabelPeer
(ConnectionId addrNTN) (SizeInBytes, SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them ((SizeInBytes, SlotNo, Time)
-> TraceLabelPeer
(ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
-> Tracer
(STM m)
(TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
-> FetchedMetricsTracer m
forall a' a. (a' -> a) -> Tracer (STM m) a -> Tracer (STM m) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
(STM m)
(TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportFetch) FetchClientContext (Header blk) blk m
clientCtx
(NodeToNodeInitiatorResult, Maybe bBF)
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bBF
trailing)
aBlockFetchServer
:: NodeToNodeVersion
-> ResponderContext addrNTN
-> Channel m bBF
-> m ((), Maybe bBF)
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aBlockFetchServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bBF
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchServer"
(ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF)
forall (m :: * -> *) a.
(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),
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
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
m (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer)
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bBF
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits (BlockFetch (Serialised blk) (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
ProtocolTimeLimits (BlockFetch (Serialised blk) (Point blk))
forall {k} {k1} (block :: k) (point :: k1).
ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
Channel m bBF
channel
(Peer
(BlockFetch (Serialised blk) (Point blk)) 'AsServer '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
$ ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer ConnectionId addrNTN
them NodeToNodeVersion
version ResourceRegistry m
registry
aTxSubmission2Client
:: NodeToNodeVersion
-> ExpandedInitiatorContext addrNTN m
-> Channel m bTX
-> m (NodeToNodeInitiatorResult, Maybe bTX)
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext {
eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them,
eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
}
Channel m bTX
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionClient"
((), Maybe bTX
trailing) <- Tracer
m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
-> ProtocolSizeLimits
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
-> ProtocolTimeLimits
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> Channel m bTX
-> Peer
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
'AsClient
'StInit
m
()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
MonadTimer m, 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 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tTxSubmission2Tracer)
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
ProtocolTimeLimits (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
forall {k} {k1} (txid :: k) (tx :: k1).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
Channel m bTX
channel
(TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
-> Peer
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
'AsClient
'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
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them))
(NodeToNodeInitiatorResult, Maybe bTX)
-> m (NodeToNodeInitiatorResult, Maybe bTX)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bTX
trailing)
aTxSubmission2Server
:: NodeToNodeVersion
-> ResponderContext addrNTN
-> Channel m bTX
-> m ((), Maybe bTX)
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aTxSubmission2Server NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bTX
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionServer"
Tracer
m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
-> ProtocolSizeLimits
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
-> ProtocolTimeLimits
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> Channel m bTX
-> PeerPipelined
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
'AsServer
'StInit
m
()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM 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 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
m
(TraceLabelPeer
(ConnectionId addrNTN)
(TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tTxSubmission2Tracer)
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
ProtocolTimeLimits (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
forall {k} {k1} (txid :: k) (tx :: k1).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
Channel m bTX
channel
(TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
-> PeerPipelined
(TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
'AsServer
'StInit
m
()
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> PeerPipelined (TxSubmission2 txid tx) 'AsServer 'StInit m a
txSubmissionServerPeerPipelined (NodeToNodeVersion
-> ConnectionId addrNTN
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionServer NodeToNodeVersion
version ConnectionId addrNTN
them))
aKeepAliveClient
:: NodeToNodeVersion
-> ExpandedInitiatorContext addrNTN m
-> Channel m bKA
-> m (NodeToNodeInitiatorResult, Maybe bKA)
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext {
eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them,
eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
}
Channel m bKA
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveClient"
let kacApp :: StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA)
kacApp = \StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
dqCtx ->
Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive e m bKA
-> ProtocolSizeLimits KeepAlive bKA
-> ProtocolTimeLimits KeepAlive
-> Channel m bKA
-> Peer KeepAlive 'AsClient 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
MonadTimer m, 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 addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec KeepAlive e m bKA
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
ProtocolSizeLimits KeepAlive bKA
blKeepAlive
ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
Channel m bKA
channel
(Peer KeepAlive 'AsClient '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
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
dqCtx
(DiffTime -> KeepAliveInterval
KeepAliveInterval DiffTime
10)
((), Maybe bKA
trailing) <- FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
-> ConnectionId addrNTN
-> (StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA))
-> m ((), Maybe bKA)
forall (m :: * -> *) a peer header block.
(MonadSTM m, MonadFork m, MonadMask m, Ord peer) =>
FetchClientRegistry peer header block m
-> peer -> (StrictTVar m (Map peer PeerGSV) -> m a) -> m a
bracketKeepAliveClient (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel) ConnectionId addrNTN
them StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA)
kacApp
(NodeToNodeInitiatorResult, Maybe bKA)
-> m (NodeToNodeInitiatorResult, Maybe bKA)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bKA
trailing)
aKeepAliveServer
:: NodeToNodeVersion
-> ResponderContext addrNTN
-> Channel m bKA
-> m ((), Maybe bKA)
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aKeepAliveServer NodeToNodeVersion
version ResponderContext addrNTN
_responderCtx 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),
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 addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec KeepAlive e m bKA
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
((bKA -> Word) -> ProtocolSizeLimits KeepAlive bKA
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive (Word -> bKA -> Word
forall a b. a -> b -> a
const Word
0))
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
aPeerSharingClient
:: NodeToNodeVersion
-> ExpandedInitiatorContext addrNTN m
-> Channel m bPS
-> m (NodeToNodeInitiatorResult, Maybe bPS)
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext {
eicConnectionId :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them,
eicControlMessage :: forall addr (m :: * -> *).
ExpandedInitiatorContext addr m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
}
Channel m bPS
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingClient"
PeerSharingRegistry addrNTN m
-> addrNTN
-> (PeerSharingController addrNTN m
-> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall peer (m :: * -> *) a.
(Ord peer, MonadSTM m, MonadThrow m) =>
PeerSharingRegistry peer m
-> peer -> (PeerSharingController peer m -> m a) -> m a
bracketPeerSharingClient (NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
getPeerSharingRegistry NodeKernel m addrNTN addrNTC blk
kernel) (ConnectionId addrNTN -> addrNTN
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId addrNTN
them)
((PeerSharingController addrNTN m
-> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS))
-> (PeerSharingController addrNTN m
-> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall a b. (a -> b) -> a -> b
$ \PeerSharingController addrNTN m
controller -> do
PeerSharingClient addrNTN m ()
psClient <- NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them PeerSharingController addrNTN m
controller
((), Maybe bPS
trailing) <- Tracer m (TraceSendRecv (PeerSharing addrNTN))
-> Codec (PeerSharing addrNTN) e m bPS
-> ProtocolSizeLimits (PeerSharing addrNTN) bPS
-> ProtocolTimeLimits (PeerSharing addrNTN)
-> Channel m bPS
-> Peer (PeerSharing addrNTN) 'AsClient 'StIdle m ()
-> m ((), Maybe bPS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
MonadTimer m, 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 (PeerSharing addrNTN))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (PeerSharing addrNTN) e m bPS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
((bPS -> Word) -> ProtocolSizeLimits (PeerSharing addrNTN) bPS
forall {k} bytes (peerAddress :: k).
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing (Word -> bPS -> Word
forall a b. a -> b -> a
const Word
0))
ProtocolTimeLimits (PeerSharing addrNTN)
forall {k} (peerAddress :: k).
ProtocolTimeLimits (PeerSharing peerAddress)
timeLimitsPeerSharing
Channel m bPS
channel
(PeerSharingClient addrNTN m ()
-> Peer (PeerSharing addrNTN) 'AsClient 'StIdle m ()
forall (m :: * -> *) peerAddress a.
Monad m =>
PeerSharingClient peerAddress m a
-> Peer (PeerSharing peerAddress) 'AsClient 'StIdle m a
peerSharingClientPeer PeerSharingClient addrNTN m ()
psClient)
(NodeToNodeInitiatorResult, Maybe bPS)
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeToNodeInitiatorResult
NoInitiatorResult, Maybe bPS
trailing)
aPeerSharingServer
:: NodeToNodeVersion
-> ResponderContext addrNTN
-> Channel m bPS
-> m ((), Maybe bPS)
aPeerSharingServer :: ServerApp m addrNTN bPS ()
aPeerSharingServer NodeToNodeVersion
version ResponderContext { rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them } Channel m bPS
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingServer"
Tracer m (TraceSendRecv (PeerSharing addrNTN))
-> Codec (PeerSharing addrNTN) e m bPS
-> ProtocolSizeLimits (PeerSharing addrNTN) bPS
-> ProtocolTimeLimits (PeerSharing addrNTN)
-> Channel m bPS
-> Peer (PeerSharing addrNTN) 'AsServer 'StIdle m ()
-> m ((), Maybe bPS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadAsync m, MonadFork m, MonadMask m, MonadThrow (STM m),
MonadTimer m, 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 (PeerSharing addrNTN))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
(Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
-> Codec (PeerSharing addrNTN) e m bPS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bKA bPS.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS
mkCodecs NodeToNodeVersion
version))
((bPS -> Word) -> ProtocolSizeLimits (PeerSharing addrNTN) bPS
forall {k} bytes (peerAddress :: k).
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing (Word -> bPS -> Word
forall a b. a -> b -> a
const Word
0))
ProtocolTimeLimits (PeerSharing addrNTN)
forall {k} (peerAddress :: k).
ProtocolTimeLimits (PeerSharing peerAddress)
timeLimitsPeerSharing
Channel m bPS
channel
(Peer (PeerSharing addrNTN) 'AsServer 'StIdle m ()
-> m ((), Maybe bPS))
-> Peer (PeerSharing addrNTN) 'AsServer 'StIdle m ()
-> m ((), Maybe bPS)
forall a b. (a -> b) -> a -> b
$ PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'StIdle m ()
forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Peer (PeerSharing peerAddress) 'AsServer 'StIdle m ()
peerSharingServerPeer
(PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'StIdle m ())
-> PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'StIdle m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hPeerSharingServer NodeToNodeVersion
version ConnectionId addrNTN
them
initiator ::
MiniProtocolParameters
-> NodeToNodeVersion
-> PSTypes.PeerSharing
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx 'InitiatorMode addr b m a Void
initiator :: forall (m :: * -> *) addr b a c.
MiniProtocolParameters
-> NodeToNodeVersion
-> PeerSharing
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx 'InitiatorMode addr b m a Void
initiator MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version PeerSharing
ownPeerSharing Apps {ServerApp m addr b c
ClientApp m addr b a
aChainSyncClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bCS a
aChainSyncServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bCS b
aBlockFetchClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bBF a
aBlockFetchServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bBF b
aTxSubmission2Client :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bTX a
aTxSubmission2Server :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bTX b
aKeepAliveClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bKA a
aKeepAliveServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bKA b
aPeerSharingClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bPS a
aPeerSharingServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bPS b
aChainSyncClient :: ClientApp m addr b a
aChainSyncServer :: ServerApp m addr b c
aBlockFetchClient :: ClientApp m addr b a
aBlockFetchServer :: ServerApp m addr b c
aTxSubmission2Client :: ClientApp m addr b a
aTxSubmission2Server :: ServerApp m addr b c
aKeepAliveClient :: ClientApp m addr b a
aKeepAliveServer :: ServerApp m addr b c
aPeerSharingClient :: ClientApp m addr b a
aPeerSharingServer :: ServerApp m addr b c
..} =
MiniProtocolParameters
-> NodeToNodeProtocols
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
forall (muxMode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocolParameters
-> NodeToNodeProtocols
muxMode initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
MiniProtocolParameters
miniProtocolParameters
(NodeToNodeProtocols {
chainSyncProtocol :: RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
chainSyncProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
blockFetchProtocol :: RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
blockFetchProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
txSubmissionProtocol :: RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
txSubmissionProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
keepAliveProtocol :: RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
keepAliveProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx))),
peerSharingProtocol :: RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
peerSharingProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> RunMiniProtocol
'InitiatorMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
ctx -> ClientApp m addr b a
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
ctx)))
})
NodeToNodeVersion
version
PeerSharing
ownPeerSharing
initiatorAndResponder ::
MiniProtocolParameters
-> NodeToNodeVersion
-> PSTypes.PeerSharing
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx 'InitiatorResponderMode addr b m a c
initiatorAndResponder :: forall (m :: * -> *) addr b a c.
MiniProtocolParameters
-> NodeToNodeVersion
-> PeerSharing
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx
'InitiatorResponderMode addr b m a c
initiatorAndResponder MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version PeerSharing
ownPeerSharing Apps {ServerApp m addr b c
ClientApp m addr b a
aChainSyncClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bCS a
aChainSyncServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bCS b
aBlockFetchClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bBF a
aBlockFetchServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bBF b
aTxSubmission2Client :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bTX a
aTxSubmission2Server :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bTX b
aKeepAliveClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bKA a
aKeepAliveServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bKA b
aPeerSharingClient :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ClientApp m addr bPS a
aPeerSharingServer :: forall (m :: * -> *) addr bCS bBF bTX bKA bPS a b.
Apps m addr bCS bBF bTX bKA bPS a b -> ServerApp m addr bPS b
aChainSyncClient :: ClientApp m addr b a
aChainSyncServer :: ServerApp m addr b c
aBlockFetchClient :: ClientApp m addr b a
aBlockFetchServer :: ServerApp m addr b c
aTxSubmission2Client :: ClientApp m addr b a
aTxSubmission2Server :: ServerApp m addr b c
aKeepAliveClient :: ClientApp m addr b a
aKeepAliveServer :: ServerApp m addr b c
aPeerSharingClient :: ClientApp m addr b a
aPeerSharingServer :: ServerApp m addr b c
..} =
MiniProtocolParameters
-> NodeToNodeProtocols
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
forall (muxMode :: MuxMode) initiatorCtx responderCtx bytes
(m :: * -> *) a b.
MiniProtocolParameters
-> NodeToNodeProtocols
muxMode initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> PeerSharing
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
MiniProtocolParameters
miniProtocolParameters
(NodeToNodeProtocols {
chainSyncProtocol :: RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
chainSyncProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aChainSyncServer NodeToNodeVersion
version ResponderContext addr
responderCtx))),
blockFetchProtocol :: RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
blockFetchProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aBlockFetchServer NodeToNodeVersion
version ResponderContext addr
responderCtx))),
txSubmissionProtocol :: RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
txSubmissionProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aTxSubmission2Server NodeToNodeVersion
version ResponderContext addr
responderCtx))),
keepAliveProtocol :: RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
keepAliveProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aKeepAliveServer NodeToNodeVersion
version ResponderContext addr
responderCtx))),
peerSharingProtocol :: RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
peerSharingProtocol =
(MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
'InitiatorResponderMode
(ExpandedInitiatorContext addr m)
(ResponderContext addr)
b
m
a
c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
((ExpandedInitiatorContext addr m -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ExpandedInitiatorContext addr m) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr m
initiatorCtx -> ClientApp m addr b a
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext addr m
initiatorCtx))
((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aPeerSharingServer NodeToNodeVersion
version ResponderContext addr
responderCtx)))
})
NodeToNodeVersion
version
PeerSharing
ownPeerSharing