Complete/fix Vote definition in BlockSupportsPeras

Author: tbagrel1

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

@@ -15,6 +15,8 @@
 module Ouroboros.Consensus.Block.SupportsPeras
   ( PerasRoundNo (..)
   , onPerasRoundNo
+  , PerasVoteId (..)
+  , PerasVoteTarget (..)
   , PerasVoterId (..)
   , PerasVoteStake (..)
   , PerasVoteStakeDistr (..)
@@ -30,6 +32,8 @@ module Ouroboros.Consensus.Block.SupportsPeras
   , HasPerasVoteRound (..)
   , HasPerasVoteBlock (..)
   , HasPerasVoteVoterId (..)
+  , HasPerasVoteTarget (..)
+  , HasPerasVoteId (..)
 
     -- * Convenience re-exports
   , module Ouroboros.Consensus.Peras.Params
@@ -109,6 +113,13 @@ data PerasVoteTarget blk = PerasVoteTarget
   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 vote casted by a member of a given stake distribution.
 lookupPerasVoteStake ::
   PerasVote blk ->
@@ -162,15 +173,15 @@ class
 
   validatePerasVote ::
     PerasCfg blk ->
-    PerasVote blk ->
     PerasVoteStakeDistr ->
+    PerasVote blk ->
     Either (PerasValidationErr blk) (ValidatedPerasVote blk)
 
   forgePerasCert ::
     PerasCfg blk ->
     PerasVoteTarget blk ->
     [ValidatedPerasVote blk] ->
-    Either (PerasForgeErr blk) (PerasCert 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
@@ -218,7 +229,7 @@ instance StandardHash blk => BlockSupportsPeras blk where
   -- TODO: perform actual validation against all
   -- possible 'PerasValidationErr' variants
   -- see https://github.com/tweag/cardano-peras/issues/120
-  validatePerasVote _params vote stakeDistr
+  validatePerasVote _params stakeDistr vote
     | Just stake <- lookupPerasVoteStake vote stakeDistr =
         Right
           ValidatedPerasVote
@@ -238,9 +249,13 @@ instance StandardHash blk => BlockSupportsPeras blk where
         Left PerasForgeErrInsufficientVotes
     | otherwise =
         return $
-          PerasCert
-            { pcCertRound = pvtRoundNo target
-            , pcCertBoostedBlock = pvtBlock target
+          ValidatedPerasCert
+            { vpcCert =
+                PerasCert
+                  { pcCertRound = pvtRoundNo target
+                  , pcCertBoostedBlock = pvtBlock target
+                  }
+            , vpcCertBoost = perasWeight params
             }
    where
     totalVotesStake =
@@ -408,3 +423,22 @@ instance
   HasPerasVoteTarget (WithArrivalTime vote) blk
   where
   getPerasVoteTarget = getPerasVoteTarget . forgetArrivalTime
+
+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