Skip to content

Commit 5c5be99

Browse files
tbagrel1tbagrel1
committed
Add basic types and definitions for votes
1 parent c009de8 commit 5c5be99

File tree

8 files changed

+255
-0
lines changed

8 files changed

+255
-0
lines changed

‎ouroboros-consensus/ouroboros-consensus.cabal‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -195,8 +195,10 @@ library
195195
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
196196
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
197197
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasCert
198+
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasVote
198199
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
199200
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert
201+
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasVote
200202
Ouroboros.Consensus.MiniProtocol.Util
201203
Ouroboros.Consensus.MiniProtocol.Util.Idling
202204
Ouroboros.Consensus.Node.GsmState
@@ -275,6 +277,9 @@ library
275277
Ouroboros.Consensus.Storage.PerasCertDB
276278
Ouroboros.Consensus.Storage.PerasCertDB.API
277279
Ouroboros.Consensus.Storage.PerasCertDB.Impl
280+
Ouroboros.Consensus.Storage.PerasVoteDB
281+
Ouroboros.Consensus.Storage.PerasVoteDB.API
282+
Ouroboros.Consensus.Storage.PerasVoteDB.Impl
278283
Ouroboros.Consensus.Storage.Serialisation
279284
Ouroboros.Consensus.Storage.VolatileDB
280285
Ouroboros.Consensus.Storage.VolatileDB.API

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs‎

Lines changed: 96 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE DeriveAnyClass #-}
23
{-# LANGUAGE DeriveGeneric #-}
34
{-# LANGUAGE DerivingVia #-}
@@ -7,32 +8,43 @@
78
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
89
{-# LANGUAGE NamedFieldPuns #-}
910
{-# LANGUAGE ScopedTypeVariables #-}
11+
{-# LANGUAGE StandaloneDeriving #-}
1012
{-# LANGUAGE TypeApplications #-}
1113
{-# LANGUAGE TypeFamilies #-}
1214
{-# LANGUAGE UndecidableInstances #-}
15+
{-# OPTIONS_GHC -Wno-orphans #-}
1316

1417
module Ouroboros.Consensus.Block.SupportsPeras
1518
( PerasRoundNo (..)
1619
, onPerasRoundNo
1720
, PerasWeight (..)
1821
, BlockSupportsPeras (..)
1922
, PerasCert (..)
23+
, PerasVote (..)
2024
, PerasCfg (..)
2125
, ValidatedPerasCert (..)
26+
, ValidatedPerasVote (..)
2227
, makePerasCfg
2328
, HasPerasCertRound (..)
2429
, HasPerasCertBoostedBlock (..)
2530
, HasPerasCertBoost (..)
31+
, HasPerasVoteRound (..)
32+
, HasPerasVoteVotedBlock (..)
33+
, HasStakePoolId (..)
2634

2735
-- * Ouroboros Peras round length
2836
, PerasRoundLength (..)
2937
, defaultPerasRoundLength
3038
) where
3139

40+
import qualified Cardano.Binary as KeyHash
41+
import Cardano.Ledger.Core (KeyHash, KeyRole (StakePool))
42+
import Cardano.Ledger.State (IndividualPoolStake (..), PoolDistr (PoolDistr, unPoolDistr))
3243
import Codec.Serialise (Serialise (..))
3344
import Codec.Serialise.Decoding (decodeListLenOf)
3445
import Codec.Serialise.Encoding (encodeListLen)
3546
import Data.Coerce (coerce)
47+
import qualified Data.Map as Map
3648
import Data.Monoid (Sum (..))
3749
import Data.Proxy (Proxy (..))
3850
import Data.Word (Word64)
@@ -49,6 +61,9 @@ newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64}
4961
deriving stock Generic
5062
deriving newtype (Enum, Eq, Ord, Num, Bounded, NoThunks, Serialise)
5163

64+
-- | TODO: what is the proper underlying type?
65+
type StakePoolId = KeyHash 'StakePool
66+
5267
instance Condense PerasRoundNo where
5368
condense = show . unPerasRoundNo
5469

@@ -83,6 +98,15 @@ data ValidatedPerasCert blk = ValidatedPerasCert
8398
deriving stock (Show, Eq, Ord, Generic)
8499
deriving anyclass NoThunks
85100

101+
deriving instance Ord IndividualPoolStake
102+
103+
data ValidatedPerasVote blk = ValidatedPerasVote
104+
{ vpvVote :: !(PerasVote blk)
105+
, vpvVoteStake :: !IndividualPoolStake
106+
}
107+
deriving stock (Show, Eq, Ord, Generic)
108+
deriving anyclass NoThunks
109+
86110
{-------------------------------------------------------------------------------
87111
Ouroboros Peras round length
88112
-------------------------------------------------------------------------------}
@@ -108,13 +132,21 @@ class
108132

109133
data PerasCert blk
110134

135+
data PerasVote blk
136+
111137
data PerasValidationErr blk
112138

113139
validatePerasCert ::
114140
PerasCfg blk ->
115141
PerasCert blk ->
116142
Either (PerasValidationErr blk) (ValidatedPerasCert blk)
117143

144+
validatePerasVote ::
145+
PerasCfg blk ->
146+
PerasVote blk ->
147+
PoolDistr ->
148+
Either (PerasValidationErr blk) (ValidatedPerasVote blk)
149+
118150
-- TODO: degenerate instance for all blks to get things to compile
119151
-- see https://github.com/tweag/cardano-peras/issues/73
120152
instance StandardHash blk => BlockSupportsPeras blk where
@@ -133,6 +165,14 @@ instance StandardHash blk => BlockSupportsPeras blk where
133165
deriving stock (Generic, Eq, Ord, Show)
134166
deriving anyclass NoThunks
135167

168+
data PerasVote blk = PerasVote
169+
{ pvVoteRound :: PerasRoundNo
170+
, pvVotedBlock :: Point blk
171+
, pvVoteStakePoolId :: StakePoolId
172+
}
173+
deriving stock (Generic, Eq, Ord, Show)
174+
deriving anyclass NoThunks
175+
136176
-- TODO: enrich with actual error types
137177
-- see https://github.com/tweag/cardano-peras/issues/120
138178
data PerasValidationErr blk
@@ -149,9 +189,16 @@ instance StandardHash blk => BlockSupportsPeras blk where
149189
, vpcCertBoost = perasCfgWeightBoost cfg
150190
}
151191

192+
validatePerasVote _cfg vote PoolDistr{unPoolDistr} =
193+
let stake = unPoolDistr Map.! (pvVoteStakePoolId vote)
194+
in Right (ValidatedPerasVote{vpvVote = vote, vpvVoteStake = stake})
195+
152196
instance ShowProxy blk => ShowProxy (PerasCert blk) where
153197
showProxy _ = "PerasCert " <> showProxy (Proxy @blk)
154198

199+
instance ShowProxy blk => ShowProxy (PerasVote blk) where
200+
showProxy _ = "PerasVote " <> showProxy (Proxy @blk)
201+
155202
instance Serialise (HeaderHash blk) => Serialise (PerasCert blk) where
156203
encode PerasCert{pcCertRound, pcCertBoostedBlock} =
157204
encodeListLen 2
@@ -163,6 +210,19 @@ instance Serialise (HeaderHash blk) => Serialise (PerasCert blk) where
163210
pcCertBoostedBlock <- decode
164211
pure $ PerasCert{pcCertRound, pcCertBoostedBlock}
165212

213+
instance Serialise (HeaderHash blk) => Serialise (PerasVote blk) where
214+
encode PerasVote{pvVoteRound, pvVotedBlock, pvVoteStakePoolId} =
215+
encodeListLen 3
216+
<> encode pvVoteRound
217+
<> encode pvVotedBlock
218+
<> KeyHash.toCBOR pvVoteStakePoolId
219+
decode = do
220+
decodeListLenOf 3
221+
pvVoteRound <- decode
222+
pvVotedBlock <- decode
223+
pvVoteStakePoolId <- KeyHash.fromCBOR
224+
pure $ PerasVote{pvVoteRound, pvVotedBlock, pvVoteStakePoolId}
225+
166226
-- | Derive a 'PerasCfg' from a 'BlockConfig'
167227
--
168228
-- TODO: this currently doesn't depend on 'BlockConfig' at all, but likely will
@@ -218,3 +278,39 @@ instance
218278
HasPerasCertBoost (WithArrivalTime cert)
219279
where
220280
getPerasCertBoost = getPerasCertBoost . forgetArrivalTime
281+
282+
class HasPerasVoteRound vote where
283+
getPerasVoteRound :: vote -> PerasRoundNo
284+
instance HasPerasVoteRound (PerasVote blk) where
285+
getPerasVoteRound = pvVoteRound
286+
instance HasPerasVoteRound (ValidatedPerasVote blk) where
287+
getPerasVoteRound = getPerasVoteRound . vpvVote
288+
instance
289+
HasPerasVoteRound vote =>
290+
HasPerasVoteRound (WithArrivalTime vote)
291+
where
292+
getPerasVoteRound = getPerasVoteRound . forgetArrivalTime
293+
294+
class HasPerasVoteVotedBlock vote blk | vote -> blk where
295+
getPerasVoteVotedBlock :: vote -> Point blk
296+
instance HasPerasVoteVotedBlock (PerasVote blk) blk where
297+
getPerasVoteVotedBlock = pvVotedBlock
298+
instance HasPerasVoteVotedBlock (ValidatedPerasVote blk) blk where
299+
getPerasVoteVotedBlock = getPerasVoteVotedBlock . vpvVote
300+
instance
301+
HasPerasVoteVotedBlock vote blk =>
302+
HasPerasVoteVotedBlock (WithArrivalTime vote) blk
303+
where
304+
getPerasVoteVotedBlock = getPerasVoteVotedBlock . forgetArrivalTime
305+
306+
class HasStakePoolId vote where
307+
getStakePoolId :: vote -> StakePoolId
308+
instance HasStakePoolId (PerasVote blk) where
309+
getStakePoolId = pvVoteStakePoolId
310+
instance HasStakePoolId (ValidatedPerasVote blk) where
311+
getStakePoolId = getStakePoolId . vpvVote
312+
instance
313+
HasStakePoolId vote =>
314+
HasStakePoolId (WithArrivalTime vote)
315+
where
316+
getStakePoolId = getStakePoolId . forgetArrivalTime

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/ObjectPool/PerasVote.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasVote where

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/PerasVote.hs‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
-- | This module defines type aliases for the ObjectDiffusion protocol applied
2+
-- to PerasVote diffusion.
3+
module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasVote
4+
( TracePerasVoteDiffusionInbound
5+
, TracePerasVoteDiffusionOutbound
6+
, PerasVotePoolReader
7+
, PerasVotePoolWriter
8+
, PerasVoteDiffusionInboundPipelined
9+
, PerasVoteDiffusionOutbound
10+
, PerasVoteDiffusion
11+
, PerasVoteDiffusionInboundState
12+
, PerasVoteDiffusionInboundHandle
13+
, PerasVoteDiffusionInboundHandleCollection
14+
) where
15+
16+
import Ouroboros.Consensus.Block
17+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
18+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
19+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
20+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
21+
import Ouroboros.Consensus.Storage.PerasVoteDB.API
22+
import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound (ObjectDiffusionInboundPipelined)
23+
import Ouroboros.Network.Protocol.ObjectDiffusion.Outbound (ObjectDiffusionOutbound)
24+
import Ouroboros.Network.Protocol.ObjectDiffusion.Type (ObjectDiffusion)
25+
26+
type TracePerasVoteDiffusionInbound blk =
27+
TraceObjectDiffusionInbound PerasRoundNo (PerasVote blk)
28+
29+
type TracePerasVoteDiffusionOutbound blk =
30+
TraceObjectDiffusionOutbound PerasRoundNo (PerasVote blk)
31+
32+
type PerasVotePoolReader blk m =
33+
ObjectPoolReader PerasRoundNo (PerasVote blk) PerasVoteTicketNo m
34+
35+
type PerasVotePoolWriter blk m =
36+
ObjectPoolWriter PerasRoundNo (PerasVote blk) m
37+
38+
type PerasVoteDiffusionInboundPipelined blk m a =
39+
ObjectDiffusionInboundPipelined PerasRoundNo (PerasVote blk) m a
40+
41+
type PerasVoteDiffusionOutbound blk m a =
42+
ObjectDiffusionOutbound PerasRoundNo (PerasVote blk) m a
43+
44+
type PerasVoteDiffusion blk =
45+
ObjectDiffusion PerasRoundNo (PerasVote blk)
46+
47+
type PerasVoteDiffusionInboundState blk =
48+
ObjectDiffusionInboundState blk
49+
50+
type PerasVoteDiffusionInboundHandle m blk =
51+
ObjectDiffusionInboundHandle m blk
52+
53+
type PerasVoteDiffusionInboundHandleCollection peer m blk =
54+
ObjectDiffusionInboundHandleCollection peer m blk

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE DefaultSignatures #-}
23
{-# LANGUAGE DerivingStrategies #-}
34
{-# LANGUAGE FlexibleContexts #-}
@@ -36,6 +37,8 @@ module Ouroboros.Consensus.Node.Serialisation
3637
, Some (..)
3738
) where
3839

40+
import qualified Cardano.Binary as KeyHash
41+
import Cardano.Ledger.Core
3942
import Codec.CBOR.Decoding (Decoder, decodeListLenOf)
4043
import Codec.CBOR.Encoding (Encoding, encodeListLen)
4144
import Codec.Serialise (Serialise (decode, encode))
@@ -206,6 +209,22 @@ instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasCert blk) where
206209
pcCertRound <- decodeNodeToNode ccfg version
207210
pcCertBoostedBlock <- decodeNodeToNode ccfg version
208211
pure $ PerasCert pcCertRound pcCertBoostedBlock
212+
instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasVote blk) where
213+
-- Consistent with the 'Serialise' instance for 'PerasVote' defined in Ouroboros.Consensus.Block.SupportsPeras
214+
encodeNodeToNode ccfg version PerasVote{..} =
215+
encodeListLen 2
216+
<> encodeNodeToNode ccfg version pvVoteRound
217+
<> encodeNodeToNode ccfg version pvVotedBlock
218+
decodeNodeToNode ccfg version = do
219+
decodeListLenOf 3
220+
pvVoteRound <- decodeNodeToNode ccfg version
221+
pvVotedBlock <- decodeNodeToNode ccfg version
222+
pvVoteStakePoolId <- decodeNodeToNode ccfg version
223+
pure $ PerasVote pvVoteRound pvVotedBlock pvVoteStakePoolId
224+
225+
instance SerialiseNodeToNode blk (KeyHash 'StakePool) where
226+
encodeNodeToNode _ccfg _version = KeyHash.toCBOR
227+
decodeNodeToNode _ccfg _version = KeyHash.fromCBOR
209228

210229
deriving newtype instance
211230
SerialiseNodeToClient blk (GenTxId blk) =>

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasVoteDB.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
module Ouroboros.Consensus.Storage.PerasVoteDB where

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasVoteDB/API.hs‎

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DerivingVia #-}
3+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
6+
module Ouroboros.Consensus.Storage.PerasVoteDB.API
7+
( PerasVoteDB (..)
8+
, AddPerasVoteResult (..)
9+
10+
-- * 'PerasVoteSnapshot'
11+
, PerasVoteSnapshot (..)
12+
, PerasVoteTicketNo
13+
, zeroPerasVoteTicketNo
14+
) where
15+
16+
import Data.Map (Map)
17+
import Data.Word (Word64)
18+
import NoThunks.Class
19+
import Ouroboros.Consensus.Block
20+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
21+
import Ouroboros.Consensus.Peras.Weight
22+
import Ouroboros.Consensus.Util.IOLike
23+
import Ouroboros.Consensus.Util.STM (WithFingerprint (..))
24+
25+
data PerasVoteDB m blk = PerasVoteDB
26+
{ addVote :: WithArrivalTime (ValidatedPerasVote blk) -> m AddPerasVoteResult
27+
-- ^ Add a Peras vote to the database. The result indicates whether
28+
-- the vote was actually added, or if it was already present.
29+
, getWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
30+
-- ^ Return the Peras weights in order compare the current selection against
31+
-- potential candidate chains, namely the weights for blocks not older than
32+
-- the current immutable tip. It might contain weights for even older blocks
33+
-- if they have not yet been garbage-collected.
34+
--
35+
-- The 'Fingerprint' is updated every time a new vote is added, but it
36+
-- stays the same when votes are garbage-collected.
37+
, getVoteSnapshot :: STM m (PerasVoteSnapshot blk)
38+
, getLatestVoteSeen :: STM m (Maybe (WithArrivalTime (ValidatedPerasVote blk)))
39+
-- ^ Get the vote with the highest round number that has been added to
40+
-- the db since it has been opened. This vote is not affected by garbage
41+
-- collection, but it's forgotten when the db is closed.
42+
--
43+
-- NOTE: having seen a vote is a precondition to start voting in every
44+
-- round except for the first one (at origin). As a consequence, only caught-up
45+
-- nodes can actively participate in the Peras protocol for now.
46+
, garbageCollect :: SlotNo -> m ()
47+
-- ^ Garbage-collect state older than the given slot number.
48+
, closeDB :: m ()
49+
}
50+
deriving NoThunks via OnlyCheckWhnfNamed "PerasVoteDB" (PerasVoteDB m blk)
51+
52+
data AddPerasVoteResult = AddedPerasVoteToDB | PerasVoteAlreadyInDB
53+
deriving stock (Show, Eq)
54+
55+
data PerasVoteSnapshot blk = PerasVoteSnapshot
56+
{ containsVote :: PerasRoundNo -> Bool
57+
-- ^ Do we have the vote for this round?
58+
, getVotesAfter ::
59+
PerasVoteTicketNo ->
60+
Map PerasVoteTicketNo (WithArrivalTime (ValidatedPerasVote blk))
61+
-- ^ Get votes after the given ticket number (excluded).
62+
-- The result is a map of ticket numbers to validated votes.
63+
}
64+
65+
-- | A sequence number, incremented every time we receive a new vote.
66+
--
67+
-- Note that we will /usually/ receive votes monotonically by round
68+
-- number, so round numbers could /almost/ fulfill the role of ticket numbers.
69+
-- However, in certain edge cases (while catching up, or during cooldowns), this
70+
-- might not be true, such as during syncing or during cooldown periods.
71+
-- Therefore, for robustness, we choose to maintain dedicated ticket numbers
72+
-- separately.
73+
newtype PerasVoteTicketNo = PerasVoteTicketNo Word64
74+
deriving stock Show
75+
deriving newtype (Eq, Ord, Enum, NoThunks)
76+
77+
zeroPerasVoteTicketNo :: PerasVoteTicketNo
78+
zeroPerasVoteTicketNo = PerasVoteTicketNo 0

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasVoteDB/Impl.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
module Ouroboros.Consensus.Storage.PerasVoteDB.Impl where

0 commit comments

Comments
 (0)