Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit 93cbd79

Browse files
authored
Merge pull request #3268 from input-output-hk/jordan/CDEC-453
[CDEC-453] Add golden/bitripping tests for `HandlerSpec`
2 parents ef69715 + a542c5a commit 93cbd79

File tree

12 files changed

+156
-18
lines changed

12 files changed

+156
-18
lines changed

core/test/Test/Pos/Core/Gen.hs

+5-2
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,8 @@ module Test.Pos.Core.Gen
144144
-- Helpers
145145
, genByte
146146
, genUTF8Byte
147+
, genWord16
148+
, gen32Bytes
147149
) where
148150

149151
import Universum
@@ -686,8 +688,6 @@ genOpeningsMap = do
686688

687689
genSharesDistribution :: Gen SharesDistribution
688690
genSharesDistribution = genCustomHashMap genStakeholderId genWord16
689-
where
690-
genWord16 = Gen.word16 Range.constantBounded
691691

692692
genSharesMap :: Gen SharesMap
693693
genSharesMap = do
@@ -1018,3 +1018,6 @@ genWord32 = Gen.word32 Range.constantBounded
10181018

10191019
genWord8 :: Gen Word8
10201020
genWord8 = Gen.word8 Range.constantBounded
1021+
1022+
genWord16 :: Gen Word16
1023+
genWord16 = Gen.word16 Range.constantBounded

infra/cardano-sl-infra.cabal

+29-3
Original file line numberDiff line numberDiff line change
@@ -212,15 +212,41 @@ test-suite test
212212
type: exitcode-stdio-1.0
213213

214214
other-modules: Spec
215+
Test.Pos.Infra.Arbitrary
216+
Test.Pos.Infra.Arbitrary.Communication
217+
Test.Pos.Infra.Arbitrary.Slotting
218+
Test.Pos.Infra.Arbitrary.Ssc
219+
Test.Pos.Infra.Arbitrary.Txp
220+
Test.Pos.Infra.Arbitrary.Update
221+
Test.Pos.Infra.Bi
215222
Test.Pos.Infra.Diffusion.Subscription.StatusSpec
216223
Test.Pos.Infra.Diffusion.Subscription.SubscriptionSpec
224+
Test.Pos.Infra.Gen
217225

218-
build-depends: async
226+
build-depends: QuickCheck
227+
, async
219228
, base
229+
, bytestring
230+
, cardano-sl-binary
231+
, cardano-sl-binary-test
232+
, cardano-sl-core
233+
, cardano-sl-core-test
234+
, cardano-sl-crypto
220235
, cardano-sl-crypto-test
221236
, cardano-sl-infra
237+
, cardano-sl-ssc
238+
, cardano-sl-ssc-test
239+
, cardano-sl-update-test
240+
, cardano-sl-util-test
222241
, containers
223-
, QuickCheck
242+
, generic-arbitrary
243+
, hedgehog
224244
, hspec
245+
, kademlia
246+
, universum
225247

226-
ghc-options: -threaded
248+
ghc-options: -Wall
249+
-O2
250+
-threaded
251+
252+
default-extensions: NoImplicitPrelude

infra/test/Spec.hs

+1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module Spec
22
( spec
33
) where
44

5+
import Prelude
56
import Test.Hspec
67
import qualified Test.Pos.Infra.Diffusion.Subscription.StatusSpec (spec)
78
import qualified Test.Pos.Infra.Diffusion.Subscription.SubscriptionSpec (spec)

infra/test/Test/Pos/Infra/Bi.hs

+47
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE TypeApplications #-}
3+
4+
module Test.Pos.Infra.Bi
5+
( tests
6+
) where
7+
8+
import Universum
9+
10+
import Hedgehog (Property)
11+
import qualified Hedgehog as H
12+
import Pos.Infra.Communication.Types.Protocol (HandlerSpec (..))
13+
import qualified Prelude
14+
import Test.Pos.Binary.Helpers.GoldenRoundTrip (goldenTestBi,
15+
roundTripsBiBuildable)
16+
import Test.Pos.Infra.Gen (genHandlerSpec)
17+
import Test.Pos.Util.Golden (discoverGolden, eachOf)
18+
import Test.Pos.Util.Tripping (discoverRoundTrip)
19+
20+
--------------------------------------------------------------------------------
21+
-- HandlerSpec
22+
--------------------------------------------------------------------------------
23+
24+
golden_HandlerSpec_ConvHandler :: Property
25+
golden_HandlerSpec_ConvHandler =
26+
goldenTestBi exampleConvHandler "test/golden/HandlerSpec_ConvHandler"
27+
where
28+
exampleConvHandler = ConvHandler 15553
29+
30+
golden_HandlerSpec_UnknownHandler :: Property
31+
golden_HandlerSpec_UnknownHandler =
32+
goldenTestBi exampleUnknownHandler "test/golden/HandlerSpec_UnknownHandler"
33+
where
34+
exampleUnknownHandler = UnknownHandler 104 Prelude.$ encodeUtf8 @String @ByteString "\248U=\232\167\t"
35+
36+
roundTripHandlerSpecBi :: Property
37+
roundTripHandlerSpecBi = eachOf 1000 genHandlerSpec roundTripsBiBuildable
38+
39+
-----------------------------------------------------------------------
40+
-- Main test export
41+
-----------------------------------------------------------------------
42+
43+
tests :: IO Bool
44+
tests = and <$> sequence
45+
[ H.checkSequential $$discoverGolden
46+
, H.checkParallel $$discoverRoundTrip
47+
]

infra/test/Test/Pos/Infra/Diffusion/Subscription/StatusSpec.hs

+7-8
Original file line numberDiff line numberDiff line change
@@ -9,10 +9,10 @@ import Prelude
99
import Data.List ((\\))
1010
import Data.Map.Strict (Map)
1111
import qualified Data.Map.Strict as Map
12-
import Test.Hspec (describe)
12+
import Test.Hspec (SpecWith, describe)
1313
import Test.Hspec.QuickCheck (prop)
1414
import Test.QuickCheck (Gen, Property, elements, forAllShrink,
15-
ioProperty, listOf, shrinkList, sized, (===))
15+
ioProperty, shrinkList, sized, (===))
1616

1717
import Pos.Infra.Diffusion.Subscription.Status (Changes,
1818
SubscriptionStates, SubscriptionStatus (..), changes,
@@ -27,9 +27,7 @@ newtype Inputs = Inputs
2727
}
2828
deriving (Show)
2929

30-
newtype Expectations = Expectations
31-
{ getExpectations :: [Map Key SubscriptionStatus]
32-
}
30+
newtype Expectations = Expectations [Map Key SubscriptionStatus]
3331
deriving (Eq, Show)
3432

3533
type Observations = Expectations
@@ -92,9 +90,9 @@ getObservations (Inputs inputs) = do
9290
-> Changes Key
9391
-> IO Observations
9492
start [] _ _ = pure (Expectations [])
95-
start (initial : rest) states changes = do
93+
start (initial : rest) states changes' = do
9694
feedInput initial states
97-
(_, observed) <- withChanges changes step (rest, states, [])
95+
(_, observed) <- withChanges changes' step (rest, states, [])
9896
pure (Expectations (reverse observed))
9997

10098
step
@@ -103,7 +101,7 @@ getObservations (Inputs inputs) = do
103101
-> IO ( Either ([(Key, Maybe SubscriptionStatus)], SubscriptionStates Key, [Map Key SubscriptionStatus])
104102
[Map Key SubscriptionStatus]
105103
)
106-
step ([], states, observed) m = pure (Right (m : observed))
104+
step ([], _, observed) m = pure (Right (m : observed))
107105
step ((input : rest), states, observed) m = do
108106
feedInput input states
109107
pure (Left (rest, states, m : observed))
@@ -114,4 +112,5 @@ getObservations (Inputs inputs) = do
114112
Just Subscribing -> subscribing states key
115113
Just Subscribed -> subscribed states key
116114

115+
spec :: SpecWith ()
117116
spec = describe "Status" $ prop "state change consistency" property

infra/test/Test/Pos/Infra/Diffusion/Subscription/SubscriptionSpec.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,18 @@ module Test.Pos.Infra.Diffusion.Subscription.SubscriptionSpec
22
( spec
33
) where
44

5+
import Prelude
6+
57
import Control.Concurrent.Async (AsyncCancelled (..), async, cancel,
68
waitCatch)
79
import Control.Concurrent.MVar (newEmptyMVar, takeMVar)
810
import Control.Exception (fromException, throwIO)
11+
import Pos.Infra.Diffusion.Subscription.Common
12+
(SubscriptionTerminationReason (..), networkSubscribeTo)
913
import System.IO.Error (userError)
1014
import Test.Hspec (Expectation, Spec, describe, expectationFailure,
1115
it, shouldBe)
1216

13-
import Pos.Infra.Diffusion.Subscription.Common
14-
(SubscriptionTerminationReason (..), networkSubscribeTo)
15-
1617
spec :: Spec
1718
spec = describe "Exception handling" $ do
1819
it "networkSubscribeTo squelches synchronous exceptions" syncExceptionSpec

infra/test/Test/Pos/Infra/Gen.hs

+18-1
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,9 @@ module Test.Pos.Infra.Gen
1515
-- Slotting Generators
1616
, genEpochSlottingData
1717
, genSlottingData
18+
19+
-- Pos.Infra.Communication Generators
20+
, genHandlerSpec
1821
) where
1922

2023
import Universum
@@ -27,13 +30,14 @@ import Network.Kademlia.HashNodeId (genNonce, hashAddress)
2730

2831
import Pos.Core (EpochIndex (..))
2932
import Pos.Crypto.Random (deterministic)
33+
import Pos.Infra.Communication.Types.Protocol (HandlerSpec (..))
3034
import Pos.Infra.Communication.Types.Relay (DataMsg (..), InvMsg (..),
3135
MempoolMsg (..), ReqMsg (..), ResMsg (..))
3236
import Pos.Infra.DHT (DHTData (..), DHTKey (..))
3337
import Pos.Infra.Slotting.Types (EpochSlottingData (..), SlottingData,
3438
createSlottingDataUnsafe)
3539

36-
import Test.Pos.Core.Gen (genTimeDiff)
40+
import Test.Pos.Core.Gen (gen32Bytes, genTimeDiff, genWord16)
3741
import Test.Pos.Util.Gen (genMillisecond)
3842

3943
----------------------------------------------------------------------------
@@ -94,3 +98,16 @@ genEpochIndexDataPairs range = do
9498
(\xs i -> (: xs) <$> genEpochIndexDataPair i)
9599
[]
96100
[0..len]
101+
102+
----------------------------------------------------------------------------
103+
-- Pos.Infra.Communication Generators
104+
----------------------------------------------------------------------------
105+
106+
genHandlerSpec :: Gen HandlerSpec
107+
genHandlerSpec = Gen.choice [ ConvHandler <$> genWord16
108+
-- 0 is reserved for ConvHandler tag.
109+
-- See HandlerSpec Bi instance.
110+
, UnknownHandler
111+
<$> Gen.word8 (Range.constant 1 255)
112+
<*> gen32Bytes
113+
]

infra/test/cardano-sl-infra-test.cabal

+8
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,17 @@ library
1919
Test.Pos.Infra.Arbitrary.Ssc
2020
Test.Pos.Infra.Arbitrary.Txp
2121
Test.Pos.Infra.Arbitrary.Update
22+
Test.Pos.Infra.Bi
23+
Test.Pos.Infra.Diffusion.Subscription.StatusSpec
24+
Test.Pos.Infra.Diffusion.Subscription.SubscriptionSpec
2225
Test.Pos.Infra.Gen
2326

2427
build-depends: QuickCheck
28+
, async
2529
, base
2630
, bytestring
31+
, cardano-sl-binary
32+
, cardano-sl-binary-test
2733
, cardano-sl-core
2834
, cardano-sl-core-test
2935
, cardano-sl-crypto
@@ -36,12 +42,14 @@ library
3642
, containers
3743
, generic-arbitrary
3844
, hedgehog
45+
, hspec
3946
, kademlia
4047
, universum
4148

4249
default-language: Haskell2010
4350

4451
ghc-options: -Wall
4552
-O2
53+
-threaded
4654

4755
default-extensions: NoImplicitPrelude
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
8200d81843193cc1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
821868d81849c3b8553dc3a8c2a709

infra/test/test.hs

+6-1
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,12 @@ import Prelude (IO)
33
import Test.Hspec (hspec)
44

55
import Spec (spec)
6+
import Test.Pos.Binary.Helpers (runTests)
7+
import qualified Test.Pos.Infra.Bi
68

79
main :: IO ()
8-
main =
10+
main = do
911
hspec spec
12+
runTests
13+
[ Test.Pos.Infra.Bi.tests
14+
]

pkgs/default.nix

+29
Original file line numberDiff line numberDiff line change
@@ -16642,13 +16642,18 @@ license = stdenv.lib.licenses.mit;
1664216642
, bytestring
1664316643
, cardano-report-server
1664416644
, cardano-sl-binary
16645+
, cardano-sl-binary-test
1664516646
, cardano-sl-core
16647+
, cardano-sl-core-test
1664616648
, cardano-sl-crypto
1664716649
, cardano-sl-crypto-test
1664816650
, cardano-sl-db
1664916651
, cardano-sl-networking
1665016652
, cardano-sl-ssc
16653+
, cardano-sl-ssc-test
16654+
, cardano-sl-update-test
1665116655
, cardano-sl-util
16656+
, cardano-sl-util-test
1665216657
, clock
1665316658
, conduit
1665416659
, containers
@@ -16662,7 +16667,9 @@ license = stdenv.lib.licenses.mit;
1666216667
, exceptions
1666316668
, filepath
1666416669
, formatting
16670+
, generic-arbitrary
1666516671
, hashable
16672+
, hedgehog
1666616673
, hspec
1666716674
, http-client
1666816675
, http-client-tls
@@ -16762,10 +16769,24 @@ cpphs
1676216769
testHaskellDepends = [
1676316770
async
1676416771
base
16772+
bytestring
16773+
cardano-sl-binary
16774+
cardano-sl-binary-test
16775+
cardano-sl-core
16776+
cardano-sl-core-test
16777+
cardano-sl-crypto
1676516778
cardano-sl-crypto-test
16779+
cardano-sl-ssc
16780+
cardano-sl-ssc-test
16781+
cardano-sl-update-test
16782+
cardano-sl-util-test
1676616783
containers
16784+
generic-arbitrary
16785+
hedgehog
1676716786
hspec
16787+
kademlia
1676816788
QuickCheck
16789+
universum
1676916790
];
1677016791
doHaddock = false;
1677116792
description = "Cardano SL - infrastructural";
@@ -16775,8 +16796,11 @@ license = stdenv.lib.licenses.mit;
1677516796
"cardano-sl-infra-test" = callPackage
1677616797
({
1677716798
mkDerivation
16799+
, async
1677816800
, base
1677916801
, bytestring
16802+
, cardano-sl-binary
16803+
, cardano-sl-binary-test
1678016804
, cardano-sl-core
1678116805
, cardano-sl-core-test
1678216806
, cardano-sl-crypto
@@ -16789,6 +16813,7 @@ license = stdenv.lib.licenses.mit;
1678916813
, containers
1679016814
, generic-arbitrary
1679116815
, hedgehog
16816+
, hspec
1679216817
, kademlia
1679316818
, QuickCheck
1679416819
, stdenv
@@ -16800,8 +16825,11 @@ pname = "cardano-sl-infra-test";
1680016825
version = "1.3.0";
1680116826
src = ./../infra/test;
1680216827
libraryHaskellDepends = [
16828+
async
1680316829
base
1680416830
bytestring
16831+
cardano-sl-binary
16832+
cardano-sl-binary-test
1680516833
cardano-sl-core
1680616834
cardano-sl-core-test
1680716835
cardano-sl-crypto
@@ -16814,6 +16842,7 @@ cardano-sl-util-test
1681416842
containers
1681516843
generic-arbitrary
1681616844
hedgehog
16845+
hspec
1681716846
kademlia
1681816847
QuickCheck
1681916848
universum

0 commit comments

Comments
 (0)