{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Consensus.Network.NodeToClient (
Handlers (..)
, mkHandlers
, ClientCodecs
, Codecs
, Codecs' (..)
, DefaultCodecs
, clientCodecs
, defaultCodecs
, identityCodecs
, Tracers
, Tracers' (..)
, nullTracers
, showTracers
, App
, Apps (..)
, mkApps
, responder
) where
import Codec.CBOR.Decoding (Decoder)
import Codec.CBOR.Encoding (Encoding)
import Codec.CBOR.Read (DeserialiseFailure)
import Codec.Serialise (Serialise)
import Control.Tracer
import Data.ByteString.Lazy (ByteString)
import Data.Void (Void)
import Network.TypedProtocol.Codec
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import Ouroboros.Consensus.MiniProtocol.LocalStateQuery.Server
import Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server
import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Run
import Ouroboros.Consensus.Node.Serialisation
import qualified Ouroboros.Consensus.Node.Tracers as Node
import Ouroboros.Consensus.NodeKernel
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import Ouroboros.Consensus.Util (ShowProxy)
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.Orphans ()
import Ouroboros.Consensus.Util.ResourceRegistry
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (Serialised, decodePoint, decodeTip,
encodePoint, encodeTip)
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.Channel
import Ouroboros.Network.Context
import Ouroboros.Network.Driver
import Ouroboros.Network.Mux
import Ouroboros.Network.NodeToClient hiding
(NodeToClientVersion (..))
import qualified Ouroboros.Network.NodeToClient as N (NodeToClientVersion (..))
import Ouroboros.Network.Protocol.ChainSync.Codec
import Ouroboros.Network.Protocol.ChainSync.Server
import Ouroboros.Network.Protocol.ChainSync.Type
import Ouroboros.Network.Protocol.LocalStateQuery.Codec
import Ouroboros.Network.Protocol.LocalStateQuery.Server
import Ouroboros.Network.Protocol.LocalStateQuery.Type
import Ouroboros.Network.Protocol.LocalTxMonitor.Codec
import Ouroboros.Network.Protocol.LocalTxMonitor.Server
import Ouroboros.Network.Protocol.LocalTxMonitor.Type
import Ouroboros.Network.Protocol.LocalTxSubmission.Codec
import Ouroboros.Network.Protocol.LocalTxSubmission.Server
import Ouroboros.Network.Protocol.LocalTxSubmission.Type
data Handlers m peer blk = Handlers {
forall (m :: * -> *) peer blk.
Handlers m peer blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer
:: ChainDB.Follower m blk (ChainDB.WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
, forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hTxSubmissionServer
:: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
, forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
hStateQueryServer
:: LocalStateQueryServer blk (Point blk) (Query blk) m ()
, forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hTxMonitorServer
:: LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
}
mkHandlers ::
forall m blk addrNTN addrNTC.
( IOLike m
, LedgerSupportsMempool blk
, LedgerSupportsProtocol blk
, BlockSupportsLedgerQuery blk
, ConfigSupportsNode blk
)
=> NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk
-> Handlers m addrNTC blk
mkHandlers :: forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, LedgerSupportsMempool blk, LedgerSupportsProtocol blk,
BlockSupportsLedgerQuery blk, ConfigSupportsNode blk) =>
NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk -> Handlers m addrNTC blk
mkHandlers NodeKernelArgs {TopLevelConfig blk
cfg :: TopLevelConfig blk
$sel:cfg:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> TopLevelConfig blk
cfg, Tracers m (ConnectionId addrNTN) addrNTC blk
tracers :: Tracers m (ConnectionId addrNTN) addrNTC blk
$sel:tracers:NodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
tracers} 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} =
Handlers {
hChainSyncServer :: Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer =
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised 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 (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
chainSyncBlocksServer
(Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer m (TraceChainSyncServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceChainSyncServerEvent blk)
Node.chainSyncServerBlockTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers)
ChainDB m blk
getChainDB
, hTxSubmissionServer :: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hTxSubmissionServer =
Tracer m (TraceLocalTxSubmissionServerEvent blk)
-> Mempool m blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
forall (m :: * -> *) blk.
MonadSTM m =>
Tracer m (TraceLocalTxSubmissionServerEvent blk)
-> Mempool m blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
localTxSubmissionServer
(Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer m (TraceLocalTxSubmissionServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLocalTxSubmissionServerEvent blk)
Node.localTxSubmissionServerTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers)
Mempool m blk
getMempool
, hStateQueryServer :: LocalStateQueryServer blk (Point blk) (Query blk) m ()
hStateQueryServer =
ExtLedgerCfg blk
-> STM m (Point blk)
-> (Point blk -> STM m (Maybe (ExtLedgerState blk)))
-> STM m (Point blk)
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
forall (m :: * -> *) blk.
(IOLike m, BlockSupportsLedgerQuery blk, ConfigSupportsNode blk,
HasAnnTip blk) =>
ExtLedgerCfg blk
-> STM m (Point blk)
-> (Point blk -> STM m (Maybe (ExtLedgerState blk)))
-> STM m (Point blk)
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
localStateQueryServer
(TopLevelConfig blk -> ExtLedgerCfg blk
forall blk. TopLevelConfig blk -> ExtLedgerCfg blk
ExtLedgerCfg TopLevelConfig blk
cfg)
(ChainDB m blk -> STM m (Point blk)
forall (m :: * -> *) blk. ChainDB m blk -> STM m (Point blk)
ChainDB.getTipPoint ChainDB m blk
getChainDB)
(ChainDB m blk -> Point blk -> STM m (Maybe (ExtLedgerState blk))
forall (m :: * -> *) blk.
(Monad (STM m), LedgerSupportsProtocol blk) =>
ChainDB m blk -> Point blk -> STM m (Maybe (ExtLedgerState blk))
ChainDB.getPastLedger ChainDB m blk
getChainDB)
(Point (Header blk) -> Point blk
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Header blk) -> Point blk)
-> (AnchoredFragment (Header blk) -> Point (Header blk))
-> AnchoredFragment (Header blk)
-> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment (Header blk) -> Point (Header blk)
forall block. AnchoredFragment block -> Point block
AF.anchorPoint (AnchoredFragment (Header blk) -> Point blk)
-> STM m (AnchoredFragment (Header blk)) -> STM m (Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB m blk -> STM m (AnchoredFragment (Header blk))
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
ChainDB.getCurrentChain ChainDB m blk
getChainDB)
, hTxMonitorServer :: LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hTxMonitorServer =
Mempool m blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
forall blk (m :: * -> *).
(MonadSTM m, LedgerSupportsMempool blk) =>
Mempool m blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
localTxMonitorServer
Mempool m blk
getMempool
}
data Codecs' blk serialisedBlk e m bCS bTX bSQ bTM = Codecs {
forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
cChainSyncCodec :: Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
, forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cTxSubmissionCodec :: Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
, forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cStateQueryCodec :: Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
, forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cTxMonitorCodec :: Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
}
type Codecs blk e m bCS bTX bSQ bTM =
Codecs' blk (Serialised blk) e m bCS bTX bSQ bTM
type DefaultCodecs blk m =
Codecs' blk (Serialised blk) DeserialiseFailure m ByteString ByteString ByteString ByteString
type ClientCodecs blk m =
Codecs' blk blk DeserialiseFailure m ByteString ByteString ByteString ByteString
defaultCodecs :: forall m blk.
( MonadST m
, SerialiseNodeToClientConstraints blk
, ShowQuery (BlockQuery blk)
, StandardHash blk
, Serialise (HeaderHash blk)
)
=> CodecConfig blk
-> BlockNodeToClientVersion blk
-> N.NodeToClientVersion
-> DefaultCodecs blk m
defaultCodecs :: forall (m :: * -> *) blk.
(MonadST m, SerialiseNodeToClientConstraints blk,
ShowQuery (BlockQuery blk), StandardHash blk,
Serialise (HeaderHash blk)) =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> DefaultCodecs blk m
defaultCodecs CodecConfig blk
ccfg BlockNodeToClientVersion blk
version NodeToClientVersion
networkVersion = Codecs {
cChainSyncCodec :: Codec
(ChainSync (Serialised blk) (Point blk) (Tip blk))
DeserialiseFailure
m
ByteString
cChainSyncCodec =
(Serialised blk -> Encoding)
-> (forall s. Decoder s (Serialised blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
(ChainSync (Serialised 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
Serialised blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
Decoder s (Serialised blk)
forall s. Decoder s (Serialised blk)
forall a s. SerialiseNodeToClient 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))
, cTxSubmissionCodec :: Codec
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
DeserialiseFailure
m
ByteString
cTxSubmissionCodec =
(GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (ApplyTxErr blk -> Encoding)
-> (forall s. Decoder s (ApplyTxErr blk))
-> Codec
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
DeserialiseFailure
m
ByteString
forall tx reject (m :: * -> *).
MonadST m =>
(tx -> Encoding)
-> (forall s. Decoder s tx)
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> Codec
(LocalTxSubmission tx reject) DeserialiseFailure m ByteString
codecLocalTxSubmission
GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
ApplyTxErr blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
Decoder s (ApplyTxErr blk)
forall s. Decoder s (ApplyTxErr blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
, cStateQueryCodec :: Codec
(LocalStateQuery blk (Point blk) (Query blk))
DeserialiseFailure
m
ByteString
cStateQueryCodec =
NodeToClientVersion
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (forall result. Query blk result -> Encoding)
-> (forall s. Decoder s (Some (Query blk)))
-> (forall result. Query blk result -> result -> Encoding)
-> (forall result. Query blk result -> forall s. Decoder s result)
-> Codec
(LocalStateQuery blk (Point blk) (Query blk))
DeserialiseFailure
m
ByteString
forall {k} (block :: k) point (query :: * -> *) (m :: * -> *).
(MonadST m, ShowQuery query) =>
NodeToClientVersion
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (forall result. query result -> Encoding)
-> (forall s. Decoder s (Some query))
-> (forall result. query result -> result -> Encoding)
-> (forall result. query result -> forall s. Decoder s result)
-> Codec
(LocalStateQuery block point query) DeserialiseFailure m ByteString
codecLocalStateQuery
NodeToClientVersion
networkVersion
((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))
(CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
forall blk.
(Typeable blk, Show (SomeSecond BlockQuery blk),
SerialiseNodeToClient blk (SomeSecond BlockQuery blk)) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
queryEncodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version (SomeSecond Query blk -> Encoding)
-> (Query blk result -> SomeSecond Query blk)
-> Query blk result
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query blk result -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond)
((\(SomeSecond Query blk b
qry) -> Query blk b -> Some (Query blk)
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some Query blk b
qry) (SomeSecond Query blk -> Some (Query blk))
-> Decoder s (SomeSecond Query blk) -> Decoder s (Some (Query blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
forall blk.
SerialiseNodeToClient blk (SomeSecond BlockQuery blk) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
queryDecodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version)
(CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)
(CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)
, cTxMonitorCodec :: Codec
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
DeserialiseFailure
m
ByteString
cTxMonitorCodec =
(GenTxId blk -> Encoding)
-> (forall s. Decoder s (GenTxId blk))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (SlotNo -> Encoding)
-> (forall s. Decoder s SlotNo)
-> Codec
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
DeserialiseFailure
m
ByteString
forall txid tx slot (m :: * -> *) ptcl.
(MonadST m, ptcl ~ LocalTxMonitor txid tx slot) =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> (slot -> Encoding)
-> (forall s. Decoder s slot)
-> Codec
(LocalTxMonitor txid tx slot) DeserialiseFailure m ByteString
codecLocalTxMonitor
GenTxId blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc Decoder s (GenTxId blk)
forall s. Decoder s (GenTxId blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
SlotNo -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
}
where
queryVersion :: QueryVersion
queryVersion :: QueryVersion
queryVersion = NodeToClientVersion -> QueryVersion
nodeToClientVersionToQueryVersion NodeToClientVersion
networkVersion
p :: Proxy blk
p :: Proxy blk
p = Proxy blk
forall {k} (t :: k). Proxy t
Proxy
enc :: SerialiseNodeToClient blk a => a -> Encoding
enc :: forall a. SerialiseNodeToClient blk a => a -> Encoding
enc = CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version
dec :: SerialiseNodeToClient blk a => forall s. Decoder s a
dec :: forall a s. SerialiseNodeToClient blk a => Decoder s a
dec = CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version
clientCodecs :: forall m blk.
( MonadST m
, SerialiseNodeToClientConstraints blk
, ShowQuery (BlockQuery blk)
, StandardHash blk
, Serialise (HeaderHash blk)
)
=> CodecConfig blk
-> BlockNodeToClientVersion blk
-> N.NodeToClientVersion
-> ClientCodecs blk m
clientCodecs :: forall (m :: * -> *) blk.
(MonadST m, SerialiseNodeToClientConstraints blk,
ShowQuery (BlockQuery blk), StandardHash blk,
Serialise (HeaderHash blk)) =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> ClientCodecs blk m
clientCodecs CodecConfig blk
ccfg BlockNodeToClientVersion blk
version NodeToClientVersion
networkVersion = Codecs {
cChainSyncCodec :: Codec
(ChainSync blk (Point blk) (Tip blk))
DeserialiseFailure
m
ByteString
cChainSyncCodec =
(blk -> Encoding)
-> (forall s. Decoder s blk)
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
(ChainSync 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
blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
Decoder s blk
forall s. Decoder s blk
forall a s. SerialiseNodeToClient 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))
, cTxSubmissionCodec :: Codec
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
DeserialiseFailure
m
ByteString
cTxSubmissionCodec =
(GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (ApplyTxErr blk -> Encoding)
-> (forall s. Decoder s (ApplyTxErr blk))
-> Codec
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
DeserialiseFailure
m
ByteString
forall tx reject (m :: * -> *).
MonadST m =>
(tx -> Encoding)
-> (forall s. Decoder s tx)
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> Codec
(LocalTxSubmission tx reject) DeserialiseFailure m ByteString
codecLocalTxSubmission
GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
ApplyTxErr blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
Decoder s (ApplyTxErr blk)
forall s. Decoder s (ApplyTxErr blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
, cStateQueryCodec :: Codec
(LocalStateQuery blk (Point blk) (Query blk))
DeserialiseFailure
m
ByteString
cStateQueryCodec =
NodeToClientVersion
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (forall result. Query blk result -> Encoding)
-> (forall s. Decoder s (Some (Query blk)))
-> (forall result. Query blk result -> result -> Encoding)
-> (forall result. Query blk result -> forall s. Decoder s result)
-> Codec
(LocalStateQuery blk (Point blk) (Query blk))
DeserialiseFailure
m
ByteString
forall {k} (block :: k) point (query :: * -> *) (m :: * -> *).
(MonadST m, ShowQuery query) =>
NodeToClientVersion
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (forall result. query result -> Encoding)
-> (forall s. Decoder s (Some query))
-> (forall result. query result -> result -> Encoding)
-> (forall result. query result -> forall s. Decoder s result)
-> Codec
(LocalStateQuery block point query) DeserialiseFailure m ByteString
codecLocalStateQuery
NodeToClientVersion
networkVersion
((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))
(CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
forall blk.
(Typeable blk, Show (SomeSecond BlockQuery blk),
SerialiseNodeToClient blk (SomeSecond BlockQuery blk)) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
queryEncodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version (SomeSecond Query blk -> Encoding)
-> (Query blk result -> SomeSecond Query blk)
-> Query blk result
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query blk result -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond)
((\(SomeSecond Query blk b
qry) -> Query blk b -> Some (Query blk)
forall {k} (f :: k -> *) (a :: k). f a -> Some f
Some Query blk b
qry) (SomeSecond Query blk -> Some (Query blk))
-> Decoder s (SomeSecond Query blk) -> Decoder s (Some (Query blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
forall blk.
SerialiseNodeToClient blk (SomeSecond BlockQuery blk) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
queryDecodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version)
(CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)
(CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
forall result.
CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)
, cTxMonitorCodec :: Codec
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
DeserialiseFailure
m
ByteString
cTxMonitorCodec =
(GenTxId blk -> Encoding)
-> (forall s. Decoder s (GenTxId blk))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (SlotNo -> Encoding)
-> (forall s. Decoder s SlotNo)
-> Codec
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
DeserialiseFailure
m
ByteString
forall txid tx slot (m :: * -> *) ptcl.
(MonadST m, ptcl ~ LocalTxMonitor txid tx slot) =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> (slot -> Encoding)
-> (forall s. Decoder s slot)
-> Codec
(LocalTxMonitor txid tx slot) DeserialiseFailure m ByteString
codecLocalTxMonitor
GenTxId blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc Decoder s (GenTxId blk)
forall s. Decoder s (GenTxId blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
SlotNo -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
}
where
queryVersion :: QueryVersion
queryVersion :: QueryVersion
queryVersion = NodeToClientVersion -> QueryVersion
nodeToClientVersionToQueryVersion NodeToClientVersion
networkVersion
p :: Proxy blk
p :: Proxy blk
p = Proxy blk
forall {k} (t :: k). Proxy t
Proxy
enc :: SerialiseNodeToClient blk a => a -> Encoding
enc :: forall a. SerialiseNodeToClient blk a => a -> Encoding
enc = CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version
dec :: SerialiseNodeToClient blk a => forall s. Decoder s a
dec :: forall a s. SerialiseNodeToClient blk a => Decoder s a
dec = CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version
identityCodecs :: (Monad m, BlockSupportsLedgerQuery blk)
=> Codecs blk CodecFailure m
(AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
(AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
(AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
(AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
identityCodecs :: forall (m :: * -> *) blk.
(Monad m, BlockSupportsLedgerQuery blk) =>
Codecs
blk
CodecFailure
m
(AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
(AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
(AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
(AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
identityCodecs = Codecs {
cChainSyncCodec :: Codec
(ChainSync (Serialised blk) (Point blk) (Tip blk))
CodecFailure
m
(AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
cChainSyncCodec = Codec
(ChainSync (Serialised blk) (Point blk) (Tip blk))
CodecFailure
m
(AnyMessage (ChainSync (Serialised 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
, cTxSubmissionCodec :: Codec
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
CodecFailure
m
(AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
cTxSubmissionCodec = Codec
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
CodecFailure
m
(AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall {k} {k1} (tx :: k) (reject :: k1) (m :: * -> *).
Monad m =>
Codec
(LocalTxSubmission tx reject)
CodecFailure
m
(AnyMessage (LocalTxSubmission tx reject))
codecLocalTxSubmissionId
, cStateQueryCodec :: Codec
(LocalStateQuery blk (Point blk) (Query blk))
CodecFailure
m
(AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
cStateQueryCodec = (forall result1 result2.
Query blk result1
-> Query blk result2 -> Maybe (result1 :~: result2))
-> Codec
(LocalStateQuery blk (Point blk) (Query blk))
CodecFailure
m
(AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
forall {k} {k1} (block :: k) (point :: k1) (query :: * -> *)
(m :: * -> *).
Monad m =>
(forall result1 result2.
query result1 -> query result2 -> Maybe (result1 :~: result2))
-> Codec
(LocalStateQuery block point query)
CodecFailure
m
(AnyMessage (LocalStateQuery block point query))
codecLocalStateQueryId Query blk result1
-> Query blk result2 -> Maybe (result1 :~: result2)
forall result1 result2.
Query blk result1
-> Query blk result2 -> Maybe (result1 :~: result2)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex
, cTxMonitorCodec :: Codec
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
CodecFailure
m
(AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
cTxMonitorCodec = Codec
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
CodecFailure
m
(AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
forall {k} {k1} {k2} (txid :: k) (tx :: k1) (slot :: k2)
(m :: * -> *) ptcl.
(Monad m, ptcl ~ LocalTxMonitor txid tx slot) =>
Codec ptcl CodecFailure m (AnyMessage ptcl)
codecLocalTxMonitorId
}
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 (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
, forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
}
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 (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv
(ChainSync (Serialised blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised 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 (Serialised blk) (Point blk) (Tip blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer
, tTxSubmissionTracer :: f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer
, tStateQueryTracer :: f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))))
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer
, tTxMonitorTracer :: f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer = (Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))))
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer
}
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 (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer = Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tTxSubmissionTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer = Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tStateQueryTracer :: Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer = Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
, tTxMonitorTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer = Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
}
showTracers :: ( Show peer
, Show (GenTx blk)
, Show (GenTxId blk)
, Show (ApplyTxErr blk)
, ShowQuery (BlockQuery blk)
, HasHeader blk
)
=> Tracer m String -> Tracers m peer blk e
showTracers :: forall peer blk (m :: * -> *) e.
(Show peer, Show (GenTx blk), Show (GenTxId blk),
Show (ApplyTxErr blk), ShowQuery (BlockQuery blk),
HasHeader blk) =>
Tracer m String -> Tracers m peer blk e
showTracers Tracer m String
tr = Tracers {
tChainSyncTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tTxSubmissionTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tStateQueryTracer :: Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
, tTxMonitorTracer :: Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer = Tracer m String
-> Tracer
m
(TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
}
type App m peer bytes a = peer -> Channel m bytes -> m (a, Maybe bytes)
data Apps m peer bCS bTX bSQ bTM a = Apps {
forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bCS a
aChainSyncServer :: App m peer bCS a
, forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bTX a
aTxSubmissionServer :: App m peer bTX a
, forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bSQ a
aStateQueryServer :: App m peer bSQ a
, forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bTM a
aTxMonitorServer :: App m peer bTM a
}
mkApps ::
forall m addrNTN addrNTC blk e bCS bTX bSQ bTM.
( IOLike m
, Exception e
, ShowProxy blk
, ShowProxy (ApplyTxErr blk)
, ShowProxy (BlockQuery blk)
, ShowProxy (GenTx blk)
, ShowProxy (GenTxId blk)
, ShowQuery (BlockQuery blk)
)
=> NodeKernel m addrNTN addrNTC blk
-> Tracers m addrNTC blk e
-> Codecs blk e m bCS bTX bSQ bTM
-> Handlers m addrNTC blk
-> Apps m addrNTC bCS bTX bSQ bTM ()
mkApps :: forall (m :: * -> *) addrNTN addrNTC blk e bCS bTX bSQ bTM.
(IOLike m, Exception e, ShowProxy blk, ShowProxy (ApplyTxErr blk),
ShowProxy (BlockQuery blk), ShowProxy (GenTx blk),
ShowProxy (GenTxId blk), ShowQuery (BlockQuery blk)) =>
NodeKernel m addrNTN addrNTC blk
-> Tracers m addrNTC blk e
-> Codecs blk e m bCS bTX bSQ bTM
-> Handlers m addrNTC blk
-> Apps m addrNTC bCS bTX bSQ bTM ()
mkApps NodeKernel m addrNTN addrNTC blk
kernel Tracers {Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tChainSyncTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tTxSubmissionTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tStateQueryTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tTxMonitorTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
peer
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tChainSyncTracer :: Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tTxSubmissionTracer :: Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tStateQueryTracer :: Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tTxMonitorTracer :: Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
..} Codecs {Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cChainSyncCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
cTxSubmissionCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cStateQueryCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cTxMonitorCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cChainSyncCodec :: Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
cTxSubmissionCodec :: Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cStateQueryCodec :: Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cTxMonitorCodec :: Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
..} Handlers {LocalStateQueryServer blk (Point blk) (Query blk) m ()
LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hTxSubmissionServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hStateQueryServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
hTxMonitorServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hChainSyncServer :: Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hTxSubmissionServer :: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hStateQueryServer :: LocalStateQueryServer blk (Point blk) (Query blk) m ()
hTxMonitorServer :: LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
..} =
Apps {App m addrNTC bCS ()
App m addrNTC bTX ()
App m addrNTC bSQ ()
App m addrNTC bTM ()
aChainSyncServer :: App m addrNTC bCS ()
aTxSubmissionServer :: App m addrNTC bTX ()
aStateQueryServer :: App m addrNTC bSQ ()
aTxMonitorServer :: App m addrNTC bTM ()
aChainSyncServer :: App m addrNTC bCS ()
aTxSubmissionServer :: App m addrNTC bTX ()
aStateQueryServer :: App m addrNTC bSQ ()
aTxMonitorServer :: App m addrNTC bTM ()
..}
where
aChainSyncServer
:: addrNTC
-> Channel m bCS
-> m ((), Maybe bCS)
aChainSyncServer :: App m addrNTC bCS ()
aChainSyncServer addrNTC
them Channel m bCS
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalChainSyncServer"
(ResourceRegistry m
-> m (Follower m blk (WithPoint blk (Serialised blk))))
-> (Follower m blk (WithPoint blk (Serialised blk)) -> m ())
-> (Follower m blk (WithPoint blk (Serialised 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
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (Serialised blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (Serialised blk)))
chainSyncBlockServerFollower (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))
Follower m blk (WithPoint blk (Serialised blk)) -> m ()
forall (m :: * -> *) blk a. Follower m blk a -> m ()
ChainDB.followerClose
((Follower m blk (WithPoint blk (Serialised blk))
-> m ((), Maybe bCS))
-> m ((), Maybe bCS))
-> (Follower m blk (WithPoint blk (Serialised blk))
-> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \Follower m blk (WithPoint blk (Serialised blk))
flr ->
Tracer
m
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk)))
-> Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
-> Channel m bCS
-> Peer
(ChainSync (Serialised blk) (Point blk) (Tip blk))
'AsServer
'StIdle
m
()
-> m ((), Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
((TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))
-> TraceLabelPeer
addrNTC
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> Tracer
m
(TraceSendRecv (ChainSync (Serialised 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 (addrNTC
-> TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))
-> TraceLabelPeer
addrNTC
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer addrNTC
them) Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer)
Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec
Channel m bCS
channel
(Peer
(ChainSync (Serialised blk) (Point blk) (Tip blk))
'AsServer
'StIdle
m
()
-> m ((), Maybe bCS))
-> Peer
(ChainSync (Serialised blk) (Point blk) (Tip blk))
'AsServer
'StIdle
m
()
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
-> Peer
(ChainSync (Serialised 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 (Serialised blk) (Point blk) (Tip blk) m ()
-> Peer
(ChainSync (Serialised blk) (Point blk) (Tip blk))
'AsServer
'StIdle
m
())
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
-> Peer
(ChainSync (Serialised blk) (Point blk) (Tip blk))
'AsServer
'StIdle
m
()
forall a b. (a -> b) -> a -> b
$ Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer Follower m blk (WithPoint blk (Serialised blk))
flr
aTxSubmissionServer
:: addrNTC
-> Channel m bTX
-> m ((), Maybe bTX)
aTxSubmissionServer :: App m addrNTC bTX ()
aTxSubmissionServer addrNTC
them Channel m bTX
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalTxSubmissionServer"
Tracer
m (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
-> Channel m bTX
-> Peer
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
'AsServer
'StIdle
m
()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
((TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
-> TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> Tracer
m (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr 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 (addrNTC
-> TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
-> TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer addrNTC
them) Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer)
Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cTxSubmissionCodec
Channel m bTX
channel
(m (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ())
-> Peer
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
'AsServer
'StIdle
m
()
forall tx reject (m :: * -> *) a.
Monad m =>
m (LocalTxSubmissionServer tx reject m a)
-> Peer (LocalTxSubmission tx reject) 'AsServer 'StIdle m a
localTxSubmissionServerPeer (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
-> m (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hTxSubmissionServer))
aStateQueryServer
:: addrNTC
-> Channel m bSQ
-> m ((), Maybe bSQ)
aStateQueryServer :: App m addrNTC bSQ ()
aStateQueryServer addrNTC
them Channel m bSQ
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalStateQueryServer"
Tracer
m (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
-> Channel m bSQ
-> Peer
(LocalStateQuery blk (Point blk) (Query blk))
'AsServer
'StIdle
m
()
-> m ((), Maybe bSQ)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
((TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))
-> TraceLabelPeer
addrNTC
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> Tracer
m (TraceSendRecv (LocalStateQuery blk (Point blk) (Query 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 (addrNTC
-> TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))
-> TraceLabelPeer
addrNTC
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer addrNTC
them) Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer)
Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cStateQueryCodec
Channel m bSQ
channel
(LocalStateQueryServer blk (Point blk) (Query blk) m ()
-> Peer
(LocalStateQuery blk (Point blk) (Query blk))
'AsServer
'StIdle
m
()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryServer block point query m a
-> Peer (LocalStateQuery block point query) 'AsServer 'StIdle m a
localStateQueryServerPeer LocalStateQueryServer blk (Point blk) (Query blk) m ()
hStateQueryServer)
aTxMonitorServer
:: addrNTC
-> Channel m bTM
-> m ((), Maybe bTM)
aTxMonitorServer :: App m addrNTC bTM ()
aTxMonitorServer addrNTC
them Channel m bTM
channel = do
String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalTxMonitorServer"
Tracer
m (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
-> Channel m bTM
-> Peer
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
'AsServer
'StIdle
m
()
-> m ((), Maybe bTM)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
a.
(MonadThrow m, Show failure,
forall (st' :: ps). Show (ClientHasAgency st'),
forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
((TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
-> TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracer
m (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (addrNTC
-> TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
-> TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer addrNTC
them) Tracer
m
(TraceLabelPeer
addrNTC
(TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer)
Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cTxMonitorCodec
Channel m bTM
channel
(LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
-> Peer
(LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
'AsServer
'StIdle
m
()
forall txid tx slot (m :: * -> *) a.
Monad m =>
LocalTxMonitorServer txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
localTxMonitorServerPeer LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hTxMonitorServer)
responder ::
N.NodeToClientVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosApplicationWithMinimalCtx 'ResponderMode peer b m Void a
responder :: forall (m :: * -> *) peer b a.
NodeToClientVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosApplicationWithMinimalCtx
'ResponderMode peer b m Void a
responder NodeToClientVersion
version Apps {App m (ConnectionId peer) b a
aChainSyncServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bCS a
aTxSubmissionServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bTX a
aStateQueryServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bSQ a
aTxMonitorServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bTM a
aChainSyncServer :: App m (ConnectionId peer) b a
aTxSubmissionServer :: App m (ConnectionId peer) b a
aStateQueryServer :: App m (ConnectionId peer) b a
aTxMonitorServer :: App m (ConnectionId peer) b a
..} =
NodeToClientProtocols 'ResponderMode peer b m Void a
-> NodeToClientVersion
-> OuroborosApplicationWithMinimalCtx
'ResponderMode peer b m Void a
forall (appType :: MuxMode) addr bytes (m :: * -> *) a b.
NodeToClientProtocols appType addr bytes m a b
-> NodeToClientVersion
-> OuroborosApplicationWithMinimalCtx appType addr bytes m a b
nodeToClientProtocols
(NodeToClientProtocols {
localChainSyncProtocol :: RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
localChainSyncProtocol =
MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall responderCtx bytes (m :: * -> *) b initiatorCtx.
MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'ResponderMode initiatorCtx responderCtx bytes m Void b
ResponderProtocolOnly (MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a)
-> MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall a b. (a -> b) -> a -> b
$ (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb ((ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a)
-> (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall a b. (a -> b) -> a -> b
$ \ResponderContext peer
ctx ->
App m (ConnectionId peer) b a
aChainSyncServer (ResponderContext peer -> ConnectionId peer
forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId ResponderContext peer
ctx),
localTxSubmissionProtocol :: RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
localTxSubmissionProtocol =
MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall responderCtx bytes (m :: * -> *) b initiatorCtx.
MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'ResponderMode initiatorCtx responderCtx bytes m Void b
ResponderProtocolOnly (MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a)
-> MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall a b. (a -> b) -> a -> b
$ (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb ((ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a)
-> (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall a b. (a -> b) -> a -> b
$ \ResponderContext peer
ctx ->
App m (ConnectionId peer) b a
aTxSubmissionServer (ResponderContext peer -> ConnectionId peer
forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId ResponderContext peer
ctx),
localStateQueryProtocol :: RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
localStateQueryProtocol =
MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall responderCtx bytes (m :: * -> *) b initiatorCtx.
MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'ResponderMode initiatorCtx responderCtx bytes m Void b
ResponderProtocolOnly (MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a)
-> MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall a b. (a -> b) -> a -> b
$ (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb ((ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a)
-> (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall a b. (a -> b) -> a -> b
$ \ResponderContext peer
ctx ->
App m (ConnectionId peer) b a
aStateQueryServer (ResponderContext peer -> ConnectionId peer
forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId ResponderContext peer
ctx),
localTxMonitorProtocol :: RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
localTxMonitorProtocol =
MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall responderCtx bytes (m :: * -> *) b initiatorCtx.
MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
'ResponderMode initiatorCtx responderCtx bytes m Void b
ResponderProtocolOnly (MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a)
-> MiniProtocolCb (ResponderContext peer) b m a
-> RunMiniProtocolWithMinimalCtx 'ResponderMode peer b m Void a
forall a b. (a -> b) -> a -> b
$ (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall ctx (m :: * -> *) bytes a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb ((ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a)
-> (ResponderContext peer -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb (ResponderContext peer) b m a
forall a b. (a -> b) -> a -> b
$ \ResponderContext peer
ctx ->
App m (ConnectionId peer) b a
aTxMonitorServer (ResponderContext peer -> ConnectionId peer
forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId ResponderContext peer
ctx)
})
NodeToClientVersion
version