[DO NOT MERGE] Replace PerasVote and PerasCert validation by a no-op

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs

@@ -397,13 +397,6 @@ mkHandlers
             )
             ( makePerasVotePoolWriterFromChainDB
                 systemTime
-                -- TODO: when actual plumbing for Peras is ready, we will have to
-                -- extract the committee selection data from the chainDB to pass
-                -- it here, instead of relying on an empty the stake distribution.
-                --
-                -- Note that the empty stake distribution will cause all votes to
-                -- be considered invalid.
-                (pure (PerasVoteStakeDistr mempty))
                 getChainDB
             )
             version

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

@@ -20,8 +20,6 @@ module Ouroboros.Consensus.Block.SupportsPeras
   , PerasVoterId (..)
   , PerasVoteStake (..)
   , stakeAboveThreshold
-  , PerasVoteStakeDistr (..)
-  , lookupPerasVoteStake
   , BlockSupportsPeras (..)
   , PerasCert (..)
   , PerasVote (..)
@@ -56,8 +54,6 @@ import Codec.Serialise.Encoding (encodeListLen)
 import Control.DeepSeq (NFData)
 import Data.Coerce (coerce)
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.Map as Map
-import Data.Map.Strict (Map)
 import Data.Monoid (Sum (..))
 import Data.Proxy (Proxy (..))
 import Data.Word (Word64)
@@ -141,12 +137,6 @@ stakeAboveThreshold params voteStake =
     unPerasQuorumStakeThresholdSafetyMargin
       (perasQuorumStakeThresholdSafetyMargin params)
 
-newtype PerasVoteStakeDistr = PerasVoteStakeDistr
-  { unPerasVoteStakeDistr :: Map PerasVoterId PerasVoteStake
-  }
-  deriving newtype NoThunks
-  deriving stock (Show, Eq, Generic)
-
 data PerasVoteTarget blk = PerasVoteTarget
   { pvtRoundNo :: !PerasRoundNo
   , pvtBlock :: !(Point blk)
@@ -161,16 +151,6 @@ data PerasVoteId blk = PerasVoteId
   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
@@ -267,7 +247,6 @@ class
 
   validatePerasVote ::
     PerasCfg blk ->
-    PerasVoteStakeDistr ->
     PerasVote blk ->
     Either (PerasValidationErr blk) (ValidatedPerasVote blk)
 
@@ -300,6 +279,7 @@ instance StandardHash blk => BlockSupportsPeras blk where
     { pvVoteRound :: PerasRoundNo
     , pvVoteBlock :: Point blk
     , pvVoteVoterId :: PerasVoterId
+    , pvVoteStake :: PerasVoteStake
     }
     deriving stock (Generic, Eq, Ord, Show)
     deriving anyclass NoThunks
@@ -329,15 +309,15 @@ 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 stakeDistr vote
-    | Just stake <- lookupPerasVoteStake vote stakeDistr =
-        Right
-          ValidatedPerasVote
-            { vpvVote = vote
-            , vpvVoteStake = stake
-            }
-    | otherwise =
-        Left PerasValidationErr
+  --
+  -- This is currently a no-op that trusts the vote stake contained in the
+  -- 'PerasVote' itself.
+  validatePerasVote _params vote =
+    Right
+      ValidatedPerasVote
+        { vpvVote = vote
+        , vpvVoteStake = pvVoteStake vote
+        }
 
   -- TODO: perform actual validation against all
   -- possible 'PerasForgeErr' variants
@@ -378,17 +358,19 @@ instance Serialise (HeaderHash blk) => Serialise (PerasCert blk) where
     pure $ PerasCert{pcCertRound, pcCertBoostedBlock}
 
 instance Serialise (HeaderHash blk) => Serialise (PerasVote blk) where
-  encode PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId} =
-    encodeListLen 3
+  encode PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId, pvVoteStake} =
+    encodeListLen 4
       <> encode pvVoteRound
       <> encode pvVoteBlock
       <> KeyHash.toCBOR (unPerasVoterId pvVoteVoterId)
+      <> encode pvVoteStake
   decode = do
-    decodeListLenOf 3
+    decodeListLenOf 4
     pvVoteRound <- decode
     pvVoteBlock <- decode
     pvVoteVoterId <- PerasVoterId <$> KeyHash.fromCBOR
-    pure $ PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId}
+    pvVoteStake <- decode
+    pure $ PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId, pvVoteStake}
 
 instance Serialise (PerasVoteId blk) where
   encode PerasVoteId{pviRoundNo, pviVoterId} =

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

@@ -92,13 +92,9 @@ makePerasVotePoolReaderFromChainDB chainDB =
 makePerasVotePoolWriterFromVoteDB ::
   (StandardHash blk, IOLike m) =>
   SystemTime m ->
-  -- | This is needed for validating votes (since it is during the validation of
-  -- votes that we give them a verified weight. In the future, we won't read it
-  -- from the stake distr directly, but rather use the committee selection data)
-  STM m PerasVoteStakeDistr ->
   PerasVoteDB m blk ->
   ObjectPoolWriter (PerasVoteId blk) (PerasVote blk) m
-makePerasVotePoolWriterFromVoteDB systemTime getStakeDistrSTM perasVoteDB =
+makePerasVotePoolWriterFromVoteDB systemTime perasVoteDB =
   ObjectPoolWriter
     { opwObjectId = getPerasVoteId
     , opwAddObjects = \votes ->
@@ -108,7 +104,7 @@ makePerasVotePoolWriterFromVoteDB systemTime getStakeDistrSTM perasVoteDB =
           -- TODO: in the future we won't need just the stake distribution for
           -- validating votes, but also the whole committee selection context
           -- (containing vote weights of committee members = voters)
-          (\vote -> getStakeDistrSTM >>= \sd -> pure $ validatePerasVote mkPerasParams sd vote)
+          (validatePerasVote mkPerasParams)
           (void . join . atomically . PerasVoteDB.addVote perasVoteDB)
           votes
     , opwHasObject = do
@@ -122,13 +118,9 @@ makePerasVotePoolWriterFromVoteDB systemTime getStakeDistrSTM perasVoteDB =
 makePerasVotePoolWriterFromChainDB ::
   (StandardHash blk, IOLike m) =>
   SystemTime m ->
-  -- | This is needed for validating votes (since its during the validation of
-  -- votes that we give them a verified weight. In the future, we won't read it
-  -- from the stake distr directly, but rather use the committee selection data)
-  STM m PerasVoteStakeDistr ->
   ChainDB m blk ->
   ObjectPoolWriter (PerasVoteId blk) (PerasVote blk) m
-makePerasVotePoolWriterFromChainDB systemTime getStakeDistrSTM chainDB =
+makePerasVotePoolWriterFromChainDB systemTime chainDB =
   ObjectPoolWriter
     { opwObjectId = getPerasVoteId
     , opwAddObjects = \votes ->
@@ -138,7 +130,7 @@ makePerasVotePoolWriterFromChainDB systemTime getStakeDistrSTM chainDB =
           -- TODO: in the future we won't need just the stake distribution for
           -- validating votes, but also the whole committee selection context
           -- (containing vote weights of committee members = voters)
-          (\vote -> getStakeDistrSTM >>= \sd -> pure $ validatePerasVote mkPerasParams sd vote)
+          (validatePerasVote mkPerasParams)
           -- We do not want to block the writer thread on waiting for ChainSel
           -- side-effects to complete, so we use the async version of adding
           -- votes to the ChainDB and ignore the returned promise.
@@ -171,17 +163,15 @@ processVotes ::
   MonadSTM m =>
   SystemTime m ->
   STM m (Set (PerasVoteId blk)) ->
-  (PerasVote blk -> STM m (Either (PerasValidationErr blk) (ValidatedPerasVote blk))) ->
+  (PerasVote blk -> Either (PerasValidationErr blk) (ValidatedPerasVote blk)) ->
   (WithArrivalTime (ValidatedPerasVote blk) -> m ()) ->
   [PerasVote blk] ->
   m ()
 processVotes systemTime alreadyInDbSTM validateVote addVote votes = do
-  validationResults <- atomically $ do
-    alreadyInDb <- alreadyInDbSTM
-    let votesNotAlreadyInDb = filter (not . (`Set.member` alreadyInDb) . getPerasVoteId) votes
-    mapM validateVote votesNotAlreadyInDb
+  alreadyInDb <- atomically alreadyInDbSTM
+  let votesNotAlreadyInDb = filter (not . (`Set.member` alreadyInDb) . getPerasVoteId) votes
   now <- systemTimeCurrent systemTime
-  case partitionEithers validationResults of
+  case partitionEithers (validateVote <$> votesNotAlreadyInDb) of
     -- All votes are valid => add them to the pool
     ([], validatedVotes) ->
       mapM_

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

@@ -197,6 +197,10 @@ instance SerialiseNodeToNode blk PerasRoundNo where
   encodeNodeToNode _ccfg _version = encode
   decodeNodeToNode _ccfg _version = decode
 
+instance SerialiseNodeToNode blk PerasVoteStake 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{..} =
@@ -212,16 +216,18 @@ instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasCert blk) where
 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
+    encodeListLen 4
       <> encodeNodeToNode ccfg version pvVoteRound
       <> encodeNodeToNode ccfg version pvVoteBlock
       <> encodeNodeToNode ccfg version pvVoteVoterId
+      <> encodeNodeToNode ccfg version pvVoteStake
   decodeNodeToNode ccfg version = do
-    decodeListLenOf 3
+    decodeListLenOf 4
     pvVoteRound <- decodeNodeToNode ccfg version
     pvVoteBlock <- decodeNodeToNode ccfg version
     pvVoteVoterId <- decodeNodeToNode ccfg version
-    pure $ PerasVote pvVoteRound pvVoteBlock pvVoteVoterId
+    pvVoteStake <- decodeNodeToNode ccfg version
+    pure $ PerasVote pvVoteRound pvVoteBlock pvVoteVoterId pvVoteStake
 
 instance SerialiseNodeToNode blk PerasVoterId where
   encodeNodeToNode _ccfg _version = KeyHash.toCBOR . unPerasVoterId

ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ObjectDiffusion/PerasVote/Smoke.hs

@@ -87,7 +87,8 @@ genPerasVote = do
   pvVoteRound <- PerasRoundNo <$> arbitrary
   pvVoteBlock <- genPointTestBlock
   pvVoteVoterId <- genPerasVoterId
-  pure $ PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId}
+  pvVoteStake <- genPerasVoteStake
+  pure $ PerasVote{pvVoteRound, pvVoteBlock, pvVoteVoterId, pvVoteStake}
 
 instance WithId (PerasVote blk) (PerasVoteId blk) where
   getId = getPerasVoteId
@@ -96,10 +97,13 @@ instance WithId (WithArrivalTime (ValidatedPerasVote blk)) (PerasVoteId blk) whe
   getId = getPerasVoteId . vpvVote . forgetArrivalTime
 
 genValidatedPerasVote :: Gen (ValidatedPerasVote TestBlock)
-genValidatedPerasVote =
-  ValidatedPerasVote
-    <$> genPerasVote
-    <*> genPerasVoteStake
+genValidatedPerasVote = do
+  vote <- genPerasVote
+  pure $
+    ValidatedPerasVote
+      { vpvVote = vote
+      , vpvVoteStake = pvVoteStake vote
+      }
 
 newVoteDB ::
   (IOLike m, StandardHash blk, Typeable blk) =>
@@ -136,16 +140,9 @@ prop_smoke =
             inboundPool <- newVoteDB []
 
             let outboundPoolReader = makePerasVotePoolReaderFromVoteDB outboundPool
-                stakeDistr =
-                  PerasVoteStakeDistr $
-                    Map.fromList
-                      [ (pvVoteVoterId (vpvVote v), vpvVoteStake v)
-                      | WithArrivalTime _ v <- watValidatedVotes
-                      ]
                 inboundPoolWriter =
                   makePerasVotePoolWriterFromVoteDB
                     mockSystemTime
-                    (pure stakeDistr)
                     inboundPool
                 getAllInboundPoolContent = do
                   votesMap <-

ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs

@@ -1322,6 +1322,7 @@ generator loe genBlock genPerasBlock m@Model{..} =
                     { pvVoteRound = roundNo
                     , pvVoteBlock = blockPoint blk
                     , pvVoteVoterId = voterId
+                    , pvVoteStake = stake
                     }
               , vpvVoteStake = stake
               }

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

@@ -191,6 +191,7 @@ instance StateModel Model where
                       { pvVoteRound = roundNo
                       , pvVoteBlock = point
                       , pvVoteVoterId = voterId
+                      , pvVoteStake = stake
                       }
                 , vpvVoteStake = stake
                 }