This repository has been archived by the owner on Feb 9, 2021. It is now read-only.
/
Gen.hs
142 lines (123 loc) · 4.32 KB
/
Gen.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.Cardano.Chain.Slotting.Gen
( genEpochIndex
, genEpochSlottingData
, genSlottingDataCustom
, genSlottingDataTooFewIndicies
, genSlottingDataInvalidIndicies
, genFlatSlotId
, genLocalSlotIndex
, genSlotCount
, genSlotId
, genSlottingData
, feedPMEpochSlots
)
where
import Cardano.Prelude
import Test.Cardano.Prelude
import qualified Data.Map.Strict as Map
import Formatting (build, sformat)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Cardano.Chain.Slotting
( EpochIndex(..)
, EpochSlottingData(..)
, FlatSlotId
, LocalSlotIndex
, SlotCount(..)
, SlotId(..)
, SlottingData
, getSlotIndex
, localSlotIndexMaxBound
, localSlotIndexMinBound
, mkLocalSlotIndex
, mkSlottingData
, unsafeSlottingData
)
import Cardano.Crypto (ProtocolMagicId)
import Test.Cardano.Crypto.Gen (genProtocolMagicId)
genEpochIndex :: Gen EpochIndex
genEpochIndex = EpochIndex <$> Gen.word64 Range.constantBounded
genEpochSlottingData :: Gen EpochSlottingData
genEpochSlottingData =
EpochSlottingData <$> genNominalDiffTime <*> genNominalDiffTime
genFlatSlotId :: Gen FlatSlotId
genFlatSlotId = Gen.word64 Range.constantBounded
genLocalSlotIndex :: SlotCount -> Gen LocalSlotIndex
genLocalSlotIndex epochSlots = mkLocalSlotIndex'
<$> Gen.word16 (Range.constant lb ub)
where
lb = getSlotIndex localSlotIndexMinBound
ub = getSlotIndex (localSlotIndexMaxBound epochSlots)
mkLocalSlotIndex' slot = case mkLocalSlotIndex epochSlots slot of
Left err -> panic $ sformat
("The impossible happened in genLocalSlotIndex: " . build)
err
Right lsi -> lsi
genSlotCount :: Gen SlotCount
genSlotCount = SlotCount <$> Gen.word64 (Range.constantFrom 1 1 maxBound)
genSlotId :: SlotCount -> Gen SlotId
genSlotId epochSlots =
SlotId <$> genEpochIndex <*> genLocalSlotIndex epochSlots
genSlottingData :: Gen SlottingData
genSlottingData = mkSlottingData <$> genSlottingDataMap >>= \case
Left err ->
panic $ sformat ("The impossible happened in genSlottingData: " . build) err
Right slottingData -> pure slottingData
where
genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData)
genSlottingDataMap = do
mapSize <- Gen.int $ Range.linear 2 10
epochSlottingDatas <- Gen.list
(Range.singleton mapSize)
genEpochSlottingData
pure $ Map.fromList $ zip
[0 .. fromIntegral mapSize - 1]
epochSlottingDatas
genSlottingDataCustom :: Int -> Int -> Gen SlottingData
genSlottingDataCustom lowerMb upperMb = mkSlottingData <$> genSlottingDataMap >>= \case
Left err ->
panic $ sformat ("The impossible happened in genSlottingData: " . build) err
Right slottingData -> pure slottingData
where
genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData)
genSlottingDataMap = do
mapSize <- Gen.int $ Range.linear lowerMb upperMb
epochSlottingDatas <- Gen.list
(Range.singleton mapSize)
genEpochSlottingData
pure $ Map.fromList $ zip
[0 .. fromIntegral mapSize - 1]
epochSlottingDatas
genSlottingDataTooFewIndicies :: Gen SlottingData
genSlottingDataTooFewIndicies = unsafeSlottingData <$> genSlottingDataMap
where
genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData)
genSlottingDataMap = do
mapSize <- Gen.int $ Range.linear 0 1
epochSlottingDatas <- Gen.list
(Range.singleton mapSize)
genEpochSlottingData
pure $ Map.fromList $ zip
[0 .. fromIntegral mapSize - 1]
epochSlottingDatas
genSlottingDataInvalidIndicies :: Gen SlottingData
genSlottingDataInvalidIndicies = unsafeSlottingData <$> genSlottingDataMap
where
genSlottingDataMap :: Gen (Map EpochIndex EpochSlottingData)
genSlottingDataMap = do
mapSize <- Gen.int $ Range.singleton 10
rList <- Gen.filter (\x -> x /= sort x) $ Gen.list (Range.singleton mapSize) (Gen.word64 (Range.linear 0 (fromIntegral mapSize - 1)))
epochSlottingDatas <- Gen.list
(Range.singleton mapSize)
genEpochSlottingData
pure $ Map.fromAscList $ zip
(map EpochIndex rList)
epochSlottingDatas
feedPMEpochSlots :: (ProtocolMagicId -> SlotCount -> Gen a) -> Gen a
feedPMEpochSlots genA = do
pm <- genProtocolMagicId
epochSlots <- SlotCount . fromIntegral <$> Gen.word16 Range.constantBounded
genA pm epochSlots