Skip to content

Commit 6b35d34

Browse files
agustinmistaagustinmista
committed
WIP implementing state-machine tests for PerasVoteDB
1 parent 2a042da commit 6b35d34

File tree

6 files changed

+476
-0
lines changed

6 files changed

+476
-0
lines changed

‎ouroboros-consensus/ouroboros-consensus.cabal‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -804,6 +804,9 @@ test-suite storage-test
804804
Test.Ouroboros.Storage.PerasCertDB
805805
Test.Ouroboros.Storage.PerasCertDB.Model
806806
Test.Ouroboros.Storage.PerasCertDB.StateMachine
807+
Test.Ouroboros.Storage.PerasVoteDB
808+
Test.Ouroboros.Storage.PerasVoteDB.Model
809+
Test.Ouroboros.Storage.PerasVoteDB.StateMachine
807810
Test.Ouroboros.Storage.VolatileDB
808811
Test.Ouroboros.Storage.VolatileDB.Mock
809812
Test.Ouroboros.Storage.VolatileDB.Model
@@ -816,6 +819,7 @@ test-suite storage-test
816819
bifunctors,
817820
bytestring,
818821
cardano-binary,
822+
cardano-crypto-class,
819823
cardano-ledger-binary:testlib,
820824
cardano-ledger-core:{cardano-ledger-core, testlib},
821825
cardano-slotting:{cardano-slotting, testlib},

‎ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ import qualified Test.Ouroboros.Storage.ChainDB as ChainDB
66
import qualified Test.Ouroboros.Storage.ImmutableDB as ImmutableDB
77
import qualified Test.Ouroboros.Storage.LedgerDB as LedgerDB
88
import qualified Test.Ouroboros.Storage.PerasCertDB as PerasCertDB
9+
import qualified Test.Ouroboros.Storage.PerasVoteDB as PerasVoteDB
910
import qualified Test.Ouroboros.Storage.VolatileDB as VolatileDB
1011
import Test.Tasty (TestTree, testGroup)
1112

@@ -22,4 +23,5 @@ tests =
2223
, LedgerDB.tests
2324
, ChainDB.tests
2425
, PerasCertDB.tests
26+
, PerasVoteDB.tests
2527
]

‎ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/Orphans.hs‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE FlexibleInstances #-}
12
{-# LANGUAGE StandaloneDeriving #-}
23
{-# OPTIONS_GHC -Wno-orphans #-}
34

@@ -19,6 +20,7 @@ import Ouroboros.Consensus.Util.CallStack
1920
import System.FS.API.Types (FsError, sameFsError)
2021
import Test.QuickCheck.StateModel (HasVariables)
2122
import Test.QuickCheck.StateModel.Variables (HasVariables (..))
23+
import Cardano.Crypto.Hash.Class (PackedBytes)
2224

2325
{-------------------------------------------------------------------------------
2426
PrettyCallStack
@@ -76,3 +78,17 @@ deriving instance StandardHash blk => Eq (ChainDbError blk)
7678

7779
instance HasVariables NominalDiffTime where
7880
getAllVariables _ = mempty
81+
82+
{-------------------------------------------------------------------------------
83+
Rational
84+
-------------------------------------------------------------------------------}
85+
86+
instance HasVariables Rational where
87+
getAllVariables _ = mempty
88+
89+
{-------------------------------------------------------------------------------
90+
PackedBytes
91+
-------------------------------------------------------------------------------}
92+
93+
instance HasVariables (PackedBytes a) where
94+
getAllVariables _ = mempty

‎ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasVoteDB.hs‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
module Test.Ouroboros.Storage.PerasVoteDB (tests) where
2+
3+
import qualified Test.Ouroboros.Storage.PerasVoteDB.StateMachine as StateMachine
4+
import Test.Tasty (TestTree, testGroup)
5+
6+
--
7+
-- The list of all PerasVoteDB tests
8+
--
9+
10+
tests :: TestTree
11+
tests =
12+
testGroup
13+
"PerasVoteDB"
14+
[ StateMachine.tests
15+
]

‎ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasVoteDB/Model.hs‎

Lines changed: 169 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,169 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
3+
module Test.Ouroboros.Storage.PerasVoteDB.Model
4+
( Model (..)
5+
, initModel
6+
, openDB
7+
, closeDB
8+
, addVote
9+
, getVoteSnapshot
10+
, getForgedCertForRound
11+
, garbageCollect
12+
) where
13+
14+
import Data.Map.Strict (Map)
15+
import qualified Data.Map.Strict as Map
16+
import Data.Set (Set)
17+
import qualified Data.Set as Set
18+
import GHC.Generics (Generic)
19+
import Ouroboros.Consensus.Block.Abstract (Point, StandardHash)
20+
import Ouroboros.Consensus.Block.SupportsPeras
21+
( HasPerasVoteBlock (..)
22+
, HasPerasVoteRound (..)
23+
, PerasCert (..)
24+
, PerasCfg
25+
, PerasParams (..)
26+
, PerasQuorumStakeThreshold (unPerasQuorumStakeThreshold)
27+
, PerasRoundNo
28+
, PerasVoteStake (..)
29+
, ValidatedPerasCert (..)
30+
, ValidatedPerasVote
31+
, getPerasVoteStake
32+
)
33+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
34+
( WithArrivalTime (..)
35+
)
36+
import Ouroboros.Consensus.Storage.PerasVoteDB.API
37+
( AddPerasVoteResult (..)
38+
, PerasVoteSnapshot
39+
)
40+
41+
data Model blk = Model
42+
{ votes ::
43+
Map
44+
(PerasRoundNo, Point blk)
45+
(Set (WithArrivalTime (ValidatedPerasVote blk)))
46+
, certs ::
47+
Map
48+
PerasRoundNo
49+
(ValidatedPerasCert blk)
50+
, params :: PerasParams
51+
, open :: Bool
52+
}
53+
deriving (Show, Generic)
54+
55+
initModel :: PerasCfg blk -> Model blk
56+
initModel cfg =
57+
Model
58+
{ open = False
59+
, votes = Map.empty
60+
, certs = Map.empty
61+
, params = cfg
62+
}
63+
64+
openDB ::
65+
Model blk ->
66+
Model blk
67+
openDB model =
68+
model
69+
{ open = True
70+
}
71+
72+
closeDB ::
73+
Model blk ->
74+
Model blk
75+
closeDB model =
76+
model
77+
{ open = False
78+
, votes = Map.empty
79+
, certs = Map.empty
80+
}
81+
82+
addVote ::
83+
StandardHash blk =>
84+
WithArrivalTime (ValidatedPerasVote blk) ->
85+
Model blk ->
86+
( Maybe (AddPerasVoteResult blk)
87+
, Model blk
88+
)
89+
addVote vote model = maybeResultAndNewModel
90+
where
91+
roundNo =
92+
getPerasVoteRound vote
93+
votedBlock =
94+
getPerasVoteBlock vote
95+
existingVotes =
96+
Map.findWithDefault Set.empty (roundNo, votedBlock) (votes model)
97+
extendedVotes =
98+
Set.insert vote existingVotes
99+
quorumStakeThreshold =
100+
unPerasQuorumStakeThreshold . perasQuorumStakeThreshold . params
101+
getVoteStake =
102+
unPerasVoteStake . getPerasVoteStake . forgetArrivalTime
103+
reachedQuorum =
104+
sum (getVoteStake <$> Set.toList extendedVotes)
105+
>= quorumStakeThreshold model
106+
result
107+
| Set.member vote existingVotes =
108+
PerasVoteAlreadyInDB
109+
| reachedQuorum =
110+
let cert =
111+
ValidatedPerasCert
112+
{ vpcCert =
113+
PerasCert
114+
{ pcCertRound = getPerasVoteRound vote
115+
, pcCertBoostedBlock = getPerasVoteBlock vote
116+
}
117+
, vpcCertBoost = perasWeight (params model)
118+
}
119+
in AddedPerasVoteAndGeneratedNewCert cert
120+
| otherwise =
121+
AddedPerasVoteButDidntGenerateNewCert
122+
maybeResultAndNewModel =
123+
case result of
124+
PerasVoteAlreadyInDB ->
125+
( Just result
126+
, model
127+
)
128+
AddedPerasVoteAndGeneratedNewCert cert
129+
| Just cert' <- Map.lookup roundNo (certs model)
130+
, cert' /= cert ->
131+
( Nothing -- 'EquivocatingCertError'
132+
, model
133+
)
134+
| otherwise ->
135+
( Just result
136+
, model
137+
{ certs =
138+
Map.insert roundNo cert (certs model)
139+
, votes =
140+
Map.insert (roundNo, votedBlock) extendedVotes (votes model)
141+
}
142+
)
143+
AddedPerasVoteButDidntGenerateNewCert ->
144+
( Just result
145+
, model
146+
{ votes =
147+
Map.insert (roundNo, votedBlock) extendedVotes (votes model)
148+
}
149+
)
150+
151+
getVoteSnapshot ::
152+
Model blk ->
153+
PerasVoteSnapshot blk
154+
getVoteSnapshot _model =
155+
error "Not implemented"
156+
157+
getForgedCertForRound ::
158+
PerasRoundNo ->
159+
Model blk ->
160+
Maybe (ValidatedPerasCert blk)
161+
getForgedCertForRound roundNo model =
162+
Map.lookup roundNo (certs model)
163+
164+
garbageCollect ::
165+
PerasRoundNo ->
166+
Model blk ->
167+
Model blk
168+
garbageCollect _roundNo _model =
169+
error "Not implemented"

0 commit comments

Comments
 (0)