Skip to content

Commit eedb23a

Browse files
cootcoot
committed
dmq-test: added SigSubmission codec tests
1 parent 5860060 commit eedb23a

File tree

5 files changed

+172
-1
lines changed

5 files changed

+172
-1
lines changed

‎decentralized-message-queue/decentralized-message-queue.cabal‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -100,6 +100,7 @@ test-suite dmq-test
100100
other-modules:
101101
Test.DMQ.NodeToClient
102102
Test.DMQ.NodeToNode
103+
Test.DMQ.Protocol.SigSubmission
103104

104105
type: exitcode-stdio-1.0
105106
hs-source-dirs: test
@@ -109,8 +110,11 @@ test-suite dmq-test
109110
base >=4.14 && <4.22,
110111
decentralized-message-queue,
111112
ouroboros-network-api,
113+
ouroboros-network-protocols:testlib,
114+
quickcheck-instances,
112115
tasty,
113116
tasty-quickcheck,
117+
typed-protocols,
114118
with-utf8,
115119

116120
ghc-options:

‎decentralized-message-queue/src/DMQ/Protocol/SigSubmission/Codec.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module DMQ.Protocol.SigSubmission.Codec
88
( codecSigSubmission
99
, byteLimitsSigSubmission
1010
, timeLimitsSigSubmission
11+
, codecSigSubmissionId
1112
) where
1213

1314
import Control.Monad (when)
@@ -118,3 +119,9 @@ codecSigSubmission =
118119
sigKesSignature,
119120
sigOpCertificate
120121
}
122+
123+
124+
codecSigSubmissionId
125+
:: Monad m
126+
=> Codec SigSubmission CodecFailure m (AnyMessage SigSubmission)
127+
codecSigSubmissionId = TX.codecTxSubmission2Id

‎decentralized-message-queue/test/Main.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@ module Main (main) where
22

33
import Main.Utf8 (withUtf8)
44

5+
import Test.DMQ.NodeToClient qualified
56
import Test.DMQ.NodeToNode qualified
7+
import Test.DMQ.Protocol.SigSubmission qualified
68

79
import Test.Tasty
810

@@ -14,5 +16,7 @@ main = withUtf8 $ defaultMain tests
1416
tests :: TestTree
1517
tests =
1618
testGroup "decentralised-message-queue:testse"
17-
[ Test.DMQ.NodeToNode.tests
19+
[ Test.DMQ.NodeToClient.tests
20+
, Test.DMQ.NodeToNode.tests
21+
, Test.DMQ.Protocol.SigSubmission.tests
1822
]

‎decentralized-message-queue/test/Test/DMQ/Protocol/SigSubmission.hs‎

Lines changed: 155 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,155 @@
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE TypeApplications #-}
4+
5+
{-# OPTIONS_GHC -Wno-orphans #-}
6+
7+
module Test.DMQ.Protocol.SigSubmission where
8+
9+
import Control.Monad.ST (runST)
10+
import Data.Bifunctor (second)
11+
import Data.List.NonEmpty qualified as NonEmpty
12+
import Data.Word (Word32)
13+
14+
import Network.TypedProtocol.Codec hiding (prop_codec)
15+
16+
import Ouroboros.Network.SizeInBytes
17+
18+
import DMQ.Protocol.SigSubmission.Type
19+
import DMQ.Protocol.SigSubmission.Codec
20+
21+
import Ouroboros.Network.Protocol.TxSubmission2.Test (labelMsg)
22+
23+
import Test.Ouroboros.Network.Protocol.Utils (prop_codec_cborM,
24+
prop_codec_valid_cbor_encoding, splits2, splits3)
25+
26+
import Test.Tasty
27+
import Test.Tasty.QuickCheck
28+
import Test.QuickCheck as QC
29+
import Test.QuickCheck.Instances.ByteString ()
30+
31+
32+
tests :: TestTree
33+
tests =
34+
testGroup "DMQ.Protocol"
35+
[ testGroup "SigSubmission"
36+
[ testProperty "codec" prop_codec
37+
, testProperty "codec id" prop_codec_id
38+
, testProperty "codec 2-splits" prop_codec_splits2
39+
, testProperty "codec 3-splits" $ withMaxSize 10
40+
prop_codec_splits3
41+
, testProperty "codec cbor" prop_codec_cbor
42+
, testProperty "codec valid cbor" prop_codec_valid_cbor
43+
]
44+
]
45+
46+
instance Arbitrary SigHash where
47+
arbitrary = SigHash <$> arbitrary
48+
shrink = map SigHash . shrink . getSigHash
49+
50+
instance Arbitrary SigId where
51+
arbitrary = SigId <$> arbitrary
52+
shrink = map SigId . shrink . getSigId
53+
54+
instance Arbitrary SigBody where
55+
arbitrary = SigBody <$> arbitrary
56+
shrink = map SigBody . shrink . getSigBody
57+
58+
instance Arbitrary SigTTL where
59+
-- generate only whole seconds (this is what we receive on the wire)
60+
arbitrary = SigTTL . realToFrac @Word32 <$> arbitrary
61+
-- shrink via Word32 (e.g. in seconds)
62+
shrink (SigTTL posix) = SigTTL . realToFrac
63+
<$> shrink (floor @_ @Word32 posix)
64+
65+
instance Arbitrary SigKesSignature where
66+
arbitrary = SigKesSignature <$> arbitrary
67+
shrink = map SigKesSignature . shrink . getSigKesSignature
68+
69+
instance Arbitrary SigOpCertificate where
70+
arbitrary = SigOpCertificate <$> arbitrary
71+
shrink = map SigOpCertificate . shrink . getSigOpCertificate
72+
73+
instance Arbitrary Sig where
74+
arbitrary = Sig <$> arbitrary
75+
<*> arbitrary
76+
<*> arbitrary
77+
<*> arbitrary
78+
shrink sig@Sig { sigId, sigBody, sigTTL, sigOpCertificate, sigKesSignature } =
79+
[ sig { sigId = sigId' }
80+
| sigId' <- shrink sigId
81+
]
82+
++
83+
[ sig { sigBody = sigBody' }
84+
| sigBody' <- shrink sigBody
85+
]
86+
++
87+
[ sig { sigTTL = sigTTL' }
88+
| sigTTL' <- shrink sigTTL
89+
]
90+
++
91+
[ sig { sigOpCertificate = sigOpCertificate' }
92+
| sigOpCertificate' <- shrink sigOpCertificate
93+
]
94+
++
95+
[ sig { sigKesSignature = sigKesSignature' }
96+
| sigKesSignature' <- shrink sigKesSignature
97+
]
98+
99+
100+
instance Arbitrary (AnyMessage SigSubmission) where
101+
arbitrary = oneof
102+
[ pure $ AnyMessage MsgInit
103+
, AnyMessage <$>
104+
(MsgRequestTxIds SingBlocking
105+
<$> arbitrary
106+
<*> arbitrary)
107+
108+
, AnyMessage <$>
109+
(MsgRequestTxIds SingNonBlocking
110+
<$> arbitrary
111+
<*> arbitrary)
112+
113+
, AnyMessage <$>
114+
MsgReplyTxIds <$> (BlockingReply . NonEmpty.fromList
115+
. map (second SizeInBytes)
116+
. QC.getNonEmpty
117+
<$> arbitrary)
118+
119+
, AnyMessage <$> MsgReplyTxIds <$> (NonBlockingReply . map (second SizeInBytes) <$> arbitrary)
120+
121+
, AnyMessage <$> MsgRequestTxs <$> arbitrary
122+
123+
, AnyMessage <$> MsgReplyTxs <$> arbitrary
124+
125+
, AnyMessage <$> pure MsgDone
126+
]
127+
128+
prop_codec :: AnyMessage SigSubmission -> Bool
129+
prop_codec msg =
130+
runST (prop_codecM codecSigSubmission msg)
131+
132+
prop_codec_id :: AnyMessage SigSubmission -> Bool
133+
prop_codec_id msg =
134+
runST (prop_codecM codecSigSubmissionId msg)
135+
136+
prop_codec_splits2 :: AnyMessage SigSubmission -> Bool
137+
prop_codec_splits2 msg =
138+
runST (prop_codec_splitsM splits2 codecSigSubmission msg)
139+
140+
prop_codec_splits3 :: AnyMessage SigSubmission -> Property
141+
prop_codec_splits3 msg =
142+
labelMsg msg $
143+
runST (prop_codec_splitsM splits3 codecSigSubmission msg)
144+
145+
146+
prop_codec_cbor
147+
:: AnyMessage SigSubmission
148+
-> Property
149+
prop_codec_cbor msg =
150+
runST (prop_codec_cborM codecSigSubmission msg)
151+
152+
prop_codec_valid_cbor
153+
:: AnyMessage SigSubmission
154+
-> Property
155+
prop_codec_valid_cbor = prop_codec_valid_cbor_encoding codecSigSubmission

‎ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/TxSubmission2/Test.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Ouroboros.Network.Protocol.TxSubmission2.Test
1818
( tests
1919
, Tx (..)
2020
, TxId (..)
21+
, labelMsg
2122
) where
2223

2324
import Data.Bifunctor (second)

0 commit comments

Comments
 (0)