Skip to content

Commit 7dd936f

Browse files
cootcoot
authored
Typed Protocols: new API (#1223)
# Description Use `typed-protocols-0.3.0.0`. Depends on: * [x] input-output-hk/typed-protocols#52 * [x] input-output-hk/typed-protocols#61 * [x] IntersectMBO/ouroboros-network#4935 - **Updated to use typed-protocols-0.3.0.0** - **Added KeepAlive tracer**
2 parents b0884a3 + 120d92d commit 7dd936f

File tree

20 files changed

+107
-44
lines changed

20 files changed

+107
-44
lines changed

‎cabal.project

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,9 +14,9 @@ repository cardano-haskell-packages
1414
-- update either of these.
1515
index-state:
1616
-- Bump this if you need newer packages from Hackage
17-
, hackage.haskell.org 2024-08-27T14:57:57Z
17+
, hackage.haskell.org 2024-09-16T12:20:25Z
1818
-- Bump this if you need newer packages from CHaP
19-
, cardano-haskell-packages 2024-10-11T13:55:09Z
19+
, cardano-haskell-packages 2024-10-21T06:28:35Z
2020

2121
packages:
2222
ouroboros-consensus

‎flake.lock

Lines changed: 6 additions & 6 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎ouroboros-consensus-cardano/changelog.d/20241021_094824_coot_typed_protocols_new_api.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
### Non-Breaking
2+
3+
- Updated to `ouroboros-network-0.14`, and `typed-protocols-0.3.0.0` as a consequence.
4+
- Updated to `ouroboros-network-api-0.11`, which introduced `NodeToClientV_19`.

‎ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -159,7 +159,7 @@ library
159159
nothunks,
160160
ouroboros-consensus ^>=0.21,
161161
ouroboros-consensus-protocol ^>=0.9,
162-
ouroboros-network-api ^>=0.10,
162+
ouroboros-network-api ^>=0.11,
163163
serialise ^>=0.2,
164164
small-steps,
165165
sop-core ^>=0.5,
@@ -463,7 +463,7 @@ test-suite cardano-test
463463
tasty,
464464
tasty-hunit,
465465
tasty-quickcheck,
466-
typed-protocols ^>=0.1.1,
466+
typed-protocols ^>=0.3,
467467
unstable-byron-testlib,
468468
unstable-cardano-testlib,
469469
unstable-shelley-testlib,
@@ -555,7 +555,7 @@ library unstable-cardano-tools
555555
ouroboros-consensus-protocol ^>=0.9,
556556
ouroboros-network,
557557
ouroboros-network-api,
558-
ouroboros-network-framework ^>=0.13.2,
558+
ouroboros-network-framework ^>=0.14,
559559
ouroboros-network-protocols,
560560
serialise ^>=0.2,
561561
singletons,

‎ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -512,9 +512,10 @@ instance CardanoHardForkConstraints c
512512
, (NodeToClientV_16, CardanoNodeToClientVersion12)
513513
, (NodeToClientV_17, CardanoNodeToClientVersion13)
514514
, (NodeToClientV_18, CardanoNodeToClientVersion14)
515+
, (NodeToClientV_19, CardanoNodeToClientVersion14)
515516
]
516517

517-
latestReleasedNodeVersion _prx = (Just NodeToNodeV_14, Just NodeToClientV_18)
518+
latestReleasedNodeVersion _prx = (Just NodeToNodeV_14, Just NodeToClientV_19)
518519

519520
{-------------------------------------------------------------------------------
520521
ProtocolInfo

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@ instance SupportedNetworkProtocolVersion (ShelleyBlock proto era) where
6666
, (NodeToClientV_16, ShelleyNodeToClientVersion8)
6767
, (NodeToClientV_17, ShelleyNodeToClientVersion9)
6868
, (NodeToClientV_18, ShelleyNodeToClientVersion10)
69+
, (NodeToClientV_19, ShelleyNodeToClientVersion10)
6970
]
7071

7172
latestReleasedNodeVersion = latestReleasedNodeVersionDefault

‎ouroboros-consensus-diffusion/changelog.d/20241021_094154_coot_typed_protocols_new_api.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
### Breaking
2+
3+
- Updated to `typed-protocols-0.3.0.0`
4+
- Added `KeepAlive` tracer to `Tracers'` data type.

‎ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -90,10 +90,10 @@ library
9090
io-classes ^>=1.5,
9191
mtl,
9292
ouroboros-consensus ^>=0.21,
93-
ouroboros-network ^>=0.17.1,
94-
ouroboros-network-api ^>=0.10,
95-
ouroboros-network-framework ^>=0.13.2,
96-
ouroboros-network-protocols ^>=0.11,
93+
ouroboros-network ^>=0.18,
94+
ouroboros-network-api ^>=0.11,
95+
ouroboros-network-framework ^>=0.14,
96+
ouroboros-network-protocols ^>=0.12,
9797
random,
9898
safe-wild-cards ^>=1.0,
9999
serialise ^>=0.2,
@@ -103,6 +103,7 @@ library
103103
time,
104104
transformers,
105105
typed-protocols,
106+
typed-protocols-stateful,
106107

107108
-- GHC 8.10.7 on aarch64-darwin cannot use text-2
108109
build-depends: text >=1.2.5.0 && <2.2

‎ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE ExistentialQuantification #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE NamedFieldPuns #-}
5+
{-# LANGUAGE PolyKinds #-}
46
{-# LANGUAGE QuantifiedConstraints #-}
57
{-# LANGUAGE RecordWildCards #-}
68
{-# LANGUAGE ScopedTypeVariables #-}
@@ -40,6 +42,7 @@ import Control.Tracer
4042
import Data.ByteString.Lazy (ByteString)
4143
import Data.Void (Void)
4244
import Network.TypedProtocol.Codec
45+
import qualified Network.TypedProtocol.Stateful.Codec as Stateful
4346
import Ouroboros.Consensus.Block
4447
import Ouroboros.Consensus.Ledger.Extended
4548
import Ouroboros.Consensus.Ledger.Query
@@ -66,6 +69,7 @@ import Ouroboros.Network.BlockFetch
6669
import Ouroboros.Network.Channel
6770
import Ouroboros.Network.Context
6871
import Ouroboros.Network.Driver
72+
import qualified Ouroboros.Network.Driver.Stateful as Stateful
6973
import Ouroboros.Network.Mux
7074
import Ouroboros.Network.NodeToClient hiding
7175
(NodeToClientVersion (..))
@@ -75,7 +79,7 @@ import Ouroboros.Network.Protocol.ChainSync.Server
7579
import Ouroboros.Network.Protocol.ChainSync.Type
7680
import Ouroboros.Network.Protocol.LocalStateQuery.Codec
7781
import Ouroboros.Network.Protocol.LocalStateQuery.Server
78-
import Ouroboros.Network.Protocol.LocalStateQuery.Type
82+
import Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
7983
import Ouroboros.Network.Protocol.LocalTxMonitor.Codec
8084
import Ouroboros.Network.Protocol.LocalTxMonitor.Server
8185
import Ouroboros.Network.Protocol.LocalTxMonitor.Type
@@ -144,7 +148,7 @@ mkHandlers NodeKernelArgs {cfg, tracers} NodeKernel {getChainDB, getMempool} =
144148
data Codecs' blk serialisedBlk e m bCS bTX bSQ bTM = Codecs {
145149
cChainSyncCodec :: Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
146150
, cTxSubmissionCodec :: Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
147-
, cStateQueryCodec :: Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
151+
, cStateQueryCodec :: Stateful.Codec (LocalStateQuery blk (Point blk) (Query blk)) e LocalStateQuery.State m bSQ
148152
, cTxMonitorCodec :: Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
149153
}
150154

@@ -293,7 +297,7 @@ identityCodecs :: (Monad m, BlockSupportsLedgerQuery blk)
293297
=> Codecs blk CodecFailure m
294298
(AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
295299
(AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
296-
(AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
300+
(Stateful.AnyMessage (LocalStateQuery blk (Point blk) (Query blk)) LocalStateQuery.State)
297301
(AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
298302
identityCodecs = Codecs {
299303
cChainSyncCodec = codecChainSyncId
@@ -313,7 +317,7 @@ type Tracers m peer blk e =
313317
data Tracers' peer blk e f = Tracers {
314318
tChainSyncTracer :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
315319
, tTxSubmissionTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
316-
, tStateQueryTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
320+
, tStateQueryTracer :: f (TraceLabelPeer peer (Stateful.TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)) LocalStateQuery.State))
317321
, tTxMonitorTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
318322
}
319323

@@ -433,10 +437,11 @@ mkApps kernel Tracers {..} Codecs {..} Handlers {..} =
433437
-> m ((), Maybe bSQ)
434438
aStateQueryServer them channel = do
435439
labelThisThread "LocalStateQueryServer"
436-
runPeer
440+
Stateful.runPeer
437441
(contramap (TraceLabelPeer them) tStateQueryTracer)
438442
cStateQueryCodec
439443
channel
444+
LocalStateQuery.StateIdle
440445
(localStateQueryServerPeer hStateQueryServer)
441446

442447
aTxMonitorServer

‎ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -245,14 +245,14 @@ mkHandlers
245245
, hTxSubmissionClient = \version controlMessageSTM peer ->
246246
txSubmissionOutbound
247247
(contramap (TraceLabelPeer peer) (Node.txOutboundTracer tracers))
248-
(NumTxIdsToAck $ txSubmissionMaxUnacked miniProtocolParameters)
248+
(txSubmissionMaxUnacked miniProtocolParameters)
249249
(mapTxSubmissionMempoolReader txForgetValidated $ getMempoolReader getMempool)
250250
version
251251
controlMessageSTM
252252
, hTxSubmissionServer = \version peer ->
253253
txSubmissionInbound
254254
(contramap (TraceLabelPeer peer) (Node.txInboundTracer tracers))
255-
(NumTxIdsToAck $ txSubmissionMaxUnacked miniProtocolParameters)
255+
(txSubmissionMaxUnacked miniProtocolParameters)
256256
(mapTxSubmissionMempoolReader txForgetValidated $ getMempoolReader getMempool)
257257
(getMempoolWriter getMempool)
258258
version
@@ -377,6 +377,7 @@ data Tracers' peer blk e f = Tracers {
377377
, tBlockFetchTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
378378
, tBlockFetchSerialisedTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
379379
, tTxSubmission2Tracer :: f (TraceLabelPeer peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
380+
, tKeepAliveTracer :: f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
380381
}
381382

382383
instance (forall a. Semigroup (f a)) => Semigroup (Tracers' peer blk e f) where
@@ -386,6 +387,7 @@ instance (forall a. Semigroup (f a)) => Semigroup (Tracers' peer blk e f) where
386387
, tBlockFetchTracer = f tBlockFetchTracer
387388
, tBlockFetchSerialisedTracer = f tBlockFetchSerialisedTracer
388389
, tTxSubmission2Tracer = f tTxSubmission2Tracer
390+
, tKeepAliveTracer = f tKeepAliveTracer
389391
}
390392
where
391393
f :: forall a. Semigroup a
@@ -401,6 +403,7 @@ nullTracers = Tracers {
401403
, tBlockFetchTracer = nullTracer
402404
, tBlockFetchSerialisedTracer = nullTracer
403405
, tTxSubmission2Tracer = nullTracer
406+
, tKeepAliveTracer = nullTracer
404407
}
405408

406409
showTracers :: ( Show blk
@@ -418,6 +421,7 @@ showTracers tr = Tracers {
418421
, tBlockFetchTracer = showTracing tr
419422
, tBlockFetchSerialisedTracer = showTracing tr
420423
, tTxSubmission2Tracer = showTracing tr
424+
, tKeepAliveTracer = showTracing tr
421425
}
422426

423427
{-------------------------------------------------------------------------------
@@ -721,7 +725,7 @@ mkApps kernel Tracers {..} mkCodecs ByteLimits {..} genChainSyncTimeout lopBucke
721725
labelThisThread "KeepAliveClient"
722726
let kacApp = \dqCtx ->
723727
runPeerWithLimits
724-
nullTracer
728+
(TraceLabelPeer them `contramap` tKeepAliveTracer)
725729
(cKeepAliveCodec (mkCodecs version))
726730
blKeepAlive
727731
timeLimitsKeepAlive
@@ -738,10 +742,10 @@ mkApps kernel Tracers {..} mkCodecs ByteLimits {..} genChainSyncTimeout lopBucke
738742
-> ResponderContext addrNTN
739743
-> Channel m bKA
740744
-> m ((), Maybe bKA)
741-
aKeepAliveServer version _responderCtx channel = do
745+
aKeepAliveServer version ResponderContext { rcConnectionId = them } channel = do
742746
labelThisThread "KeepAliveServer"
743747
runPeerWithLimits
744-
nullTracer
748+
(TraceLabelPeer them `contramap` tKeepAliveTracer)
745749
(cKeepAliveCodec (mkCodecs version))
746750
(byteLimitsKeepAlive (const 0)) -- TODO: Real Bytelimits, see #1727
747751
timeLimitsKeepAlive
@@ -765,6 +769,7 @@ mkApps kernel Tracers {..} mkCodecs ByteLimits {..} genChainSyncTimeout lopBucke
765769
$ \controller -> do
766770
psClient <- hPeerSharingClient version controlMessageSTM them controller
767771
((), trailing) <- runPeerWithLimits
772+
-- TODO: add tracer
768773
nullTracer
769774
(cPeerSharingCodec (mkCodecs version))
770775
(byteLimitsPeerSharing (const 0))
@@ -781,6 +786,7 @@ mkApps kernel Tracers {..} mkCodecs ByteLimits {..} genChainSyncTimeout lopBucke
781786
aPeerSharingServer version ResponderContext { rcConnectionId = them } channel = do
782787
labelThisThread "PeerSharingServer"
783788
runPeerWithLimits
789+
-- TODO: add tracer
784790
nullTracer
785791
(cPeerSharingCodec (mkCodecs version))
786792
(byteLimitsPeerSharing (const 0))

0 commit comments

Comments
 (0)