Skip to content

Commit 70d1cc9

Browse files
cootcoot
committed
api: VersionedCodecCBORTerm
1 parent 6082cfa commit 70d1cc9

File tree

9 files changed

+68
-35
lines changed

9 files changed

+68
-35
lines changed

‎cardano-diffusion/api/lib/Cardano/Network/NodeToClient/Version.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -149,4 +149,4 @@ nodeToClientCodecCBORTerm _v = CodecCBORTerm {encodeTerm, decodeTerm}
149149

150150

151151
nodeToClientVersionDataCodec :: VersionDataCodec NodeToClientVersion NodeToClientVersionData
152-
nodeToClientVersionDataCodec = cborTermVersionDataCodec nodeToClientCodecCBORTerm
152+
nodeToClientVersionDataCodec = mkVersionedCodecCBORTerm nodeToClientCodecCBORTerm

‎cardano-diffusion/api/lib/Cardano/Network/NodeToNode/Version.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,6 @@ nodeToNodeCodecCBORTerm =
170170

171171

172172
nodeToNodeVersionDataCodec :: VersionDataCodec NodeToNodeVersion NodeToNodeVersionData
173-
nodeToNodeVersionDataCodec = cborTermVersionDataCodec nodeToNodeCodecCBORTerm
173+
nodeToNodeVersionDataCodec = mkVersionedCodecCBORTerm nodeToNodeCodecCBORTerm
174174

175175
data ConnectionMode = UnidirectionalMode | DuplexMode

‎ouroboros-network/api/lib/Ouroboros/Network/CodecCBORTerm.hs‎

Lines changed: 43 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,12 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE PatternSynonyms #-}
3+
14
module Ouroboros.Network.CodecCBORTerm
25
( CodecCBORTerm (..)
3-
, VersionDataCodec (..)
4-
, cborTermVersionDataCodec
6+
, VersionDataCodec
7+
, VersionedCodecCBORTerm (.., VersionDataCodec, encodeData, decodeData)
8+
, mkVersionedCodecCBORTerm
9+
, unVersionCodecCBORTerm
510
) where
611

712
import Codec.CBOR.Term qualified as CBOR
@@ -17,19 +22,43 @@ data CodecCBORTerm fail a = CodecCBORTerm
1722
, decodeTerm :: CBOR.Term -> Either fail a
1823
}
1924

20-
-- | Codec for version data exchanged by the handshake protocol.
25+
26+
-- | A pure codec which encodes to / decodes from `CBOR.Term` which can
27+
-- depend on a version.
2128
--
22-
data VersionDataCodec vNumber vData = VersionDataCodec {
23-
encodeData :: vNumber -> vData -> CBOR.Term,
24-
-- ^ encoder of 'vData' which has access to 'extra vData' which can bring
25-
-- extra instances into the scope (by means of pattern matching on a GADT).
26-
decodeData :: vNumber -> CBOR.Term -> Either Text vData
27-
-- ^ decoder of 'vData'.
29+
data VersionedCodecCBORTerm fail v a = VersionedCodecCBORTerm {
30+
encodeVersionedTerm :: v -> a -> CBOR.Term,
31+
decodeVersionedTerm :: v -> CBOR.Term -> Either fail a
2832
}
2933

30-
cborTermVersionDataCodec :: (vNumber -> CodecCBORTerm Text vData)
31-
-> VersionDataCodec vNumber vData
32-
cborTermVersionDataCodec codec = VersionDataCodec {
33-
encodeData = encodeTerm . codec,
34-
decodeData = decodeTerm . codec
34+
mkVersionedCodecCBORTerm :: (vNumber -> CodecCBORTerm fail vData)
35+
-> VersionedCodecCBORTerm fail vNumber vData
36+
mkVersionedCodecCBORTerm codec = VersionedCodecCBORTerm {
37+
encodeVersionedTerm = encodeTerm . codec,
38+
decodeVersionedTerm = decodeTerm . codec
3539
}
40+
41+
unVersionCodecCBORTerm :: VersionedCodecCBORTerm fail vNumber vData
42+
-> vNumber -> CodecCBORTerm fail vData
43+
unVersionCodecCBORTerm VersionedCodecCBORTerm{encodeVersionedTerm, decodeVersionedTerm} v =
44+
CodecCBORTerm {
45+
encodeTerm = encodeVersionedTerm v,
46+
decodeTerm = decodeVersionedTerm v
47+
}
48+
49+
--
50+
-- A specialised VersionedCodecCBORTerm used for encoding / decoding
51+
-- handshake's version data
52+
--
53+
54+
type VersionDataCodec versionNumber versionData =
55+
VersionedCodecCBORTerm Text versionNumber versionData
56+
57+
-- | Codec for version data exchanged by the handshake protocol.
58+
--
59+
pattern VersionDataCodec :: (v -> a -> CBOR.Term)
60+
-> (v -> CBOR.Term -> Either Text a)
61+
-> VersionDataCodec v a
62+
pattern VersionDataCodec { encodeData, decodeData } =
63+
VersionedCodecCBORTerm encodeData decodeData
64+
{-# COMPLETE VersionDataCodec #-}

‎ouroboros-network/framework/lib/Ouroboros/Network/Protocol/Handshake/Codec.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,9 @@ module Ouroboros.Network.Protocol.Handshake.Codec
1414
, encodeRefuseReason
1515
, decodeRefuseReason
1616
-- ** Version data codec
17-
, VersionDataCodec (..)
18-
, cborTermVersionDataCodec
17+
, VersionDataCodec
18+
, VersionedCodecCBORTerm (..)
19+
, mkVersionedCodecCBORTerm
1920
) where
2021

2122
import Control.Monad (replicateM, unless)

‎ouroboros-network/framework/lib/Ouroboros/Network/Protocol/Handshake/Unversioned.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ instance Queryable UnversionedProtocolData where
5353

5454
unversionedProtocolDataCodec :: VersionDataCodec UnversionedProtocol
5555
UnversionedProtocolData
56-
unversionedProtocolDataCodec = cborTermVersionDataCodec
56+
unversionedProtocolDataCodec = mkVersionedCodecCBORTerm
5757
(const CodecCBORTerm {encodeTerm, decodeTerm})
5858
where
5959
encodeTerm :: UnversionedProtocolData -> CBOR.Term

‎ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -291,7 +291,7 @@ withInitiatorOnlyConnectionManager name timeouts trTracer tracer stdGen snocket
291291
haHandshakeTracer = WithName name `contramap` nullTracer,
292292
haBearerTracer = WithName name `contramap` nullTracer,
293293
haHandshakeCodec = unversionedHandshakeCodec,
294-
haVersionDataCodec = cborTermVersionDataCodec dataFlowProtocolDataCodec,
294+
haVersionDataCodec = mkVersionedCodecCBORTerm dataFlowProtocolDataCodec,
295295
haAcceptVersion = acceptableVersion,
296296
haQueryVersion = queryVersion,
297297
haTimeLimits = handshakeTimeLimits
@@ -487,7 +487,7 @@ withBidirectionalConnectionManager name timeouts
487487
haHandshakeTracer = WithName name `contramap` nullTracer,
488488
haBearerTracer = WithName `contramap` nullTracer,
489489
haHandshakeCodec = unversionedHandshakeCodec,
490-
haVersionDataCodec = cborTermVersionDataCodec dataFlowProtocolDataCodec,
490+
haVersionDataCodec = mkVersionedCodecCBORTerm dataFlowProtocolDataCodec,
491491
haAcceptVersion = acceptableVersion,
492492
haQueryVersion = queryVersion,
493493
haTimeLimits = handshakeTimeLimits

‎ouroboros-network/protocols/tests-lib/Ouroboros/Network/Protocol/Handshake/Test.hs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -397,11 +397,11 @@ prop_connect (ArbitraryVersions clientVersions serverVersions) =
397397
in case runSimOrThrow
398398
(connect
399399
(handshakeClientPeer
400-
(cborTermVersionDataCodec dataCodecCBORTerm)
400+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
401401
acceptableVersion
402402
clientVersions)
403403
(handshakeServerPeer
404-
(cborTermVersionDataCodec dataCodecCBORTerm)
404+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
405405
acceptableVersion
406406
queryVersion
407407
serverVersions)) of
@@ -438,11 +438,11 @@ prop_channel createChannels clientVersions serverVersions =
438438
runConnectedPeers
439439
createChannels nullTracer versionNumberHandshakeCodec
440440
(handshakeClientPeer
441-
(cborTermVersionDataCodec dataCodecCBORTerm)
441+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
442442
acceptableVersion
443443
clientVersions)
444444
(handshakeServerPeer
445-
(cborTermVersionDataCodec dataCodecCBORTerm)
445+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
446446
acceptableVersion
447447
queryVersion
448448
serverVersions)
@@ -513,11 +513,11 @@ prop_channel_asymmetric createChannels clientVersions = do
513513
versionNumberHandshakeCodec
514514
(codecHandshake versionNumberCodec')
515515
(handshakeClientPeer
516-
(cborTermVersionDataCodec dataCodecCBORTerm)
516+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
517517
acceptableVersion
518518
clientVersions)
519519
(handshakeServerPeer
520-
(cborTermVersionDataCodec dataCodecCBORTerm)
520+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
521521
acceptableVersion
522522
queryVersion
523523
serverVersions)
@@ -714,7 +714,7 @@ prop_acceptOrRefuse_symmetric_VersionData
714714
-> ArbitraryValidVersions
715715
-> Property
716716
prop_acceptOrRefuse_symmetric_VersionData (ArbitraryValidVersions a) (ArbitraryValidVersions b) =
717-
prop_acceptOrRefuse_symmetric (cborTermVersionDataCodec dataCodecCBORTerm)
717+
prop_acceptOrRefuse_symmetric (mkVersionedCodecCBORTerm dataCodecCBORTerm)
718718
a b
719719

720720

@@ -785,7 +785,7 @@ prop_channel_simultaneous_open_ST (ArbitraryVersions clientVersions serverVersio
785785
runSimOrThrow $ prop_channel_simultaneous_open
786786
createConnectedChannels
787787
versionNumberHandshakeCodec
788-
(cborTermVersionDataCodec dataCodecCBORTerm)
788+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
789789
clientVersions
790790
serverVersions
791791

@@ -796,7 +796,7 @@ prop_channel_simultaneous_open_IO (ArbitraryVersions clientVersions serverVersio
796796
ioProperty $ prop_channel_simultaneous_open
797797
createConnectedChannels
798798
versionNumberHandshakeCodec
799-
(cborTermVersionDataCodec dataCodecCBORTerm)
799+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
800800
clientVersions
801801
serverVersions
802802

@@ -880,7 +880,7 @@ prop_channel_simultaneous_open_SimNet
880880
(ArbitraryVersions clientVersions serverVersions) =
881881
runSimOrThrow $ prop_channel_simultaneous_open_sim
882882
versionNumberHandshakeCodec
883-
(cborTermVersionDataCodec dataCodecCBORTerm)
883+
(mkVersionedCodecCBORTerm dataCodecCBORTerm)
884884
clientVersions
885885
serverVersions
886886

‎ouroboros-network/tests/io/Test/Ouroboros/Network/Socket.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -138,6 +138,8 @@ testVersionCodecCBORTerm !_ =
138138
decodeTerm t
139139
= Left $ T.pack $ "unknown encoding: " ++ show t
140140

141+
testVersionDataCodec :: VersionDataCodec TestVersion TestVersionData
142+
testVersionDataCodec = mkVersionedCodecCBORTerm testVersionCodecCBORTerm
141143

142144
--
143145
-- The list of all tests
@@ -245,7 +247,7 @@ demo chain0 updates = withIOManager $ \iocp -> do
245247
haHandshakeTracer = nullTracer,
246248
haBearerTracer = nullTracer,
247249
haHandshakeCodec = handshakeCodec,
248-
haVersionDataCodec = cborTermVersionDataCodec testVersionCodecCBORTerm,
250+
haVersionDataCodec = testVersionDataCodec,
249251
haAcceptVersion = acceptableVersion,
250252
haQueryVersion = queryVersion,
251253
haTimeLimits = noTimeLimitsHandshake
@@ -263,7 +265,7 @@ demo chain0 updates = withIOManager $ \iocp -> do
263265
ConnectToArgs {
264266
ctaHandshakeCodec = handshakeCodec,
265267
ctaHandshakeTimeLimits = noTimeLimitsHandshake,
266-
ctaVersionDataCodec = cborTermVersionDataCodec testVersionCodecCBORTerm,
268+
ctaVersionDataCodec = testVersionDataCodec,
267269
ctaConnectTracers = nullNetworkConnectTracers,
268270
ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion
269271
}

‎ouroboros-network/tests/lib/Test/Ouroboros/Network/Diffusion/Node.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -62,10 +62,11 @@ import Data.Void (Void)
6262
import Network.DNS (Domain, TYPE)
6363
import System.Random (StdGen, split)
6464

65+
import Ouroboros.Network.CodecCBORTerm
6566
import Ouroboros.Network.Mux (noBindForkPolicy)
6667
import Ouroboros.Network.Protocol.Handshake (HandshakeArguments (..))
67-
import Ouroboros.Network.Protocol.Handshake.Codec (VersionDataCodec (..),
68-
noTimeLimitsHandshake, timeLimitsHandshake)
68+
import Ouroboros.Network.Protocol.Handshake.Codec (noTimeLimitsHandshake,
69+
timeLimitsHandshake)
6970
import Ouroboros.Network.Protocol.Handshake.Unversioned
7071
(unversionedHandshakeCodec, unversionedProtocolDataCodec)
7172
import Ouroboros.Network.Protocol.Handshake.Version (Accept (Accept))

0 commit comments

Comments
 (0)