Skip to content

Commit 8dd729b

Browse files
sgillespiekderme
authored andcommitted
test(cardano-db-sync): Extract Hedgehog generators into new module
1 parent 33bc1b1 commit 8dd729b

File tree

3 files changed

+198
-66
lines changed

3 files changed

+198
-66
lines changed

cardano-db-sync/cardano-db-sync.cabal

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -339,6 +339,7 @@ test-suite test
339339
other-modules: Cardano.DbSync.Config.TypesTest
340340
Cardano.DbSync.Era.Shelley.Generic.ScriptDataTest
341341
Cardano.DbSync.Era.Shelley.Generic.ScriptTest
342+
Cardano.DbSync.Gen
342343
Cardano.DbSync.Util.AddressTest
343344
Cardano.DbSync.Util.Bech32Test
344345
Cardano.DbSync.Util.CborTest
@@ -350,11 +351,15 @@ test-suite test
350351
, cardano-binary
351352
, cardano-crypto-class
352353
, cardano-crypto-praos
354+
, cardano-crypto-wrapper
355+
, cardano-db
356+
, iohk-monitoring
353357
, cardano-ledger-api
354358
, cardano-ledger-binary
355359
, cardano-ledger-core:testlib
356360
, cardano-ledger-allegra:{cardano-ledger-allegra,testlib}
357361
, cardano-ledger-alonzo:{testlib}
362+
, cardano-ledger-byron
358363
, cardano-ledger-shelley:{cardano-ledger-shelley,testlib}
359364
, cardano-db-sync
360365
, cardano-ledger-core
@@ -364,4 +369,5 @@ test-suite test
364369
, data-default-class
365370
, hedgehog
366371
, hedgehog-quickcheck
372+
, ouroboros-consensus-cardano
367373
, text

cardano-db-sync/test/Cardano/DbSync/Config/TypesTest.hs

Lines changed: 8 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,13 @@
44
module Cardano.DbSync.Config.TypesTest (tests) where
55

66
import Cardano.DbSync.Config.Types
7+
import qualified Cardano.DbSync.Gen as Gen
78
import Cardano.Prelude
89
import qualified Data.Aeson as Aeson
910
import Data.Aeson.QQ.Simple (aesonQQ)
10-
import Data.ByteString.Short (ShortByteString (), toShort)
1111
import Data.Default.Class (Default (..))
1212
import Hedgehog
1313
import qualified Hedgehog.Gen as Gen
14-
import qualified Hedgehog.Range as Range
1514
import Prelude ()
1615

1716
tests :: IO Bool
@@ -37,115 +36,58 @@ prop_syncInsertConfigFromJSON = property $ do
3736

3837
prop_syncInsertConfigRoundtrip :: Property
3938
prop_syncInsertConfigRoundtrip = property $ do
40-
cfg <- forAll genSyncInsertConfig
39+
cfg <- forAll Gen.syncInsertConfig
4140

4241
tripping cfg Aeson.encode Aeson.decode
4342

4443
prop_isTxEnabled :: Property
4544
prop_isTxEnabled = property $ do
46-
cfg <- forAll genSyncInsertConfig
45+
cfg <- forAll Gen.syncInsertConfig
4746
let txOutCfg = spcTxOut cfg
4847

4948
-- TxOut is enabled if it is not TxOutDisable
5049
isTxOutEnabled txOutCfg === (txOutCfg /= TxOutDisable)
5150

5251
prop_isLedgerEnabled :: Property
5352
prop_isLedgerEnabled = property $ do
54-
cfg <- forAll genSyncInsertConfig
53+
cfg <- forAll Gen.syncInsertConfig
5554
let ledgerCfg = spcLedger cfg
5655

5756
-- Ledger is enabled if it is not LedgerDisable
5857
isLedgerEnabled ledgerCfg === (ledgerCfg /= LedgerDisable)
5958

6059
prop_isShelleyEnabled :: Property
6160
prop_isShelleyEnabled = property $ do
62-
cfg <- forAll genSyncInsertConfig
61+
cfg <- forAll Gen.syncInsertConfig
6362
let shelleyCfg = spcShelley cfg
6463

6564
-- Shelley is enabled if it is not ShelleyDisable
6665
isShelleyEnabled shelleyCfg === (shelleyCfg /= ShelleyDisable)
6766

6867
prop_isMultiAssetEnabled :: Property
6968
prop_isMultiAssetEnabled = property $ do
70-
cfg <- forAll genSyncInsertConfig
69+
cfg <- forAll Gen.syncInsertConfig
7170
let multiAssetCfg = spcMultiAsset cfg
7271

7372
-- MultiAsset is enabled if it is not MultiAssetDisable
7473
isMultiAssetEnabled multiAssetCfg === (multiAssetCfg /= MultiAssetDisable)
7574

7675
prop_isMetadataEnabled :: Property
7776
prop_isMetadataEnabled = property $ do
78-
cfg <- forAll genSyncInsertConfig
77+
cfg <- forAll Gen.syncInsertConfig
7978
let metadataCfg = spcMetadata cfg
8079

8180
-- Metadata is enabled if it is not MetadataDisable
8281
isMetadataEnabled metadataCfg === (metadataCfg /= MetadataDisable)
8382

8483
prop_isPlutusEnabled :: Property
8584
prop_isPlutusEnabled = property $ do
86-
cfg <- forAll genSyncInsertConfig
85+
cfg <- forAll Gen.syncInsertConfig
8786
let plutusCfg = spcPlutus cfg
8887

8988
-- Plutus is enabled if it is not PlutusDisable
9089
isPlutusEnabled plutusCfg === (plutusCfg /= PlutusDisable)
9190

92-
genSyncInsertConfig :: Gen SyncInsertConfig
93-
genSyncInsertConfig =
94-
SyncInsertConfig
95-
<$> Gen.element [TxOutEnable, TxOutDisable, TxOutConsumed, TxOutPrune, TxOutBootstrap]
96-
<*> Gen.element [LedgerEnable, LedgerDisable, LedgerIgnore]
97-
<*> genShelleyConfig
98-
<*> genMultiAssetConfig
99-
<*> genMetadataConfig
100-
<*> genPlutusConfig
101-
<*> (GovernanceConfig <$> Gen.bool)
102-
<*> (OffchainPoolDataConfig <$> Gen.bool)
103-
<*> Gen.element [JsonTypeText, JsonTypeJsonb, JsonTypeDisable]
104-
105-
genShelleyConfig :: Gen ShelleyInsertConfig
106-
genShelleyConfig = do
107-
Gen.choice
108-
[ pure ShelleyEnable
109-
, pure ShelleyDisable
110-
, ShelleyStakeAddrs <$> Gen.nonEmpty (Range.linear 1 5) genAddr
111-
]
112-
113-
genMultiAssetConfig :: Gen MultiAssetConfig
114-
genMultiAssetConfig =
115-
Gen.choice
116-
[ pure MultiAssetEnable
117-
, pure MultiAssetDisable
118-
, MultiAssetPolicies <$> Gen.nonEmpty (Range.linear 1 5) genPolicy
119-
]
120-
121-
genMetadataConfig :: Gen MetadataConfig
122-
genMetadataConfig =
123-
Gen.choice
124-
[ pure MetadataEnable
125-
, pure MetadataDisable
126-
, MetadataKeys <$> Gen.nonEmpty (Range.linear 1 5) genKey
127-
]
128-
129-
genPlutusConfig :: Gen PlutusConfig
130-
genPlutusConfig =
131-
Gen.choice
132-
[ pure PlutusEnable
133-
, pure PlutusDisable
134-
, PlutusScripts <$> Gen.nonEmpty (Range.linear 1 5) genScriptHash
135-
]
136-
137-
genAddr :: Gen ShortByteString
138-
genAddr = toShort <$> Gen.utf8 (Range.linear 1 5) Gen.unicode
139-
140-
genPolicy :: Gen ShortByteString
141-
genPolicy = toShort <$> Gen.utf8 (Range.linear 1 5) Gen.unicode
142-
143-
genKey :: Gen Word
144-
genKey = Gen.word (Range.linear minBound maxBound)
145-
146-
genScriptHash :: Gen ShortByteString
147-
genScriptHash = toShort <$> Gen.utf8 (Range.linear 1 5) Gen.unicode
148-
14991
-- | Various JSON values that should generate the default config
15092
genDefaultJson :: Gen Aeson.Value
15193
genDefaultJson =
Lines changed: 184 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,184 @@
1+
{-# LANGUAGE TypeApplications #-}
2+
{-# LANGUAGE NoImplicitPrelude #-}
3+
4+
module Cardano.DbSync.Gen (
5+
-- * Config/Api Type generators
6+
syncNodeParams,
7+
syncNodeConfig,
8+
syncInsertConfig,
9+
shelleyConfig,
10+
multiAssetConfig,
11+
metadataConfig,
12+
plutusConfig,
13+
multiAssetPolicy,
14+
metadataKey,
15+
scriptHash,
16+
addr,
17+
18+
-- * Utility generators
19+
hashBlake2b_256,
20+
filePath,
21+
protocolVersion,
22+
triggerHardFork,
23+
) where
24+
25+
import qualified Cardano.BM.Configuration.Model as Logging
26+
import Cardano.Chain.Update (ProtocolVersion (..))
27+
import Cardano.Crypto (RequiresNetworkMagic (..))
28+
import Cardano.Crypto.Hash (Blake2b_256 (), Hash ())
29+
import Cardano.Crypto.Hash.Class (HashAlgorithm (..), hashFromBytes)
30+
import Cardano.Db (PGPassSource (..))
31+
import Cardano.DbSync
32+
import Cardano.DbSync.Config.Types
33+
import Cardano.Ledger.Slot (EpochNo (..))
34+
import Cardano.Prelude
35+
import Data.ByteString.Short (ShortByteString (), toShort)
36+
import Data.Maybe (fromJust)
37+
import Hedgehog
38+
import qualified Hedgehog.Gen as Gen
39+
import qualified Hedgehog.Range as Range
40+
import Ouroboros.Consensus.Cardano.CanHardFork (TriggerHardFork (..))
41+
42+
syncNodeParams :: MonadGen m => m SyncNodeParams
43+
syncNodeParams =
44+
SyncNodeParams
45+
<$> (ConfigFile <$> filePath)
46+
<*> (SocketPath <$> filePath)
47+
<*> Gen.maybe (LedgerStateDir <$> filePath)
48+
<*> (MigrationDir <$> filePath)
49+
<*> Gen.constant PGPassDefaultEnv
50+
<*> Gen.bool
51+
<*> Gen.bool
52+
<*> Gen.bool
53+
<*> Gen.bool
54+
<*> Gen.bool
55+
<*> Gen.bool
56+
<*> Gen.bool
57+
<*> Gen.bool
58+
<*> Gen.bool
59+
<*> Gen.bool
60+
<*> Gen.bool
61+
<*> Gen.list (Range.linear 0 10) (Gen.word64 (Range.linear minBound maxBound))
62+
<*> Gen.bool
63+
<*> Gen.bool
64+
<*> Gen.bool
65+
<*> Gen.bool
66+
<*> Gen.bool
67+
<*> Gen.bool
68+
<*> Gen.bool
69+
<*> Gen.bool
70+
<*> Gen.bool
71+
<*> Gen.bool
72+
<*> Gen.bool
73+
<*> Gen.word64 (Range.linear 0 1000)
74+
<*> Gen.word64 (Range.linear 0 1000)
75+
<*> pure Nothing
76+
77+
syncNodeConfig :: Logging.Configuration -> Gen SyncNodeConfig
78+
syncNodeConfig loggingCfg =
79+
SyncNodeConfig
80+
<$> (NetworkName <$> Gen.text (Range.linear 0 100) Gen.alpha)
81+
<*> pure loggingCfg
82+
<*> (NodeConfigFile <$> filePath)
83+
<*> Gen.constant SyncProtocolCardano
84+
<*> Gen.element [RequiresNoMagic, RequiresMagic]
85+
<*> Gen.bool
86+
<*> Gen.bool
87+
<*> Gen.int (Range.linear 0 10000)
88+
<*> Gen.maybe (Gen.double (Range.linearFrac 0 1))
89+
<*> (GenesisFile <$> filePath)
90+
<*> (GenesisHashByron <$> Gen.text (Range.linear 0 100) Gen.alphaNum)
91+
<*> (GenesisFile <$> filePath)
92+
<*> (GenesisHashShelley . fromJust <$> hashBlake2b_256)
93+
<*> (GenesisFile <$> filePath)
94+
<*> (GenesisHashAlonzo . fromJust <$> hashBlake2b_256)
95+
<*> Gen.maybe (GenesisFile <$> filePath)
96+
<*> Gen.maybe (GenesisHashConway . fromJust <$> hashBlake2b_256)
97+
<*> protocolVersion
98+
<*> triggerHardFork
99+
<*> triggerHardFork
100+
<*> triggerHardFork
101+
<*> triggerHardFork
102+
<*> triggerHardFork
103+
<*> triggerHardFork
104+
<*> syncInsertConfig
105+
106+
syncInsertConfig :: Gen SyncInsertConfig
107+
syncInsertConfig =
108+
SyncInsertConfig
109+
<$> Gen.element [TxOutEnable, TxOutDisable, TxOutConsumed, TxOutPrune, TxOutBootstrap]
110+
<*> Gen.element [LedgerEnable, LedgerDisable, LedgerIgnore]
111+
<*> shelleyConfig
112+
<*> multiAssetConfig
113+
<*> metadataConfig
114+
<*> plutusConfig
115+
<*> (GovernanceConfig <$> Gen.bool)
116+
<*> (OffchainPoolDataConfig <$> Gen.bool)
117+
<*> Gen.element [JsonTypeText, JsonTypeJsonb, JsonTypeDisable]
118+
119+
shelleyConfig :: Gen ShelleyInsertConfig
120+
shelleyConfig = do
121+
Gen.choice
122+
[ pure ShelleyEnable
123+
, pure ShelleyDisable
124+
, ShelleyStakeAddrs <$> Gen.nonEmpty (Range.linear 1 5) addr
125+
]
126+
127+
multiAssetConfig :: Gen MultiAssetConfig
128+
multiAssetConfig =
129+
Gen.choice
130+
[ pure MultiAssetEnable
131+
, pure MultiAssetDisable
132+
, MultiAssetPolicies <$> Gen.nonEmpty (Range.linear 1 5) multiAssetPolicy
133+
]
134+
135+
metadataConfig :: Gen MetadataConfig
136+
metadataConfig =
137+
Gen.choice
138+
[ pure MetadataEnable
139+
, pure MetadataDisable
140+
, MetadataKeys <$> Gen.nonEmpty (Range.linear 1 5) metadataKey
141+
]
142+
143+
plutusConfig :: Gen PlutusConfig
144+
plutusConfig =
145+
Gen.choice
146+
[ pure PlutusEnable
147+
, pure PlutusDisable
148+
, PlutusScripts <$> Gen.nonEmpty (Range.linear 1 5) scriptHash
149+
]
150+
151+
addr :: Gen ShortByteString
152+
addr = toShort <$> Gen.utf8 (Range.linear 1 5) Gen.unicode
153+
154+
multiAssetPolicy :: Gen ShortByteString
155+
multiAssetPolicy = toShort <$> Gen.utf8 (Range.linear 1 5) Gen.unicode
156+
157+
metadataKey :: Gen Word
158+
metadataKey = Gen.word (Range.linear minBound maxBound)
159+
160+
scriptHash :: Gen ShortByteString
161+
scriptHash = toShort <$> Gen.utf8 (Range.linear 1 5) Gen.unicode
162+
163+
hashBlake2b_256 :: MonadGen m => m (Maybe (Hash Blake2b_256 ByteString))
164+
hashBlake2b_256 = serialiseHash <$> Gen.bytes (Range.linear 0 100)
165+
where
166+
serialiseHash :: ByteString -> Maybe (Hash Blake2b_256 ByteString)
167+
serialiseHash = hashFromBytes . digest (Proxy @Blake2b_256)
168+
169+
filePath :: MonadGen m => m FilePath
170+
filePath = Gen.string (Range.linear 0 100) Gen.unicode
171+
172+
protocolVersion :: MonadGen m => m ProtocolVersion
173+
protocolVersion = ProtocolVersion <$> word16 <*> word16 <*> word8
174+
where
175+
word16 = Gen.word16 (Range.linear minBound maxBound)
176+
word8 = Gen.word8 (Range.linear minBound maxBound)
177+
178+
triggerHardFork :: MonadGen m => m TriggerHardFork
179+
triggerHardFork =
180+
Gen.choice
181+
[ Gen.constant TriggerHardForkNotDuringThisExecution
182+
, TriggerHardForkAtEpoch . EpochNo <$> Gen.word64 (Range.linear minBound maxBound)
183+
, TriggerHardForkAtVersion <$> Gen.word16 (Range.linear minBound maxBound)
184+
]

0 commit comments

Comments
 (0)