From d6ed23114952271a12cd5b13ece0c3abe526ac67 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 8 Aug 2023 13:54:59 +0200 Subject: [PATCH 1/5] cddl: use Any in the chain-sync mini-protocol --- .../Network/Protocol/ChainSync/Codec.hs | 2 +- ouroboros-network-protocols/test-cddl/Main.hs | 79 +++++++------ .../test-cddl/specs/chain-sync.cddl | 4 +- .../test-cddl/specs/common.cddl | 2 +- .../Network/Protocol/ChainSync/Test.hs | 104 ++++++++++++------ 5 files changed, 119 insertions(+), 72 deletions(-) diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs index ab44a697830..000aa5b1f6d 100644 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs +++ b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ChainSync/Codec.hs @@ -184,7 +184,7 @@ codecChainSync encodeHeader decodeHeader return (SomeMessage MsgDone) -- - -- failures per protcol state + -- failures per protocol state -- (_, _, ClientAgency TokIdle) -> diff --git a/ouroboros-network-protocols/test-cddl/Main.hs b/ouroboros-network-protocols/test-cddl/Main.hs index 4513067f569..fe1716a95e4 100644 --- a/ouroboros-network-protocols/test-cddl/Main.hs +++ b/ouroboros-network-protocols/test-cddl/Main.hs @@ -1,19 +1,20 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-unused-imports #-} @@ -57,7 +58,7 @@ import Ouroboros.Network.Block (Point, SlotNo, Tip, decodeTip, encodeTip, unwrapCBORinCBOR, wrapCBORinCBOR) import Ouroboros.Network.CodecCBORTerm import Ouroboros.Network.Magic -import Ouroboros.Network.Mock.ConcreteBlock (Block, BlockHeader (..)) +import Ouroboros.Network.Mock.ConcreteBlock (Block) import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion, NodeToClientVersionData (..), nodeToClientCodecCBORTerm) @@ -115,6 +116,7 @@ import Ouroboros.Network.Protocol.PeerSharing.Test () import Ouroboros.Network.Protocol.PeerSharing.Type (ClientHasAgency (TokIdle), ServerHasAgency (..)) import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PeerSharing +import Test.Data.CDDL (Any (..)) import Test.QuickCheck import Test.QuickCheck.Instances.ByteString () import Test.Tasty (TestTree, adjustOption, defaultMain, testGroup) @@ -232,10 +234,7 @@ data CDDLSpecs = CDDLSpecs { cddlHandshakeNodeToClient :: CDDLSpec (Handshake NodeToClientVersion CBOR.Term), cddlHandshakeNodeToNodeV7To10 :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), cddlHandshakeNodeToNodeV11ToLast :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), - cddlChainSync :: CDDLSpec (ChainSync - BlockHeader - (Point BlockHeader) - (Tip BlockHeader)), + cddlChainSync :: CDDLSpec (ChainSync BlockHeader HeaderPoint HeaderTip), cddlBlockFetch :: CDDLSpec (BlockFetch Block (Point Block)), cddlTxSubmission2 :: CDDLSpec (TxSubmission2 TxId Tx), cddlKeepAlive :: CDDLSpec KeepAlive, @@ -299,20 +298,30 @@ readCDDLSpecs = do cddlNodeToNodeVersionDataV11ToLast = CDDLSpec nodeToNodeVersionDataV11ToLast } + +newtype BlockHeader = BlockHeader Any + deriving (Eq, Show, Arbitrary, Serialise) + +newtype HeaderPoint = HeaderPoint Any + deriving (Eq, Show, Arbitrary, Serialise) + +newtype HeaderTip = HeaderTip Any + deriving (Eq, Show, Arbitrary, Serialise) + -- -- Mini-Protocol Codecs -- -chainSyncCodec :: Codec (ChainSync BlockHeader (Point BlockHeader) (Tip BlockHeader)) +chainSyncCodec :: Codec (ChainSync BlockHeader HeaderPoint HeaderTip) CBOR.DeserialiseFailure IO BL.ByteString chainSyncCodec = codecChainSync - (wrapCBORinCBOR Serialise.encode) - (unwrapCBORinCBOR (const <$> Serialise.decode)) Serialise.encode Serialise.decode - (encodeTip Serialise.encode) - (decodeTip Serialise.decode) + Serialise.encode + Serialise.decode + Serialise.encode + Serialise.decode blockFetchCodec :: Codec (BlockFetch Block (Point Block)) @@ -413,7 +422,7 @@ validateCBORTermEncoder spec $ a terms = CBOR.deserialiseFromBytes CBOR.decodeTerm blob --- | Match encoded cbor against cddl specifiction. +-- | Match encoded CBOR against cddl specification. -- validateCBOR :: CDDLSpec ps -> BL.ByteString @@ -569,11 +578,11 @@ prop_encodeHandshakeNodeToClient spec = validateEncoder spec nodeToClientHandsha prop_encodeChainSync :: CDDLSpec (ChainSync BlockHeader - (Point BlockHeader) - (Tip BlockHeader)) + HeaderPoint + HeaderTip) -> AnyMessageAndAgency (ChainSync BlockHeader - (Point BlockHeader) - (Tip BlockHeader)) + HeaderPoint + HeaderTip) -> Property prop_encodeChainSync spec = validateEncoder spec chainSyncCodec @@ -797,13 +806,13 @@ generateCBORFromSpec spec rounds = do . readProcessWithExitCode "diag2cbor.rb" ["-"] --- | Try decode at all given agencies. If one suceeds return +-- | Try decode at all given agencies. If one succeeds return -- 'Nothing' otherwise return all 'DeserialiseFailure's. -- decodeMsg :: forall ps. Codec ps CBOR.DeserialiseFailure IO BL.ByteString -> [SomeAgency ps] - -- ^ list of all gencies to try + -- ^ list of all agencies to try -> BL.ByteString -> IO (Maybe [CBOR.DeserialiseFailure]) decodeMsg codec stoks bs = @@ -813,7 +822,7 @@ decodeMsg codec stoks bs = decoder <- decode codec stok res <- runDecoder [bs] decoder return $ case res of - Left err -> Just (err) + Left err -> Just err Right {} -> Nothing @@ -842,7 +851,7 @@ unit_decodeHandshakeNodeToClient spec = unit_decodeChainSync - :: CDDLSpec (ChainSync BlockHeader (Point BlockHeader) (Tip BlockHeader)) + :: CDDLSpec (ChainSync BlockHeader HeaderPoint HeaderTip) -> Assertion unit_decodeChainSync spec = validateDecoder Nothing diff --git a/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl b/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl index 46ea1dc13b7..d9fe2e3d60f 100644 --- a/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl @@ -17,8 +17,8 @@ msgIntersectFound = [5, point, tip] msgIntersectNotFound = [6, tip] chainSyncMsgDone = [7] -wrappedHeader = #6.24(bytes .cbor blockHeader) -tip = [point, uint] +wrappedHeader = any +tip = any points = [ *point ] diff --git a/ouroboros-network-protocols/test-cddl/specs/common.cddl b/ouroboros-network-protocols/test-cddl/specs/common.cddl index 0320bd04072..c9e2c7f87e3 100644 --- a/ouroboros-network-protocols/test-cddl/specs/common.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/common.cddl @@ -16,7 +16,7 @@ headerSlot = word64 headerBlockNo = word64 headerBodyHash = int -point = origin / blockHeaderHash +point = any origin = [] blockHeaderHash = [slotNo, int] slotNo = word64 diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/ChainSync/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/ChainSync/Test.hs index 7a65f3c4bb2..73fc43a965e 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/ChainSync/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/ChainSync/Test.hs @@ -33,7 +33,7 @@ import Ouroboros.Network.Channel import Ouroboros.Network.Driver import Ouroboros.Network.Block (BlockNo, Serialised (..), - StandardHash, Tip (..), castPoint, decodeTip, encodeTip, + StandardHash, Tip (..), decodeTip, encodeTip, pattern BlockPoint, pattern GenesisPoint, unwrapCBORinCBOR, wrapCBORinCBOR) import Ouroboros.Network.Mock.Chain (Chain, Point) @@ -332,43 +332,83 @@ propChainSyncPipelinedMinConnectIO cps choices (Positive omax) = (ChainSyncExamples.chainSyncClientPipelinedMin omax) cps -genChainSync :: Gen point - -> Gen header - -> Gen tip - -> Gen (AnyMessageAndAgency (ChainSync header point tip)) -genChainSync genPoint genHeader genTip = oneof + +instance (Arbitrary header, Arbitrary point, Arbitrary tip) + => Arbitrary (AnyMessageAndAgency (ChainSync header point tip)) where + arbitrary = oneof [ return $ AnyMessageAndAgency (ClientAgency TokIdle) MsgRequestNext , return $ AnyMessageAndAgency (ServerAgency (TokNext TokCanAwait)) MsgAwaitReply , AnyMessageAndAgency (ServerAgency (TokNext TokCanAwait)) - <$> (MsgRollForward <$> genHeader - <*> genTip) + <$> (MsgRollForward <$> arbitrary + <*> arbitrary) , AnyMessageAndAgency (ServerAgency (TokNext TokMustReply)) - <$> (MsgRollForward <$> genHeader - <*> genTip) + <$> (MsgRollForward <$> arbitrary + <*> arbitrary) , AnyMessageAndAgency (ServerAgency (TokNext TokCanAwait)) - <$> (MsgRollBackward <$> genPoint - <*> genTip) + <$> (MsgRollBackward <$> arbitrary + <*> arbitrary) , AnyMessageAndAgency (ServerAgency (TokNext TokMustReply)) - <$> (MsgRollBackward <$> genPoint - <*> genTip) + <$> (MsgRollBackward <$> arbitrary + <*> arbitrary) , AnyMessageAndAgency (ClientAgency TokIdle) . MsgFindIntersect - <$> listOf genPoint + <$> listOf arbitrary , AnyMessageAndAgency (ServerAgency TokIntersect) - <$> (MsgIntersectFound <$> genPoint - <*> genTip) + <$> (MsgIntersectFound <$> arbitrary + <*> arbitrary) , AnyMessageAndAgency (ServerAgency TokIntersect) - <$> (MsgIntersectNotFound <$> genTip) + <$> (MsgIntersectNotFound <$> arbitrary) , return $ AnyMessageAndAgency (ClientAgency TokIdle) MsgDone ] + shrink (AnyMessageAndAgency (ClientAgency TokIdle) MsgRequestNext) = [] + shrink (AnyMessageAndAgency (ServerAgency (TokNext TokCanAwait)) MsgAwaitReply) = [] + shrink (AnyMessageAndAgency a@(ServerAgency (TokNext TokCanAwait)) (MsgRollForward header tip)) = + [ AnyMessageAndAgency a (MsgRollForward header' tip) + | header' <- shrink header + ] + ++ [ AnyMessageAndAgency a (MsgRollForward header tip') + | tip' <- shrink tip + ] + -- TODO: with ghc-9.2 or later this and previous case can be merged into one + shrink (AnyMessageAndAgency a@(ServerAgency (TokNext TokMustReply)) (MsgRollForward header tip)) = + [ AnyMessageAndAgency a (MsgRollForward header' tip) + | header' <- shrink header + ] + ++ [ AnyMessageAndAgency a (MsgRollForward header tip') + | tip' <- shrink tip + ] + shrink (AnyMessageAndAgency a@(ServerAgency TokNext {}) (MsgRollBackward header tip)) = + [ AnyMessageAndAgency a (MsgRollBackward header' tip) + | header' <- shrink header + ] + ++ [ AnyMessageAndAgency a (MsgRollBackward header tip') + | tip' <- shrink tip + ] + shrink (AnyMessageAndAgency a@(ClientAgency TokIdle) (MsgFindIntersect points)) = + [ AnyMessageAndAgency a (MsgFindIntersect points') + | points' <- shrink points + ] + shrink (AnyMessageAndAgency a@(ServerAgency TokIntersect) (MsgIntersectFound point tip)) = + [ AnyMessageAndAgency a (MsgIntersectFound point' tip) + | point' <- shrink point + ] + ++ [ AnyMessageAndAgency a (MsgIntersectFound point tip') + | tip' <- shrink tip + ] + shrink (AnyMessageAndAgency a@(ServerAgency TokIntersect) (MsgIntersectNotFound tip)) = + [ AnyMessageAndAgency a (MsgIntersectNotFound tip') + | tip' <- shrink tip + ] + shrink (AnyMessageAndAgency (ClientAgency TokIdle) MsgDone) = [] + -- type aliases to keep sizes down type ChainSync_BlockHeader = @@ -377,27 +417,25 @@ type ChainSync_BlockHeader = type ChainSync_Serialised_BlockHeader = ChainSync (Serialised BlockHeader) (Point BlockHeader) (Tip BlockHeader) -instance Arbitrary (AnyMessageAndAgency ChainSync_BlockHeader) where - arbitrary = genChainSync arbitrary arbitrary genTip +instance Arbitrary (Tip BlockHeader) where + arbitrary = f <$> arbitrary <*> arbitrary where - genTip = f <$> arbitrary <*> arbitrary f :: Point BlockHeader -> BlockNo -> Tip BlockHeader f GenesisPoint _ = TipGenesis f (BlockPoint s h) b = Tip s h b -instance Arbitrary (AnyMessageAndAgency ChainSync_Serialised_BlockHeader) where - arbitrary = genChainSync (castPoint <$> genPoint) - (serialiseBlock <$> arbitrary) - genTip + shrink TipGenesis = [] + shrink (Tip slotNo hash blockNo) = + [ Tip slotNo' hash blockNo + | slotNo' <- shrink slotNo + ] + ++ [ Tip slotNo hash blockNo' + | blockNo' <- shrink blockNo + ] + +instance Arbitrary (Serialised BlockHeader) where + arbitrary = serialiseBlock <$> arbitrary where - genTip = f <$> arbitrary <*> arbitrary - f :: Point BlockHeader -> BlockNo -> Tip BlockHeader - f GenesisPoint _ = TipGenesis - f (BlockPoint s h) b = Tip s h b - - genPoint :: Gen (Point BlockHeader) - genPoint = arbitrary - serialiseBlock :: BlockHeader -> Serialised BlockHeader serialiseBlock = Serialised . S.serialise From 51e8acf16bb8fd63524a45e053c3e1ee46e4211a Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 8 Aug 2023 16:57:05 +0200 Subject: [PATCH 2/5] cddl: use Any in the local-state-query mini-protocol --- ouroboros-network-protocols/test-cddl/Main.hs | 79 +++++++++++++----- .../test-cddl/specs/block-fetch.cddl | 3 +- .../test-cddl/specs/common.cddl | 2 +- .../test-cddl/specs/local-state-query.cddl | 8 +- .../Network/Protocol/BlockFetch/Test.hs | 61 +++++++++----- .../Network/Protocol/LocalStateQuery/Test.hs | 83 +++++++++++++------ 6 files changed, 157 insertions(+), 79 deletions(-) diff --git a/ouroboros-network-protocols/test-cddl/Main.hs b/ouroboros-network-protocols/test-cddl/Main.hs index fe1716a95e4..c88c61dfe62 100644 --- a/ouroboros-network-protocols/test-cddl/Main.hs +++ b/ouroboros-network-protocols/test-cddl/Main.hs @@ -58,7 +58,7 @@ import Ouroboros.Network.Block (Point, SlotNo, Tip, decodeTip, encodeTip, unwrapCBORinCBOR, wrapCBORinCBOR) import Ouroboros.Network.CodecCBORTerm import Ouroboros.Network.Magic -import Ouroboros.Network.Mock.ConcreteBlock (Block) +import qualified Ouroboros.Network.Mock.ConcreteBlock as Concrete (Block) import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion, NodeToClientVersionData (..), nodeToClientCodecCBORTerm) @@ -87,6 +87,9 @@ import Ouroboros.Network.Protocol.KeepAlive.Codec (codecKeepAlive_v2) import Ouroboros.Network.Protocol.KeepAlive.Test () import Ouroboros.Network.Protocol.KeepAlive.Type (KeepAlive) import qualified Ouroboros.Network.Protocol.KeepAlive.Type as KeepAlive +import Ouroboros.Network.Protocol.LocalStateQuery.Codec + (codecLocalStateQuery) +import qualified Ouroboros.Network.Protocol.LocalStateQuery.Codec as LocalStateQuery import qualified Ouroboros.Network.Protocol.LocalStateQuery.Test as LocalStateQuery import Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuery) @@ -116,8 +119,11 @@ import Ouroboros.Network.Protocol.PeerSharing.Test () import Ouroboros.Network.Protocol.PeerSharing.Type (ClientHasAgency (TokIdle), ServerHasAgency (..)) import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PeerSharing + +import Test.ChainGenerators () import Test.Data.CDDL (Any (..)) -import Test.QuickCheck + +import Test.QuickCheck hiding (Result (..)) import Test.QuickCheck.Instances.ByteString () import Test.Tasty (TestTree, adjustOption, defaultMain, testGroup) import Test.Tasty.HUnit @@ -179,7 +185,7 @@ tests CDDLSpecs { cddlChainSync cddlKeepAlive) , testProperty "LocalTxSubmission" (prop_encodeLocalTxSubmission cddlLocalTxSubmission) - , testProperty "LocalTxMonitor" (prop_encodeLocalTxMonitor + , testProperty "LocalTxMonitor" (prop_encodeLocalTxMonitor cddlLocalTxMonitor) , testProperty "LocalStateQuery" (prop_encodeLocalStateQuery cddlLocalStateQuery) @@ -212,7 +218,7 @@ tests CDDLSpecs { cddlChainSync cddlKeepAlive) , testCase "LocalTxSubmission" (unit_decodeLocalTxSubmission cddlLocalTxSubmission) - , testCase "LocalTxMonitor" (unit_decodeLocalTxMonitor + , testCase "LocalTxMonitor" (unit_decodeLocalTxMonitor cddlLocalTxMonitor) , testCase "LocalStateQuery" (unit_decodeLocalStateQuery cddlLocalStateQuery) @@ -235,16 +241,14 @@ data CDDLSpecs = CDDLSpecs { cddlHandshakeNodeToNodeV7To10 :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), cddlHandshakeNodeToNodeV11ToLast :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), cddlChainSync :: CDDLSpec (ChainSync BlockHeader HeaderPoint HeaderTip), - cddlBlockFetch :: CDDLSpec (BlockFetch Block (Point Block)), + cddlBlockFetch :: CDDLSpec (BlockFetch Block BlockPoint), cddlTxSubmission2 :: CDDLSpec (TxSubmission2 TxId Tx), cddlKeepAlive :: CDDLSpec KeepAlive, cddlLocalTxSubmission :: CDDLSpec (LocalTxSubmission LocalTxSubmission.Tx LocalTxSubmission.Reject), cddlLocalTxMonitor :: CDDLSpec (LocalTxMonitor TxId Tx SlotNo), - cddlLocalStateQuery :: CDDLSpec (LocalStateQuery - Block (Point Block) - LocalStateQuery.Query), + cddlLocalStateQuery :: CDDLSpec (LocalStateQuery Block BlockPoint Query), cddlPeerSharing :: CDDLSpec (PeerSharing.PeerSharing SockAddr), cddlNodeToNodeVersionDataV7To10 :: CDDLSpec NodeToNodeVersionData, @@ -308,6 +312,31 @@ newtype HeaderPoint = HeaderPoint Any newtype HeaderTip = HeaderTip Any deriving (Eq, Show, Arbitrary, Serialise) +newtype Block = Block Any + deriving (Eq, Show, Arbitrary, Serialise) + +newtype BlockPoint = BlockPoint Any + deriving (Eq, Show, Arbitrary, Serialise) + +newtype Result = Result Any + deriving (Eq, Show, Arbitrary, Serialise) + +-- TODO: add payload to the query +data Query result where + Query :: Any -> Query Result + +encodeQuery :: Query result -> CBOR.Encoding +encodeQuery (Query a) = Serialise.encode a + +decodeQuery :: forall s. CBOR.Decoder s (LocalStateQuery.Some Query) +decodeQuery = LocalStateQuery.Some . Query <$> Serialise.decode + +instance LocalStateQuery.ShowQuery Query where + showResult (Query query) result = show (query, result) +deriving instance Show (Query result) +instance Arbitrary (Query Result) where + arbitrary = Query <$> arbitrary + -- -- Mini-Protocol Codecs -- @@ -324,12 +353,12 @@ chainSyncCodec = Serialise.decode -blockFetchCodec :: Codec (BlockFetch Block (Point Block)) +blockFetchCodec :: Codec (BlockFetch Block BlockPoint) CBOR.DeserialiseFailure IO BL.ByteString blockFetchCodec = codecBlockFetch - (wrapCBORinCBOR Serialise.encode) - (unwrapCBORinCBOR (const <$> Serialise.decode)) + Serialise.encode + Serialise.decode Serialise.encode Serialise.decode @@ -363,10 +392,14 @@ localTxMonitorCodec = Serialise.encode Serialise.decode -localStateQueryCodec :: Codec (LocalStateQuery Block (Point Block) LocalStateQuery.Query) +localStateQueryCodec :: Codec (LocalStateQuery Block BlockPoint Query) CBOR.DeserialiseFailure IO BL.ByteString localStateQueryCodec = - LocalStateQuery.codec + codecLocalStateQuery + Serialise.encode Serialise.decode + encodeQuery decodeQuery + (\Query{} -> Serialise.encode) (\Query{} -> Serialise.decode) + -- @@ -588,8 +621,8 @@ prop_encodeChainSync spec = validateEncoder spec chainSyncCodec prop_encodeBlockFetch - :: CDDLSpec (BlockFetch Block (Point Block)) - -> AnyMessageAndAgency (BlockFetch Block (Point Block)) + :: CDDLSpec (BlockFetch Block BlockPoint) + -> AnyMessageAndAgency (BlockFetch Block BlockPoint) -> Property prop_encodeBlockFetch spec = validateEncoder spec blockFetchCodec @@ -623,10 +656,10 @@ prop_encodeLocalTxMonitor prop_encodeLocalTxMonitor spec = validateEncoder spec localTxMonitorCodec prop_encodeLocalStateQuery - :: CDDLSpec (LocalStateQuery Block (Point Block) LocalStateQuery.Query) - -> AnyMessageAndAgency (LocalStateQuery Block (Point Block) LocalStateQuery.Query) + :: CDDLSpec (LocalStateQuery Block BlockPoint Query) + -> LocalStateQuery.AnyMessageAndAgencyWithResult Block BlockPoint Query Result -> Property -prop_encodeLocalStateQuery spec = validateEncoder spec localStateQueryCodec +prop_encodeLocalStateQuery spec (LocalStateQuery.AnyMessageAndAgencyWithResult msg) = validateEncoder spec localStateQueryCodec msg instance Arbitrary PortNumber where arbitrary = fromIntegral @Word16 <$> arbitrary @@ -865,7 +898,7 @@ unit_decodeChainSync spec = unit_decodeBlockFetch - :: CDDLSpec (BlockFetch Block (Point Block)) + :: CDDLSpec (BlockFetch Block BlockPoint) -> Assertion unit_decodeBlockFetch spec = validateDecoder Nothing @@ -940,9 +973,8 @@ unit_decodeLocalTxMonitor spec = ] 100 - unit_decodeLocalStateQuery - :: CDDLSpec (LocalStateQuery Block (Point Block) LocalStateQuery.Query) + :: CDDLSpec (LocalStateQuery Block BlockPoint Query) -> Assertion unit_decodeLocalStateQuery spec = validateDecoder Nothing @@ -950,7 +982,10 @@ unit_decodeLocalStateQuery spec = [ SomeAgency $ ClientAgency LocalStateQuery.TokIdle , SomeAgency $ ClientAgency LocalStateQuery.TokAcquired , SomeAgency $ ServerAgency LocalStateQuery.TokAcquiring - , SomeAgency $ ServerAgency (LocalStateQuery.TokQuerying LocalStateQuery.QueryPoint) + , SomeAgency $ ServerAgency (LocalStateQuery.TokQuerying + (Query (error "invariant violation: lazy value"))) + -- note: we use a bottom, because the `codecLocalStateQuery` via + -- `decodeQuery` will not scrutinize the query payload. ] 100 diff --git a/ouroboros-network-protocols/test-cddl/specs/block-fetch.cddl b/ouroboros-network-protocols/test-cddl/specs/block-fetch.cddl index 5032c99f4e3..8541fd27c60 100644 --- a/ouroboros-network-protocols/test-cddl/specs/block-fetch.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/block-fetch.cddl @@ -17,6 +17,5 @@ msgRequestRange = [0, point, point] msgClientDone = [1] msgStartBatch = [2] msgNoBlocks = [3] -msgBlock = [4, #6.24(bytes .cbor block)] +msgBlock = [4, block] msgBatchDone = [5] - diff --git a/ouroboros-network-protocols/test-cddl/specs/common.cddl b/ouroboros-network-protocols/test-cddl/specs/common.cddl index c9e2c7f87e3..18f0ebdba91 100644 --- a/ouroboros-network-protocols/test-cddl/specs/common.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/common.cddl @@ -4,7 +4,7 @@ ; a bit arbitrarly. See `CBOR and CDDL` in the network technical report ; https://input-output-hk.github.io/ouroboros-network/pdfs/network-spec -block = [blockHeader, blockBody] +block = any blockHeader = [headerHash, chainHash, headerSlot, headerBlockNo, headerBodyHash] headerHash = int diff --git a/ouroboros-network-protocols/test-cddl/specs/local-state-query.cddl b/ouroboros-network-protocols/test-cddl/specs/local-state-query.cddl index ed670ec0c6a..cf788832a45 100644 --- a/ouroboros-network-protocols/test-cddl/specs/local-state-query.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/local-state-query.cddl @@ -18,12 +18,8 @@ acquireFailurePointNotOnChain = 1 failure = acquireFailurePointTooOld / acquireFailurePointNotOnChain -; 'query' and 'result' encodings are not specified; The values are only used -; for compatibility with -; 'Ouroboros.Network.Protocol.LocalStateQuery.Test.codec' -query = null -result = [] - / [point] +query = any +result = any msgAcquire = [0, point] / [8] diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/BlockFetch/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/BlockFetch/Test.hs index 937121bbc39..97931b504e7 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/BlockFetch/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/BlockFetch/Test.hs @@ -4,6 +4,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ParallelListComp #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -26,8 +27,8 @@ import Network.TypedProtocol.Proofs import Ouroboros.Network.Channel import Ouroboros.Network.Driver.Simple (runConnectedPeers) -import Ouroboros.Network.Block (Serialised (..), castPoint, - genesisPoint, unwrapCBORinCBOR, wrapCBORinCBOR) +import Ouroboros.Network.Block (Serialised (..), genesisPoint, + unwrapCBORinCBOR, wrapCBORinCBOR) import Ouroboros.Network.Mock.Chain (Chain, Point) import qualified Ouroboros.Network.Mock.Chain as Chain @@ -338,22 +339,42 @@ codecSerialised :: MonadST m m ByteString codecSerialised = codecBlockFetch S.encode S.decode S.encode S.decode -genBlockFetch :: Gen block - -> Gen (ChainRange point) - -> Gen (AnyMessageAndAgency (BlockFetch block point)) -genBlockFetch genBlock genChainRange = oneof - [ AnyMessageAndAgency (ClientAgency TokIdle) <$> - MsgRequestRange <$> genChainRange + +instance Arbitrary point => Arbitrary (ChainRange point) where + arbitrary = ChainRange <$> arbitrary <*> arbitrary + shrink (ChainRange a b) = + [ ChainRange a' b + | a' <- shrink a + ] + ++ + [ ChainRange a b' + | b' <- shrink b + ] + +instance (Arbitrary block, Arbitrary point) + => Arbitrary (AnyMessageAndAgency (BlockFetch block point)) where + arbitrary = oneof + [ AnyMessageAndAgency (ClientAgency TokIdle) <$> MsgRequestRange <$> arbitrary , return $ AnyMessageAndAgency (ServerAgency TokBusy) MsgStartBatch , return $ AnyMessageAndAgency (ServerAgency TokBusy) MsgNoBlocks - , AnyMessageAndAgency (ServerAgency TokStreaming) <$> - MsgBlock <$> genBlock + , AnyMessageAndAgency (ServerAgency TokStreaming) <$> MsgBlock <$> arbitrary , return $ AnyMessageAndAgency (ServerAgency TokStreaming) MsgBatchDone , return $ AnyMessageAndAgency (ClientAgency TokIdle) MsgClientDone ] -instance Arbitrary (AnyMessageAndAgency (BlockFetch Block (Point Block))) where - arbitrary = genBlockFetch arbitrary arbitrary + shrink (AnyMessageAndAgency a@(ClientAgency TokIdle) (MsgRequestRange range)) = + [ AnyMessageAndAgency a (MsgRequestRange range') + | range' <- shrink range + ] + shrink (AnyMessageAndAgency (ServerAgency TokBusy) MsgStartBatch) = [] + shrink (AnyMessageAndAgency (ServerAgency TokBusy) MsgNoBlocks) = [] + shrink (AnyMessageAndAgency a@(ServerAgency TokStreaming) (MsgBlock block)) = + [ AnyMessageAndAgency a (MsgBlock block') + | block' <- shrink block + ] + shrink (AnyMessageAndAgency (ServerAgency TokStreaming) MsgBatchDone) = [] + shrink (AnyMessageAndAgency (ClientAgency TokIdle) MsgClientDone) = [] + instance (Eq block, Eq point) => Eq (AnyMessage (BlockFetch block point)) where @@ -365,17 +386,11 @@ instance (Eq block, Eq point) => AnyMessage MsgClientDone == AnyMessage MsgClientDone = True _ == _ = False -instance Arbitrary (AnyMessageAndAgency (BlockFetch (Serialised Block) (Point Block))) where - arbitrary = genBlockFetch (serialiseBlock <$> arbitrary) - (toSerialisedChainRange <$> arbitrary) - where - serialiseBlock :: Block -> Serialised Block - serialiseBlock = Serialised . S.serialise +instance Arbitrary (Serialised Block) where + arbitrary = Serialised . S.serialise @Block <$> arbitrary - toSerialisedChainRange :: ChainRange (Point Block) - -> ChainRange (Point Block) - toSerialisedChainRange (ChainRange l u) = - ChainRange (castPoint l) (castPoint u) + shrink (Serialised block) = + Serialised . S.serialise @Block <$> shrink (S.deserialise block) prop_codec_BlockFetch :: AnyMessageAndAgency (BlockFetch Block (Point Block)) @@ -464,7 +479,7 @@ prop_codec_binary_compat_BlockFetchSerialised_BlockFetch msg = TokStreaming -> SamePeerHasAgency $ ServerAgency TokStreaming -- --- Auxilary functions +-- Auxiliary functions -- -- | Generate a list of @ChainRange@s from a list of points on a chain. The diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs index 3a366f13ade..258be6630d4 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs @@ -11,7 +11,7 @@ module Ouroboros.Network.Protocol.LocalStateQuery.Test ( tests , codec - , Query (..) + , AnyMessageAndAgencyWithResult (..) ) where import qualified Codec.CBOR.Decoding as CBOR @@ -84,6 +84,18 @@ tests = -- Common types & clients and servers used in the tests in this module. -- +data QueryWithResult query result where + QueryWithResult :: query result + -> result + -> QueryWithResult query result + deriving Show + +instance ( Arbitrary (query result) + , Arbitrary result + ) + => Arbitrary (QueryWithResult query result) where + arbitrary = QueryWithResult <$> arbitrary <*> arbitrary + data Query result where QueryPoint :: Query (Maybe (Point Block)) @@ -238,26 +250,45 @@ instance Arbitrary AcquireFailure where instance Arbitrary (Query (Maybe (Point Block))) where arbitrary = pure QueryPoint -instance Arbitrary (AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)) where - arbitrary = oneof - [ getAnyMessageAndAgencyV7 <$> arbitrary +-- | A newtype wrapper which captures type of response generated for all +-- queries. +-- +-- Note that this is not as general as the protocol allows, since the protocol +-- admits different result for different queries. +-- +newtype AnyMessageAndAgencyWithResult block point query result = AnyMessageAndAgencyWithResult { + getAnyMessageAndAgencyWithResult :: AnyMessageAndAgency (LocalStateQuery block point query) + } + deriving Show + +instance ( Arbitrary point + , Arbitrary (query result) + , Arbitrary result + ) + => Arbitrary (AnyMessageAndAgencyWithResult block point query result) where + arbitrary = oneof + [ AnyMessageAndAgencyWithResult . getAnyMessageAndAgencyV7 <$> (arbitrary :: Gen (AnyMessageAndAgencyV7 block point query result)) - , pure $ AnyMessageAndAgency (ClientAgency TokIdle) - (MsgAcquire Nothing) + , pure $ AnyMessageAndAgencyWithResult $ AnyMessageAndAgency (ClientAgency TokIdle) + (MsgAcquire Nothing) - , pure $ AnyMessageAndAgency (ClientAgency TokAcquired) - (MsgReAcquire Nothing) - ] + , pure $ AnyMessageAndAgencyWithResult $ AnyMessageAndAgency (ClientAgency TokAcquired) + (MsgReAcquire Nothing) + ] -- Newtype wrapper which generates only valid data for 'NodeToClientV7' protocol. -- -newtype AnyMessageAndAgencyV7 = AnyMessageAndAgencyV7 { +newtype AnyMessageAndAgencyV7 block point query result = AnyMessageAndAgencyV7 { getAnyMessageAndAgencyV7 - :: AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query) + :: AnyMessageAndAgency (LocalStateQuery block point query) } deriving Show -instance Arbitrary AnyMessageAndAgencyV7 where +instance ( Arbitrary point + , Arbitrary (query result) + , Arbitrary result + ) + => Arbitrary (AnyMessageAndAgencyV7 block point query result) where arbitrary = AnyMessageAndAgencyV7 <$> oneof [ AnyMessageAndAgency (ClientAgency TokIdle) <$> (MsgAcquire . Just <$> arbitrary) @@ -269,10 +300,12 @@ instance Arbitrary AnyMessageAndAgencyV7 where (MsgFailure <$> arbitrary) , AnyMessageAndAgency (ClientAgency TokAcquired) <$> - (MsgQuery <$> (arbitrary :: Gen (Query (Maybe (Point Block))))) + (MsgQuery <$> (arbitrary :: Gen (query result))) - , AnyMessageAndAgency (ServerAgency (TokQuerying QueryPoint)) <$> - (MsgResult QueryPoint <$> arbitrary) + , (\(QueryWithResult query result) -> + AnyMessageAndAgency (ServerAgency (TokQuerying query)) + (MsgResult query result)) + <$> (arbitrary :: Gen (QueryWithResult query result)) , AnyMessageAndAgency (ClientAgency TokAcquired) <$> pure MsgRelease @@ -348,36 +381,36 @@ codec = -- | Check the codec round trip property. -- prop_codec - :: AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query) + :: AnyMessageAndAgencyWithResult Block (Point Block) Query (Maybe (Point Block)) -> Bool -prop_codec msg = +prop_codec (AnyMessageAndAgencyWithResult msg) = runST (prop_codecM codec msg) -- | Check for data chunk boundary problems in the codec using 2 chunks. -- prop_codec_splits2 - :: AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query) + :: AnyMessageAndAgencyWithResult Block (Point Block) Query (Maybe (Point Block)) -> Bool -prop_codec_splits2 msg = +prop_codec_splits2 (AnyMessageAndAgencyWithResult msg) = runST (prop_codec_splitsM splits2 codec msg) -- | Check for data chunk boundary problems in the codec using 3 chunks. -- prop_codec_splits3 - :: AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query) + :: AnyMessageAndAgencyWithResult Block (Point Block) Query (Maybe (Point Block)) -> Bool -prop_codec_splits3 msg = +prop_codec_splits3 (AnyMessageAndAgencyWithResult msg) = runST (prop_codec_splitsM splits3 codec msg) prop_codec_cbor - :: AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query) + :: AnyMessageAndAgencyWithResult Block (Point Block) Query (Maybe (Point Block)) -> Bool -prop_codec_cbor msg = +prop_codec_cbor (AnyMessageAndAgencyWithResult msg) = runST (prop_codec_cborM codec msg) -- | Check that the encoder produces a valid CBOR. -- prop_codec_valid_cbor - :: AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query) + :: AnyMessageAndAgencyWithResult Block (Point Block) Query (Maybe (Point Block)) -> Property -prop_codec_valid_cbor = prop_codec_valid_cbor_encoding codec +prop_codec_valid_cbor (AnyMessageAndAgencyWithResult msg) = prop_codec_valid_cbor_encoding codec msg From c4c712c251861bed9f179fa3ef16693d0e4e8949 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 9 Aug 2023 10:27:06 +0200 Subject: [PATCH 3/5] cddl: removed unused definitions --- .../test-cddl/specs/chain-sync.cddl | 7 +--- .../test-cddl/specs/common.cddl | 32 ++++++------------- .../test-cddl/specs/local-tx-submission.cddl | 1 + 3 files changed, 12 insertions(+), 28 deletions(-) diff --git a/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl b/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl index d9fe2e3d60f..d43429036be 100644 --- a/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/chain-sync.cddl @@ -10,15 +10,10 @@ chainSyncMessage msgRequestNext = [0] msgAwaitReply = [1] -msgRollForward = [2, wrappedHeader, tip] +msgRollForward = [2, header, tip] msgRollBackward = [3, point, tip] msgFindIntersect = [4, points] msgIntersectFound = [5, point, tip] msgIntersectNotFound = [6, tip] chainSyncMsgDone = [7] -wrappedHeader = any -tip = any - -points = [ *point ] - diff --git a/ouroboros-network-protocols/test-cddl/specs/common.cddl b/ouroboros-network-protocols/test-cddl/specs/common.cddl index 18f0ebdba91..e35b2b6989d 100644 --- a/ouroboros-network-protocols/test-cddl/specs/common.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/common.cddl @@ -4,29 +4,17 @@ ; a bit arbitrarly. See `CBOR and CDDL` in the network technical report ; https://input-output-hk.github.io/ouroboros-network/pdfs/network-spec -block = any +block = any +header = any +tip = any +point = any +points = [ *point ] +txId = any +tx = any -blockHeader = [headerHash, chainHash, headerSlot, headerBlockNo, headerBodyHash] -headerHash = int -chainHash = genesisHash / blockHash -genesisHash = [] -blockHash = [int] -blockBody = bstr -headerSlot = word64 -headerBlockNo = word64 -headerBodyHash = int - -point = any -origin = [] -blockHeaderHash = [slotNo, int] -slotNo = word64 - -; In this spec we don't specify what transaction idenfiers (txId) or -; transactions (tx) are themselves, `ouroboros-network` is polymorphic over -; them. -txId = any -tx = any -rejectReason = int +; although some of our protocols are polymorphic over slots, e.g. +; `local-tx-monitor`, slots are always encoded as `word64`. +slotNo = word64 word16 = 0..65535 word32 = 0..4294967295 diff --git a/ouroboros-network-protocols/test-cddl/specs/local-tx-submission.cddl b/ouroboros-network-protocols/test-cddl/specs/local-tx-submission.cddl index 7d5ee6bb326..2e856293dbe 100644 --- a/ouroboros-network-protocols/test-cddl/specs/local-tx-submission.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/local-tx-submission.cddl @@ -17,3 +17,4 @@ msgAcceptTx = [1] msgRejectTx = [2, rejectReason ] ltMsgDone = [3] +rejectReason = int From ef4c049e00898152c80ac04a77774c994dde653f Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 9 Aug 2023 10:20:41 +0200 Subject: [PATCH 4/5] cddl: updated documentation --- docs/network-spec/miniprotocols.tex | 21 +++++++++++-------- ouroboros-network-protocols/CHANGELOG.md | 2 ++ .../test-cddl/specs/common.cddl | 9 +++++--- 3 files changed, 20 insertions(+), 12 deletions(-) diff --git a/docs/network-spec/miniprotocols.tex b/docs/network-spec/miniprotocols.tex index 83cb15bd631..45511d64f3d 100644 --- a/docs/network-spec/miniprotocols.tex +++ b/docs/network-spec/miniprotocols.tex @@ -233,18 +233,21 @@ \section{CBOR and CDDL} Note that the networking layer knows very little about blocks, transactions or their indetifiers. We use parametric polymorphism in the implementation which -is not present in CDDL. For this reason we have to make concrete choices which -might not agree with what is used by `Cardano`. Each ledger era has its own -CDDL spec which you can find +is not present in CDDL. For this reason we use \texttt{any} in our CDDL specifications. +If you want to find concrete instatiations of these types in by `Cardano` you +will need to consult +\href{https://github.com/input-output-hk/cardano-ledger}{cardano-ledger} and +\href{https://github.com/input-output-hk/ouroboros-consensus}{ouroboros-consensus}. +Each ledger era has its own CDDL spec which you can find \href{https://github.com/input-output-hk/cardano-ledger#cardano-ledger}{here}. Note that there's also the hard fork combinator (HFC) which allows us to -combine multiple eras into a single blockchain. It affects how things are -encoded across different eras. Currently this is not properly documented (see +combine multiple eras into a single blockchain. It affects how many of the +data types are encoded across different eras. Currently this is not properly +documented (see \href{https://github.com/input-output-hk/ouroboros-consensus/issues/7}{issue -\#7}). In the mean time we can only offer informal advise: things are encoded as -tuples (length 2 lists), where the first element is a zero based index of an -era while the second item represents the data from that era (e.g. block, -transaction, etc). +\#7}). In the mean time we can only offer informal advise: data is encoded +as tuples (length 2 lists), where the first element is a zero based index of an +era while the second item is the era dependent encoding. \section{Dummy Protocols} Dummy protocols are only used for testing and are not needed either for diff --git a/ouroboros-network-protocols/CHANGELOG.md b/ouroboros-network-protocols/CHANGELOG.md index c28f984be8a..e8a8cfb665f 100644 --- a/ouroboros-network-protocols/CHANGELOG.md +++ b/ouroboros-network-protocols/CHANGELOG.md @@ -6,6 +6,8 @@ ### Non-breaking changes +* Improved cdd specs by using `any` (PR #4638) + ## 0.5.2.0 -- 2023-09-08 ### Breaking changes diff --git a/ouroboros-network-protocols/test-cddl/specs/common.cddl b/ouroboros-network-protocols/test-cddl/specs/common.cddl index e35b2b6989d..5fd8551671a 100644 --- a/ouroboros-network-protocols/test-cddl/specs/common.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/common.cddl @@ -1,8 +1,11 @@ -; The Codecs are polymorphic in the data types for blocks, points, slot -; numbers etc. In CDDL we need concrete values so we instantiate them -; a bit arbitrarly. See `CBOR and CDDL` in the network technical report +; Mini-protocol codecs are polymorphic in various data types, e.g. blocks, points, +; transactions, transaction ids, etc. In CDDL we need concrete values so we +; instantiate them using `any`. See `CBOR and CDDL` in the network +; technical report ; https://input-output-hk.github.io/ouroboros-network/pdfs/network-spec +; if you need further advise how to find concrete encoding of `Cardano` data +; types. block = any header = any From 9aed02b5f5894c550538ceb29c2b4e8e5026cea1 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 8 Aug 2023 18:33:53 +0200 Subject: [PATCH 5/5] TxSubmission: removed the Hello transformer We used it to transform TxSubmission v1 into v2, but this is no longer the case. --- .../Protocol/TxSubmission/Hello/Codec.hs | 72 ------------------- .../Protocol/TxSubmission/Hello/Type.hs | 24 ------- 2 files changed, 96 deletions(-) delete mode 100644 ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Codec.hs delete mode 100644 ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Type.hs diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Codec.hs deleted file mode 100644 index 8d2d4d1dd5e..00000000000 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Codec.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE RankNTypes #-} - -module Ouroboros.Network.Protocol.TxSubmission2.Hello.Codec - ( codecTxSubmission2 - , codecTxSubmission2Id - , byteLimitsTxSubmission2 - , timeLimitsTxSubmission2 - ) where - -import Control.Monad.Class.MonadST - -import qualified Codec.CBOR.Decoding as CBOR -import qualified Codec.CBOR.Encoding as CBOR -import qualified Codec.CBOR.Read as CBOR -import Data.ByteString.Lazy (ByteString) - -import Network.TypedProtocol.Codec.CBOR - -import Ouroboros.Network.Driver.Limits -import Ouroboros.Network.Protocol.Trans.Hello.Codec -import Ouroboros.Network.Protocol.TxSubmission.Codec -import Ouroboros.Network.Protocol.TxSubmission2.Hello.Type -import Ouroboros.Network.Util.ShowProxy - - --- | Byte Limits. --- --- Preserves byte limits of the original 'TxSubmission' protocol, see --- 'timeLimitsTxSubmission'. 'MsgHello' is using 'smallByteLimit' limit. --- -byteLimitsTxSubmission2 :: forall bytes txid tx. - (bytes -> Word) - -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes -byteLimitsTxSubmission2 = byteLimitsHello . byteLimitsTxSubmission - - --- | Time limits. --- --- Preserves the timeouts of 'TxSubmission' protocol, see --- 'timeLimitsTxSubmission'. 'MsgHello' does not have a timeout. --- -timeLimitsTxSubmission2 :: forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx) -timeLimitsTxSubmission2 = timeLimitsHello timeLimitsTxSubmission - - -codecTxSubmission2 - :: forall txid tx m. - ( MonadST m - , ShowProxy txid - , ShowProxy tx - ) - => (txid -> CBOR.Encoding) - -> (forall s . CBOR.Decoder s txid) - -> (tx -> CBOR.Encoding) - -> (forall s . CBOR.Decoder s tx) - -> Codec (TxSubmission2 txid tx) CBOR.DeserialiseFailure m ByteString -codecTxSubmission2 encodeTxId decodeTxId - encodeTx decodeTx = - codecHello - 6 - (encodeTxSubmission encodeTxId encodeTx) - (decodeTxSubmission decodeTxId decodeTx) - -codecTxSubmission2Id - :: forall txid tx m. Monad m - => Codec (TxSubmission2 txid tx) CodecFailure m (AnyMessage (TxSubmission2 txid tx)) -codecTxSubmission2Id = codecHelloId codecTxSubmissionId - diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Type.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Type.hs deleted file mode 100644 index 2a40b0fd14e..00000000000 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission/Hello/Type.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE DataKinds #-} - --- | The transaction submission protocol version 2. --- --- This module ony defines the type of the protocol, and exports all useful --- functions and types. --- -module Ouroboros.Network.Protocol.TxSubmission2.Hello.Type - ( TxSubmission2 - , module TxSubmission - , module Util - ) where - -import Ouroboros.Network.Protocol.Trans.Hello.Type (Hello) -import Ouroboros.Network.Protocol.Trans.Hello.Util as Util -import Ouroboros.Network.Protocol.TxSubmission.Type as TxSubmission - --- | The new version of transaction submission protocol. --- --- Unlike the original 'TxSubmission' protocol, this protocol starts with --- agency on the client side, like all other mini-protocols. --- -type TxSubmission2 txid tx = Hello (TxSubmission txid tx) StIdle -