diff --git a/ouroboros-consensus/changelog.d/20251209_115129_agustin.mista_votedb_api.md b/ouroboros-consensus/changelog.d/20251209_115129_agustin.mista_votedb_api.md new file mode 100644 index 0000000000..9ea1df83c9 --- /dev/null +++ b/ouroboros-consensus/changelog.d/20251209_115129_agustin.mista_votedb_api.md @@ -0,0 +1,23 @@ + + + +### Non-Breaking + +- Define Peras votes and their corresponding certificate forging API. + + diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs index 4f5a9ff49c..570ec33c4f 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} @@ -14,21 +15,40 @@ module Ouroboros.Consensus.Block.SupportsPeras ( PerasRoundNo (..) , onPerasRoundNo + , PerasVoteId (..) + , PerasVoteTarget (..) + , PerasVoterId (..) + , PerasVoteStake (..) + , PerasVoteStakeDistr (..) + , lookupPerasVoteStake , BlockSupportsPeras (..) , PerasCert (..) + , PerasVote (..) , ValidatedPerasCert (..) + , ValidatedPerasVote (..) , HasPerasCertRound (..) , HasPerasCertBoostedBlock (..) , HasPerasCertBoost (..) + , HasPerasVoteRound (..) + , HasPerasVoteBlock (..) + , HasPerasVoteVoterId (..) + , HasPerasVoteStake (..) + , HasPerasVoteTarget (..) + , HasPerasVoteId (..) -- * Convenience re-exports , module Ouroboros.Consensus.Peras.Params ) where +import qualified Cardano.Binary as KeyHash +import Cardano.Ledger.Hashes (KeyHash, KeyRole (..)) import Codec.Serialise (Serialise (..)) import Codec.Serialise.Decoding (decodeListLenOf) import Codec.Serialise.Encoding (encodeListLen) import Data.Coerce (coerce) +import qualified Data.Map as Map +import Data.Map.Strict (Map) +import Data.Monoid (Sum (..)) import Data.Proxy (Proxy (..)) import Data.Word (Word64) import GHC.Generics (Generic) @@ -40,6 +60,12 @@ import Ouroboros.Consensus.Util import Ouroboros.Consensus.Util.Condense import Quiet (Quiet (..)) +{------------------------------------------------------------------------------- +-- * Peras types +-------------------------------------------------------------------------------} + +-- ** Round numbers + newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64} deriving Show via Quiet PerasRoundNo deriving stock Generic @@ -57,7 +83,64 @@ onPerasRoundNo :: (PerasRoundNo -> PerasRoundNo -> PerasRoundNo) onPerasRoundNo = coerce --- TODO using 'Validated' for extra safety? Or some @.Unsafe@ module? +-- ** Stake pool distributions + +newtype PerasVoterId = PerasVoterId + { unPerasVoterId :: KeyHash StakePool + } + deriving newtype NoThunks + deriving stock (Eq, Ord, Generic) + deriving Show via Quiet PerasVoterId + +-- NOTE: At the moment there is no consensus from researchers/engineers on how +-- we go from the absolute stake of a voter in the ledger to the relative stake +-- of their vote in the voting commitee (given that the quorum is expressed as +-- a relative value of the voting commitee total stake). +-- +-- So, for now you can consider this 'Rational' as the best approximation we +-- have at the moment of the concrete type for a relative vote stake that can be +-- compared to the quorum threshold value (also currently a 'Rational'). +newtype PerasVoteStake = PerasVoteStake + { unPerasVoteStake :: Rational + } + deriving newtype (Eq, Ord, Num, Fractional, NoThunks, Serialise) + deriving stock Generic + deriving Show via Quiet PerasVoteStake + deriving Semigroup via Sum Rational + deriving Monoid via Sum Rational + +newtype PerasVoteStakeDistr = PerasVoteStakeDistr + { unPerasVoteStakeDistr :: Map PerasVoterId PerasVoteStake + } + deriving newtype NoThunks + deriving stock (Show, Eq, Generic) + +data PerasVoteTarget blk = PerasVoteTarget + { pvtRoundNo :: !PerasRoundNo + , pvtBlock :: !(Point blk) + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass NoThunks + +data PerasVoteId blk = PerasVoteId + { pviRoundNo :: !PerasRoundNo + , pviVoterId :: !PerasVoterId + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass NoThunks + +-- | Lookup the stake of a vote cast by a member of a given stake distribution. +lookupPerasVoteStake :: + PerasVote blk -> + PerasVoteStakeDistr -> + Maybe PerasVoteStake +lookupPerasVoteStake vote distr = + Map.lookup + (pvVoteVoterId vote) + (unPerasVoteStakeDistr distr) + +-- ** Validated types + data ValidatedPerasCert blk = ValidatedPerasCert { vpcCert :: !(PerasCert blk) , vpcCertBoost :: !PerasWeight @@ -65,6 +148,13 @@ data ValidatedPerasCert blk = ValidatedPerasCert deriving stock (Show, Eq, Ord, Generic) deriving anyclass NoThunks +data ValidatedPerasVote blk = ValidatedPerasVote + { vpvVote :: !(PerasVote blk) + , vpvVoteStake :: !PerasVoteStake + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass NoThunks + {------------------------------------------------------------------------------- -- * BlockSupportsPeras class -------------------------------------------------------------------------------} @@ -79,13 +169,29 @@ class data PerasCert blk + data PerasVote blk + data PerasValidationErr blk + data PerasForgeErr blk + validatePerasCert :: PerasCfg blk -> PerasCert blk -> Either (PerasValidationErr blk) (ValidatedPerasCert blk) + validatePerasVote :: + PerasCfg blk -> + PerasVoteStakeDistr -> + PerasVote blk -> + Either (PerasValidationErr blk) (ValidatedPerasVote blk) + + forgePerasCert :: + PerasCfg blk -> + PerasVoteTarget blk -> + [ValidatedPerasVote blk] -> + Either (PerasForgeErr blk) (ValidatedPerasCert blk) + -- TODO: degenerate instance for all blks to get things to compile -- see https://github.com/tweag/cardano-peras/issues/73 instance StandardHash blk => BlockSupportsPeras blk where @@ -98,12 +204,27 @@ instance StandardHash blk => BlockSupportsPeras blk where deriving stock (Generic, Eq, Ord, Show) deriving anyclass NoThunks + data PerasVote blk = PerasVote + { pvVoteRound :: PerasRoundNo + , pvVoteBlock :: Point blk + , pvVoteVoterId :: PerasVoterId + } + deriving stock (Generic, Eq, Ord, Show) + deriving anyclass NoThunks + -- TODO: enrich with actual error types -- see https://github.com/tweag/cardano-peras/issues/120 data PerasValidationErr blk = PerasValidationErr deriving stock (Show, Eq) + -- TODO: enrich with actual error types + -- see https://github.com/tweag/cardano-peras/issues/120 + data PerasForgeErr blk + = PerasForgeErrInsufficientVotes + | PerasForgeErrTargetMismatch + deriving stock (Show, Eq) + -- TODO: perform actual validation against all -- possible 'PerasValidationErr' variants -- see https://github.com/tweag/cardano-peras/issues/120 @@ -114,9 +235,54 @@ instance StandardHash blk => BlockSupportsPeras blk where , vpcCertBoost = perasWeight params } + -- TODO: perform actual validation against all + -- possible 'PerasValidationErr' variants + -- see https://github.com/tweag/cardano-peras/issues/120 + validatePerasVote _params stakeDistr vote + | Just stake <- lookupPerasVoteStake vote stakeDistr = + Right + ValidatedPerasVote + { vpvVote = vote + , vpvVoteStake = stake + } + | otherwise = + Left PerasValidationErr + + -- TODO: perform actual validation against all + -- possible 'PerasForgeErr' variants + -- see https://github.com/tweag/cardano-peras/issues/120 + forgePerasCert params target votes + | not allVotersMatchTarget = + Left PerasForgeErrTargetMismatch + | not votesHaveEnoughStake = + Left PerasForgeErrInsufficientVotes + | otherwise = + return $ + ValidatedPerasCert + { vpcCert = + PerasCert + { pcCertRound = pvtRoundNo target + , pcCertBoostedBlock = pvtBlock target + } + , vpcCertBoost = perasWeight params + } + where + totalVotesStake = + mconcat (vpvVoteStake <$> votes) + + votesHaveEnoughStake = + unPerasVoteStake totalVotesStake + >= unPerasQuorumStakeThreshold (perasQuorumStakeThreshold params) + + allVotersMatchTarget = + all ((target ==) . getPerasVoteTarget) votes + instance ShowProxy blk => ShowProxy (PerasCert blk) where showProxy _ = "PerasCert " <> showProxy (Proxy @blk) +instance ShowProxy blk => ShowProxy (PerasVote blk) where + showProxy _ = "PerasVote " <> showProxy (Proxy @blk) + instance Serialise (HeaderHash blk) => Serialise (PerasCert blk) where encode PerasCert{pcCertRound, pcCertBoostedBlock} = encodeListLen 2 @@ -128,6 +294,19 @@ instance Serialise (HeaderHash blk) => Serialise (PerasCert blk) where pcCertBoostedBlock <- decode pure $ PerasCert{pcCertRound, pcCertBoostedBlock} +instance Serialise (HeaderHash blk) => Serialise (PerasVote blk) where + encode PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId} = + encodeListLen 3 + <> encode pvVoteRound + <> encode pvVoteBlock + <> KeyHash.toCBOR (unPerasVoterId pvVoteVoterId) + decode = do + decodeListLenOf 3 + pvVoteRound <- decode + pvVoteBlock <- decode + pvVoteVoterId <- PerasVoterId <$> KeyHash.fromCBOR + pure $ PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId} + -- | Extract the certificate round from a Peras certificate container class HasPerasCertRound cert where getPerasCertRound :: cert -> PerasRoundNo @@ -172,3 +351,104 @@ instance HasPerasCertBoost (WithArrivalTime cert) where getPerasCertBoost = getPerasCertBoost . forgetArrivalTime + +-- | Extract the vote round from a Peras vote container +class HasPerasVoteRound vote where + getPerasVoteRound :: vote -> PerasRoundNo + +instance HasPerasVoteRound (PerasVote blk) where + getPerasVoteRound = pvVoteRound + +instance HasPerasVoteRound (ValidatedPerasVote blk) where + getPerasVoteRound = getPerasVoteRound . vpvVote + +instance + HasPerasVoteRound vote => + HasPerasVoteRound (WithArrivalTime vote) + where + getPerasVoteRound = getPerasVoteRound . forgetArrivalTime + +-- | Extract the vote block point from a Peras vote container +class HasPerasVoteBlock vote blk | vote -> blk where + getPerasVoteBlock :: vote -> Point blk + +instance HasPerasVoteBlock (PerasVote blk) blk where + getPerasVoteBlock = pvVoteBlock + +instance HasPerasVoteBlock (ValidatedPerasVote blk) blk where + getPerasVoteBlock = getPerasVoteBlock . vpvVote + +instance + HasPerasVoteBlock vote blk => + HasPerasVoteBlock (WithArrivalTime vote) blk + where + getPerasVoteBlock = getPerasVoteBlock . forgetArrivalTime + +-- | Extract the stake pool ID from a Peras vote container +class HasPerasVoteVoterId vote where + getPerasVoteVoterId :: vote -> PerasVoterId + +instance HasPerasVoteVoterId (PerasVote blk) where + getPerasVoteVoterId = pvVoteVoterId + +instance HasPerasVoteVoterId (ValidatedPerasVote blk) where + getPerasVoteVoterId = getPerasVoteVoterId . vpvVote + +instance + HasPerasVoteVoterId vote => + HasPerasVoteVoterId (WithArrivalTime vote) + where + getPerasVoteVoterId = getPerasVoteVoterId . forgetArrivalTime + +-- | Extract the vote stake from a validated Peras vote container +class HasPerasVoteStake vote where + getPerasVoteStake :: vote -> PerasVoteStake + +instance HasPerasVoteStake (ValidatedPerasVote blk) where + getPerasVoteStake = vpvVoteStake + +instance + HasPerasVoteStake vote => + HasPerasVoteStake (WithArrivalTime vote) + where + getPerasVoteStake = getPerasVoteStake . forgetArrivalTime + +-- | Extract the vote target from a Peras vote container +class HasPerasVoteTarget vote blk | vote -> blk where + getPerasVoteTarget :: vote -> PerasVoteTarget blk + +instance HasPerasVoteTarget (PerasVote blk) blk where + getPerasVoteTarget vote = + PerasVoteTarget + { pvtRoundNo = pvVoteRound vote + , pvtBlock = pvVoteBlock vote + } + +instance HasPerasVoteTarget (ValidatedPerasVote blk) blk where + getPerasVoteTarget = getPerasVoteTarget . vpvVote + +instance + HasPerasVoteTarget vote blk => + HasPerasVoteTarget (WithArrivalTime vote) blk + where + getPerasVoteTarget = getPerasVoteTarget . forgetArrivalTime + +-- | Extract the vote ID from a Peras vote container +class HasPerasVoteId vote blk | vote -> blk where + getPerasVoteId :: vote -> PerasVoteId blk + +instance HasPerasVoteId (PerasVote blk) blk where + getPerasVoteId vote = + PerasVoteId + { pviRoundNo = pvVoteRound vote + , pviVoterId = pvVoteVoterId vote + } + +instance HasPerasVoteId (ValidatedPerasVote blk) blk where + getPerasVoteId = getPerasVoteId . vpvVote + +instance + HasPerasVoteId vote blk => + HasPerasVoteId (WithArrivalTime vote) blk + where + getPerasVoteId = getPerasVoteId . forgetArrivalTime diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs index 6a4fc87229..c3fa16d599 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs @@ -36,6 +36,7 @@ module Ouroboros.Consensus.Node.Serialisation , Some (..) ) where +import qualified Cardano.Binary as KeyHash import Codec.CBOR.Decoding (Decoder, decodeListLenOf) import Codec.CBOR.Encoding (Encoding, encodeListLen) import Codec.Serialise (Serialise (decode, encode)) @@ -195,6 +196,7 @@ instance ConvertRawHash blk => SerialiseNodeToNode blk (Tip blk) where instance SerialiseNodeToNode blk PerasRoundNo where encodeNodeToNode _ccfg _version = encode decodeNodeToNode _ccfg _version = decode + instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasCert blk) where -- Consistent with the 'Serialise' instance for 'PerasCert' defined in Ouroboros.Consensus.Block.SupportsPeras encodeNodeToNode ccfg version PerasCert{..} = @@ -207,6 +209,24 @@ instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasCert blk) where pcCertBoostedBlock <- decodeNodeToNode ccfg version pure $ PerasCert pcCertRound pcCertBoostedBlock +instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasVote blk) where + -- Consistent with the 'Serialise' instance for 'PerasVote' defined in Ouroboros.Consensus.Block.SupportsPeras + encodeNodeToNode ccfg version PerasVote{..} = + encodeListLen 3 + <> encodeNodeToNode ccfg version pvVoteRound + <> encodeNodeToNode ccfg version pvVoteBlock + <> encodeNodeToNode ccfg version pvVoteVoterId + decodeNodeToNode ccfg version = do + decodeListLenOf 3 + pvVoteRound <- decodeNodeToNode ccfg version + pvVoteBlock <- decodeNodeToNode ccfg version + pvVoteVoterId <- decodeNodeToNode ccfg version + pure $ PerasVote pvVoteRound pvVoteBlock pvVoteVoterId + +instance SerialiseNodeToNode blk PerasVoterId where + encodeNodeToNode _ccfg _version = KeyHash.toCBOR . unPerasVoterId + decodeNodeToNode _ccfg _version = PerasVoterId <$> KeyHash.fromCBOR + deriving newtype instance SerialiseNodeToClient blk (GenTxId blk) => SerialiseNodeToClient blk (WrapGenTxId blk) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs index a288adc376..61f6a481b5 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs @@ -13,6 +13,7 @@ module Ouroboros.Consensus.Peras.Params , PerasCertArrivalThreshold (..) , PerasRoundLength (..) , PerasWeight (..) + , PerasQuorumStakeThreshold (..) -- * Protocol parameters bundle , PerasParams (..) @@ -80,6 +81,13 @@ newtype PerasWeight deriving via Sum Word64 instance Semigroup PerasWeight deriving via Sum Word64 instance Monoid PerasWeight +-- | Total stake needed to forge a Peras certificate. +newtype PerasQuorumStakeThreshold + = PerasQuorumStakeThreshold {unPerasQuorumStakeThreshold :: Rational} + deriving Show via Quiet PerasQuorumStakeThreshold + deriving stock Generic + deriving newtype (Eq, Ord, NoThunks, Condense) + {------------------------------------------------------------------------------- Protocol parameters bundle -------------------------------------------------------------------------------} @@ -97,6 +105,7 @@ data PerasParams = PerasParams , perasCertArrivalThreshold :: PerasCertArrivalThreshold , perasRoundLength :: !PerasRoundLength , perasWeight :: !PerasWeight + , perasQuorumStakeThreshold :: !PerasQuorumStakeThreshold } deriving (Show, Eq, Generic, NoThunks) @@ -118,4 +127,6 @@ mkPerasParams = PerasRoundLength 90 , perasWeight = PerasWeight 15 + , perasQuorumStakeThreshold = + PerasQuorumStakeThreshold (3 / 4) }