[Peras 3] Make ChainDB aware of PerasCertDB, and switch to weighted chain selection

cabal.project

@@ -84,3 +84,19 @@ source-repository-package
     eras/byron/ledger/executable-spec
     eras/byron/ledger/impl
     eras/byron/crypto
+
+allow-newer:
+    -- https://github.com/phadej/vec/issues/121
+    , ral:QuickCheck
+    , fin:QuickCheck
+    , bin:QuickCheck
+
+-- Backported version of https://github.com/IntersectMBO/ouroboros-network/pull/5161
+source-repository-package
+   type: git
+   location: https://github.com/IntersectMBO/ouroboros-network
+   tag: b07a86ed853b63881b5a83e57508902f1562ac01
+   --sha256: sha256-n/XX0+cQegq2a1cAfmGx30T64eix4oEXzpVEFCKqmg0=
+   subdir:
+     ouroboros-network-api
+     ouroboros-network

ouroboros-consensus-diffusion/changelog.d/20250919_095435_thomas.bagrel_weighted_chain_selec.md

@@ -0,0 +1,3 @@
+### Breaking
+
+- In module `Ouroboros.Consensus.Node.GSM`, `GSMView` now has a monadic `getCandidateOverSelection :: STM m (selection -> chainSyncState -> CandidateVersusSelection)` instead of the previous pure `candidateOverSelection`. This is due to the fact that chain comparisons now depend on the set of Peras certificates (if Peras is enabled).

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs

@@ -104,10 +104,16 @@ data GsmView m upstreamPeer selection chainSyncState = GsmView
   -- thundering herd phenomenon.
   --
   -- 'Nothing' should only be used for testing.
-  , candidateOverSelection ::
-      selection ->
-      chainSyncState ->
-      CandidateVersusSelection
+  , getCandidateOverSelection ::
+      STM
+        m
+        ( selection ->
+          chainSyncState ->
+          CandidateVersusSelection
+        )
+  -- ^ Whether the candidate from the @chainSyncState@ is preferable to the
+  -- selection. This can depend on external state (Peras certificates boosting
+  -- blocks).
   , peerIsIdle :: chainSyncState -> Bool
   , durationUntilTooOld :: Maybe (selection -> m DurationFromNow)
   -- ^ How long from now until the selection will be so old that the node
@@ -234,7 +240,7 @@ realGsmEntryPoints tracerArgs gsmView =
 
   GsmView
     { antiThunderingHerd
-    , candidateOverSelection
+    , getCandidateOverSelection
     , peerIsIdle
     , durationUntilTooOld
     , equivalent
@@ -383,6 +389,7 @@ realGsmEntryPoints tracerArgs gsmView =
     -- long.
     selection <- getCurrentSelection
     candidates <- traverse StrictSTM.readTVar varsState
+    candidateOverSelection <- getCandidateOverSelection
     let ok candidate =
           WhetherCandidateIsBetter False
             == candidateOverSelection selection candidate

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs

@@ -271,15 +271,18 @@ initNodeKernel
               gsmTracerArgs
               GSM.GsmView
                 { GSM.antiThunderingHerd = Just gsmAntiThunderingHerd
-                , GSM.candidateOverSelection = \(headers, _lst) state ->
-                    case AF.intersectionPoint headers (csCandidate state) of
-                      Nothing -> GSM.CandidateDoesNotIntersect
-                      Just{} ->
-                        GSM.WhetherCandidateIsBetter $ -- precondition requires intersection
-                          preferAnchoredCandidate
-                            (configBlock cfg)
-                            headers
-                            (csCandidate state)
+                , GSM.getCandidateOverSelection = do
+                    weights <- ChainDB.getPerasWeightSnapshot chainDB
+                    pure $ \(headers, _lst) state ->
+                      case AF.intersectionPoint headers (csCandidate state) of
+                        Nothing -> GSM.CandidateDoesNotIntersect
+                        Just{} ->
+                          GSM.WhetherCandidateIsBetter $ -- precondition requires intersection
+                            preferAnchoredCandidate
+                              (configBlock cfg)
+                              (forgetFingerprint weights)
+                              headers
+                              (csCandidate state)
                 , GSM.peerIsIdle = csIdling
                 , GSM.durationUntilTooOld =
                     gsmDurationUntilTooOld

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs

@@ -137,7 +137,8 @@ setupGsm isHaaSatisfied vars = do
     (id, tracer)
     GSM.GsmView
       { GSM.antiThunderingHerd = Nothing
-      , GSM.candidateOverSelection = \s (PeerState c _) -> candidateOverSelection s c
+      , GSM.getCandidateOverSelection = pure $ \s (PeerState c _) ->
+          candidateOverSelection s c
       , GSM.peerIsIdle = isIdling
       , GSM.durationUntilTooOld = Just durationUntilTooOld
       , GSM.equivalent = (==) -- unsound, but harmless in this test

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE/CaughtUp.hs

@@ -58,6 +58,7 @@ import qualified Ouroboros.Consensus.Node.GSM as GSM
 import Ouroboros.Consensus.Node.Genesis (setGetLoEFragment)
 import Ouroboros.Consensus.Node.GsmState
 import Ouroboros.Consensus.NodeId
+import Ouroboros.Consensus.Peras.Weight (emptyPerasWeightSnapshot)
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as Punishment
@@ -279,7 +280,7 @@ mkGsmEntryPoints varChainSyncHandles chainDB writeGsmState =
   GSM.realGsmEntryPoints
     (id, nullTracer)
     GSM.GsmView
-      { GSM.candidateOverSelection
+      { GSM.getCandidateOverSelection = pure candidateOverSelection
       , GSM.peerIsIdle = csIdling
       , GSM.equivalent = (==) `on` AF.headPoint
       , GSM.getChainSyncStates = fmap cschState <$> cschcMap varChainSyncHandles
@@ -301,10 +302,13 @@ mkGsmEntryPoints varChainSyncHandles chainDB writeGsmState =
       Just{} ->
         -- precondition requires intersection
         GSM.WhetherCandidateIsBetter $
-          preferAnchoredCandidate (configBlock cfg) selection candFrag
+          preferAnchoredCandidate (configBlock cfg) weights selection candFrag
    where
     candFrag = csCandidate candidateState
 
+    -- TODO https://github.com/tweag/cardano-peras/issues/67
+    weights = emptyPerasWeightSnapshot
+
 forkGDD ::
   forall m.
   IOLike m =>

ouroboros-consensus/bench/PerasCertDB-bench/Main.hs

@@ -1,9 +1,10 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- | This module contains benchmarks for Peras chain weight calculation as
---   implemented by the by the
---   'Ouroboros.Consensus.Peras.Weight.weightBoostOfFragment' function.
+--   implemented in the 'Ouroboros.Consensus.Peras.Weight' module.
 --
 --   We benchmark the calculation on a static sequence of chain fragments of
 --   increasing length, ranging from 0 to 'fragmentMaxLength', with a step size
@@ -12,13 +13,16 @@
 --   with weight 'boostWeight'. All parameters are set in 'benchmarkParams'.
 module Main (main) where
 
+import Cardano.Ledger.BaseTypes.NonZero (knownNonZeroBounded)
 import Data.List (iterate')
 import Data.Word (Word64)
 import Numeric.Natural (Natural)
 import Ouroboros.Consensus.Block (PerasWeight (PerasWeight), SlotNo (..))
+import Ouroboros.Consensus.Config.SecurityParam
 import Ouroboros.Consensus.Peras.Weight
   ( PerasWeightSnapshot
   , mkPerasWeightSnapshot
+  , takeVolatileSuffix
   , weightBoostOfFragment
   )
 import Ouroboros.Network.AnchoredFragment qualified as AF
@@ -65,7 +69,11 @@ benchmarkParams =
 
 main :: IO ()
 main =
-  Test.Tasty.Bench.defaultMain $ map benchWeightBoostOfFragment inputs
+  Test.Tasty.Bench.defaultMain $
+    concat
+      [ map benchWeightBoostOfFragment inputs
+      , map benchTakeVolatileSuffix inputs
+      ]
  where
   -- NOTE: we do not use the 'env' combinator to set up the test data since
   --       it requires 'NFData' for 'AF.AnchoredFragment'. While the necessary
@@ -84,6 +92,14 @@ benchWeightBoostOfFragment (i, (weightSnapshot, fragment)) =
   bench ("weightBoostOfFragment of length " <> show i) $
     whnf (weightBoostOfFragment weightSnapshot) fragment
 
+benchTakeVolatileSuffix ::
+  (Natural, (PerasWeightSnapshot TestBlock, AF.AnchoredFragment TestBlock)) -> Benchmark
+benchTakeVolatileSuffix (i, (weightSnapshot, fragment)) =
+  bench ("takeVolatileSuffix of length " <> show i) $
+    whnf (takeVolatileSuffix weightSnapshot k) fragment
+ where
+  k = SecurityParam $ knownNonZeroBounded @2160
+
 -- | An infinite list of chain fragments
 fragments :: [AF.AnchoredFragment TestBlock]
 fragments = iterate' addSuccessorBlock genesisFragment

ouroboros-consensus/changelog.d/20250917_144846_nicolas.bacquey_weighted_chain_selec.md

@@ -0,0 +1,7 @@
+### Breaking
+
+- Make the `ChainDB` aware of the `PerasCertDB`, and modify the chain selection function accordingly. In practice, it means that the candidate fragment is now selected based on its Peras weight, instead of its length.
+
+  Note that if Peras is disabled (which is the default), there is no observable difference.
+
+- Add module `Ouroboros.Consensus.Peras.SelectView`, which introduces a `WeightedSelectView` to correctly measure the length of a chain fragment.

ouroboros-consensus/ouroboros-consensus.cabal

@@ -198,6 +198,7 @@ library
     Ouroboros.Consensus.Node.Run
     Ouroboros.Consensus.Node.Serialisation
     Ouroboros.Consensus.NodeId
+    Ouroboros.Consensus.Peras.SelectView
     Ouroboros.Consensus.Peras.Weight
     Ouroboros.Consensus.Protocol.Abstract
     Ouroboros.Consensus.Protocol.BFT
@@ -278,6 +279,7 @@ library
     Ouroboros.Consensus.TypeFamilyWrappers
     Ouroboros.Consensus.Util
     Ouroboros.Consensus.Util.AnchoredFragment
+    Ouroboros.Consensus.Util.AnchoredSeq
     Ouroboros.Consensus.Util.Args
     Ouroboros.Consensus.Util.Assert
     Ouroboros.Consensus.Util.CBOR
@@ -905,6 +907,7 @@ benchmark PerasCertDB-bench
   other-modules:
   build-depends:
     base,
+    cardano-ledger-core,
     ouroboros-consensus,
     ouroboros-network-api,
     tasty-bench,

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs

@@ -3,24 +3,42 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..)) where
+module Ouroboros.Consensus.Config.SecurityParam
+  ( SecurityParam (..)
+  , maxRollbackWeight
+  ) where
 
 import Cardano.Binary
 import Cardano.Ledger.BaseTypes.NonZero
 import Data.Word
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks)
+import Ouroboros.Consensus.Block.SupportsPeras (PerasWeight (..))
 import Quiet
 
 -- | Protocol security parameter
 --
--- We interpret this as the number of rollbacks we support.
+-- In longest-chain protocols, we interpret this as the number of rollbacks we
+-- support.
 --
 -- i.e., k == 1: we can roll back at most one block
 --       k == 2: we can roll back at most two blocks, etc
 --
 -- NOTE: This talks about the number of /blocks/ we can roll back, not
 -- the number of /slots/.
+--
+-- In weightiest-chain protocols (such as Ouroboros Peras), we interpret this as
+-- the maximum amount of weight we can roll back. Here, the total weight of a
+-- chain (fragment) is defined to be its length plus the sum of all weight
+-- boosts given to some of its blocks on the chain (fragment).
+--
+-- i.e. k == 30: we can roll back at most 30 unweighted blocks, or two blocks
+-- each having additional weight 14. In the latter case, the chain fragment has
+-- total weight @2 + 2 * 14 = 30@.
 newtype SecurityParam = SecurityParam {maxRollbacks :: NonZero Word64}
   deriving (Eq, Generic, NoThunks, ToCBOR, FromCBOR)
   deriving Show via Quiet SecurityParam
+
+-- | The maximum amount of weight we can roll back.
+maxRollbackWeight :: SecurityParam -> PerasWeight
+maxRollbackWeight = PerasWeight . unNonZero . maxRollbacks

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs

@@ -35,6 +35,7 @@ module Ouroboros.Consensus.Fragment.Diff
 import Data.Word (Word64)
 import GHC.Stack (HasCallStack)
 import Ouroboros.Consensus.Block
+import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Network.AnchoredFragment
   ( AnchoredFragment
   , AnchoredSeq (..)
@@ -73,12 +74,31 @@ getTip = castPoint . AF.headPoint . getSuffix
 getAnchorPoint :: ChainDiff b -> Point b
 getAnchorPoint = castPoint . AF.anchorPoint . getSuffix
 
--- | Return 'True' iff applying the 'ChainDiff' to a chain @C@ will result in
--- a chain shorter than @C@, i.e., the number of blocks to roll back is
--- greater than the length of the new elements in the suffix to add.
-rollbackExceedsSuffix :: HasHeader b => ChainDiff b -> Bool
-rollbackExceedsSuffix (ChainDiff nbRollback suffix) =
-  nbRollback > fromIntegral (AF.length suffix)
+-- | Return 'True' iff applying the 'ChainDiff' to the given chain @C@ will
+-- result in a chain with less weight than @C@, i.e., the suffix of @C@ to roll
+-- back has more weight than suffix is adding.
+rollbackExceedsSuffix ::
+  forall b0 b1 b2.
+  ( HasHeader b0
+  , HasHeader b1
+  , HasHeader b2
+  , HeaderHash b0 ~ HeaderHash b1
+  , HeaderHash b0 ~ HeaderHash b2
+  ) =>
+  PerasWeightSnapshot b0 ->
+  -- | The chain @C@ the diff is applied to.
+  AnchoredFragment b1 ->
+  ChainDiff b2 ->
+  Bool
+rollbackExceedsSuffix weights curChain (ChainDiff nbRollback suffix) =
+  weightOf suffixToRollBack > weightOf suffix
+ where
+  suffixToRollBack = AF.anchorNewest nbRollback curChain
+
+  weightOf ::
+    (HasHeader b, HeaderHash b ~ HeaderHash b0) =>
+    AnchoredFragment b -> PerasWeight
+  weightOf = totalWeightOfFragment weights
 
 {-------------------------------------------------------------------------------
   Constructors

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/ValidatedDiff.hs

@@ -13,7 +13,6 @@ module Ouroboros.Consensus.Fragment.ValidatedDiff
   , getChainDiff
   , getLedger
   , new
-  , rollbackExceedsSuffix
   , toValidatedFragment
 
     -- * Monadic
@@ -96,9 +95,6 @@ toValidatedFragment ::
 toValidatedFragment (UnsafeValidatedChainDiff cs l) =
   VF.ValidatedFragment (Diff.getSuffix cs) l
 
-rollbackExceedsSuffix :: HasHeader b => ValidatedChainDiff b l -> Bool
-rollbackExceedsSuffix = Diff.rollbackExceedsSuffix . getChainDiff
-
 {-------------------------------------------------------------------------------
   Monadic
 -------------------------------------------------------------------------------}