diff --git a/cabal.project b/cabal.project
index 4f197ec5dc..3f7ef26e1f 100644
--- a/cabal.project
+++ b/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
diff --git a/ouroboros-consensus-diffusion/changelog.d/20250919_095435_thomas.bagrel_weighted_chain_selec.md b/ouroboros-consensus-diffusion/changelog.d/20250919_095435_thomas.bagrel_weighted_chain_selec.md
new file mode 100644
index 0000000000..f9361ba9d0
--- /dev/null
+++ b/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).
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs
index aa9733d360..780602118b 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs
+++ b/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
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index f962a1b6ca..1c45c68155 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
+++ b/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
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs
index 4f223c42e1..44a57f4c32 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs
+++ b/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
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE/CaughtUp.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE/CaughtUp.hs
index fe7383c0f4..a58923bd60 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE/CaughtUp.hs
+++ b/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 =>
diff --git a/ouroboros-consensus/bench/PerasCertDB-bench/Main.hs b/ouroboros-consensus/bench/PerasCertDB-bench/Main.hs
index c869365158..e2fe354903 100644
--- a/ouroboros-consensus/bench/PerasCertDB-bench/Main.hs
+++ b/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
diff --git a/ouroboros-consensus/changelog.d/20250917_144846_nicolas.bacquey_weighted_chain_selec.md b/ouroboros-consensus/changelog.d/20250917_144846_nicolas.bacquey_weighted_chain_selec.md
new file mode 100644
index 0000000000..f9225fa24c
--- /dev/null
+++ b/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.
diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
index 9396b428bb..5f2cd98720 100644
--- a/ouroboros-consensus/ouroboros-consensus.cabal
+++ b/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,
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs
index bebe022e8d..ce06787e5b 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs
+++ b/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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs
index 1521969d44..1cd42db9de 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs
+++ b/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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/ValidatedDiff.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/ValidatedDiff.hs
index 0d31d8f3fe..0a18a54308 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/ValidatedDiff.hs
+++ b/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
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs
index bdf45723e0..a630e3d104 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs
@@ -33,6 +33,7 @@ import Ouroboros.Consensus.Ledger.SupportsProtocol
   )
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CSClient
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as CSJumping
+import Ouroboros.Consensus.Peras.Weight (PerasWeightSnapshot)
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( AddBlockPromise
   , ChainDB
@@ -45,14 +46,15 @@ import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunis
 import Ouroboros.Consensus.Util.AnchoredFragment
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.Orphans ()
+import Ouroboros.Consensus.Util.STM
 import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import Ouroboros.Network.Block (MaxSlotNo)
 import Ouroboros.Network.BlockFetch.ConsensusInterface
   ( BlockFetchConsensusInterface (..)
+  , ChainComparison (..)
   , ChainSelStarvation
   , FetchMode (..)
-  , FromConsensus (..)
   , PraosFetchMode (..)
   , mkReadFetchMode
   )
@@ -66,6 +68,7 @@ data ChainDbView m blk = ChainDbView
   , getMaxSlotNo :: STM m MaxSlotNo
   , addBlockAsync :: InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
   , getChainSelStarvation :: STM m ChainSelStarvation
+  , getPerasWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
   }
 
 defaultChainDbView :: ChainDB m blk -> ChainDbView m blk
@@ -77,6 +80,7 @@ defaultChainDbView chainDB =
     , getMaxSlotNo = ChainDB.getMaxSlotNo chainDB
     , addBlockAsync = ChainDB.addBlockAsync chainDB
     , getChainSelStarvation = ChainDB.getChainSelStarvation chainDB
+    , getPerasWeightSnapshot = ChainDB.getPerasWeightSnapshot chainDB
     }
 
 readFetchModeDefault ::
@@ -226,6 +230,16 @@ mkBlockFetchConsensusInterface
     readFetchedMaxSlotNo :: STM m MaxSlotNo
     readFetchedMaxSlotNo = getMaxSlotNo chainDB
 
+    readChainComparison :: STM m (WithFingerprint (ChainComparison (HeaderWithTime blk)))
+    readChainComparison =
+      fmap mkChainComparison <$> getPerasWeightSnapshot chainDB
+     where
+      mkChainComparison weights =
+        ChainComparison
+          { plausibleCandidateChain = plausibleCandidateChain weights
+          , compareCandidateChains = compareCandidateChains weights
+          }
+
     -- Note that @ours@ comes from the ChainDB and @cand@ from the ChainSync
     -- client.
     --
@@ -241,10 +255,11 @@ mkBlockFetchConsensusInterface
     -- fragment, our current chain might have changed.
     plausibleCandidateChain ::
       HasCallStack =>
+      PerasWeightSnapshot blk ->
       AnchoredFragment (HeaderWithTime blk) ->
       AnchoredFragment (HeaderWithTime blk) ->
       Bool
-    plausibleCandidateChain ours cand
+    plausibleCandidateChain weights ours cand =
       -- 1. The ChainDB maintains the invariant that the anchor of our fragment
       --    corresponds to the immutable tip.
       --
@@ -258,52 +273,27 @@ mkBlockFetchConsensusInterface
       --    point. This means that we are no longer guaranteed that the
       --    precondition holds.
       --
-      -- 4. Our chain's anchor can only move forward. We can detect this by
-      --    looking at the block/slot numbers of the anchors: When the anchor
-      --    advances, either the block number increases (usual case), or the
-      --    block number stays the same, but the slot number increases (EBB
-      --    case).
-      --
-      | anchorBlockNoAndSlot cand < anchorBlockNoAndSlot ours -- (4)
-        =
-          case (AF.null ours, AF.null cand) of
-            -- Both are non-empty, the precondition trivially holds.
-            (False, False) -> preferAnchoredCandidate bcfg ours cand
-            -- The candidate is shorter than our chain and, worse, we'd have to
-            -- roll back past our immutable tip (the anchor of @cand@).
-            (_, True) -> False
-            -- As argued above we can only reach this case when our chain's anchor
-            -- has changed (4).
-            --
-            -- It is impossible for our chain to change /and/ still be empty: the
-            -- anchor of our chain only changes when a new block becomes
-            -- immutable. For a new block to become immutable, we must have
-            -- extended our chain with at least @k + 1@ blocks. Which means our
-            -- fragment can't be empty.
-            (True, _) -> error "impossible"
-      | otherwise =
-          preferAnchoredCandidate bcfg ours cand
-     where
-      anchorBlockNoAndSlot ::
-        AnchoredFragment (HeaderWithTime blk) ->
-        (WithOrigin BlockNo, WithOrigin SlotNo)
-      anchorBlockNoAndSlot frag =
-        (AF.anchorToBlockNo a, AF.anchorToSlotNo a)
-       where
-        a = AF.anchor frag
+      -- 4. Therefore, we check whether the candidate fragments still intersects
+      --    with our fragment; if not, then it is only a matter of time until the
+      --    ChainSync client disconnects from that peer.
+      case AF.intersectionPoint ours cand of
+        -- REVIEW: Hmm, maybe we want to change 'preferAnchoredCandidates' to
+        -- also just return 'False' in this case (and we remove the
+        -- precondition).
+        Nothing -> False
+        Just _ -> preferAnchoredCandidate bcfg weights ours cand
 
     compareCandidateChains ::
+      PerasWeightSnapshot blk ->
       AnchoredFragment (HeaderWithTime blk) ->
       AnchoredFragment (HeaderWithTime blk) ->
       Ordering
     compareCandidateChains = compareAnchoredFragments bcfg
 
-    headerForgeUTCTime :: FromConsensus (HeaderWithTime blk) -> STM m UTCTime
+    headerForgeUTCTime :: HeaderWithTime blk -> UTCTime
     headerForgeUTCTime =
-      pure
-        . fromRelativeTime (SupportsNode.getSystemStart bcfg)
+      fromRelativeTime (SupportsNode.getSystemStart bcfg)
         . hwtSlotRelativeTime
-        . unFromConsensus
 
     readChainSelStarvation = getChainSelStarvation chainDB
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
index ec16c91eca..fcb0e25388 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
@@ -124,6 +124,7 @@ import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as Ju
 import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
 import Ouroboros.Consensus.Node.GsmState (GsmState (..))
 import Ouroboros.Consensus.Node.NetworkProtocolVersion
+import Ouroboros.Consensus.Peras.Weight (emptyPerasWeightSnapshot)
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Storage.ChainDB (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
@@ -1833,7 +1834,12 @@ checkTime cfgEnv dynEnv intEnv =
   checkPreferTheirsOverOurs kis
     | -- Precondition is fulfilled as ourFrag and theirFrag intersect by
       -- construction.
-      preferAnchoredCandidate (configBlock cfg) ourFrag theirFrag =
+      preferAnchoredCandidate
+        (configBlock cfg)
+        -- TODO: remove this entire check, see https://github.com/tweag/cardano-peras/issues/64
+        emptyPerasWeightSnapshot
+        ourFrag
+        theirFrag =
         pure ()
     | otherwise =
         throwSTM $
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/SelectView.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/SelectView.hs
new file mode 100644
index 0000000000..04e4eed8ea
--- /dev/null
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/SelectView.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Ouroboros.Consensus.Peras.SelectView
+  ( -- * 'WeightedSelectView'
+    WeightedSelectView (..)
+  , wsvTotalWeight
+  , weightedSelectView
+
+    -- * Utility: 'WithEmptyFragment'
+  , WithEmptyFragment (..)
+  , withEmptyFragmentFromMaybe
+  , withEmptyFragmentToMaybe
+  ) where
+
+import Data.Function (on)
+import Ouroboros.Consensus.Block
+import Ouroboros.Consensus.Peras.Weight
+import Ouroboros.Consensus.Protocol.Abstract
+import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
+import qualified Ouroboros.Network.AnchoredFragment as AF
+
+{-------------------------------------------------------------------------------
+  Weighted select views
+-------------------------------------------------------------------------------}
+
+-- | Information from a non-empty chain fragment for a weighted chain comparison
+-- against other fragments with the same anchor.
+--
+-- Comparisons of fragments with different anchors are not possible in general,
+-- as the fragments might not intersect, and so some blocks after their
+-- intersection (and hence their weight boost) are unknown.
+data WeightedSelectView proto = WeightedSelectView
+  { wsvBlockNo :: !BlockNo
+  -- ^ The 'BlockNo' at the tip of a fragment.
+  , wsvWeightBoost :: !PerasWeight
+  -- ^ The weight boost of a fragment (w.r.t. a particular anchor).
+  , wsvTiebreaker :: TiebreakerView proto
+  -- ^ Lazy because it is only needed when 'wsvTotalWeight' is inconclusive.
+  }
+
+deriving stock instance Show (TiebreakerView proto) => Show (WeightedSelectView proto)
+deriving stock instance Eq (TiebreakerView proto) => Eq (WeightedSelectView proto)
+
+-- TODO: More type safety to prevent people from accidentally comparing
+-- 'WeightedSelectView's obtained from fragments with different anchors?
+-- Something ST-trick like?
+
+-- | The total weight, ie the sum of 'wsvBlockNo' and 'wsvBoostedWeight'.
+wsvTotalWeight :: WeightedSelectView proto -> PerasWeight
+-- could be cached, but then we need to be careful to maintain the invariant
+wsvTotalWeight wsv =
+  PerasWeight (unBlockNo (wsvBlockNo wsv)) <> wsvWeightBoost wsv
+
+instance Ord (TiebreakerView proto) => Ord (WeightedSelectView proto) where
+  compare =
+    mconcat
+      [ compare `on` wsvTotalWeight
+      , compare `on` wsvTiebreaker
+      ]
+
+instance ChainOrder (TiebreakerView proto) => ChainOrder (WeightedSelectView proto) where
+  type ChainOrderConfig (WeightedSelectView proto) = ChainOrderConfig (TiebreakerView proto)
+
+  preferCandidate cfg ours cand =
+    case compare (wsvTotalWeight ours) (wsvTotalWeight cand) of
+      LT -> True
+      EQ -> preferCandidate cfg (wsvTiebreaker ours) (wsvTiebreaker cand)
+      GT -> False
+
+-- | Get the 'WeightedSelectView' for a fragment using the given
+-- 'PerasWeightSnapshot'. Note that this is only meanigful for comparisons
+-- against other fragments /with the same anchor/.
+--
+-- Returns 'EmptyFragment' iff the input fragment is empty.
+weightedSelectView ::
+  ( GetHeader1 h
+  , HasHeader (h blk)
+  , HeaderHash blk ~ HeaderHash (h blk)
+  , BlockSupportsProtocol blk
+  ) =>
+  BlockConfig blk ->
+  PerasWeightSnapshot blk ->
+  AnchoredFragment (h blk) ->
+  WithEmptyFragment (WeightedSelectView (BlockProtocol blk))
+weightedSelectView bcfg weights = \case
+  AF.Empty{} -> EmptyFragment
+  frag@(_ AF.:> (getHeader1 -> hdr)) ->
+    NonEmptyFragment
+      WeightedSelectView
+        { wsvBlockNo = blockNo hdr
+        , wsvWeightBoost = weightBoostOfFragment weights frag
+        , wsvTiebreaker = tiebreakerView bcfg hdr
+        }
+
+{-------------------------------------------------------------------------------
+  WithEmptyFragment
+-------------------------------------------------------------------------------}
+
+-- | Attach the possibility of an empty fragment to a type.
+data WithEmptyFragment a = EmptyFragment | NonEmptyFragment !a
+  deriving stock (Show, Eq)
+
+withEmptyFragmentToMaybe :: WithEmptyFragment a -> Maybe a
+withEmptyFragmentToMaybe = \case
+  EmptyFragment -> Nothing
+  NonEmptyFragment a -> Just a
+
+withEmptyFragmentFromMaybe :: Maybe a -> WithEmptyFragment a
+withEmptyFragmentFromMaybe = \case
+  Nothing -> EmptyFragment
+  Just a -> NonEmptyFragment a
+
+-- | Prefer non-empty fragments to empty ones.
+instance Ord a => Ord (WithEmptyFragment a) where
+  compare = \cases
+    EmptyFragment EmptyFragment -> EQ
+    EmptyFragment NonEmptyFragment{} -> LT
+    NonEmptyFragment{} EmptyFragment -> GT
+    (NonEmptyFragment a) (NonEmptyFragment b) -> compare a b
+
+-- | Prefer non-empty fragments to empty ones. This instance assumes that the
+-- underlying fragments all have the same anchor.
+instance ChainOrder a => ChainOrder (WithEmptyFragment a) where
+  type ChainOrderConfig (WithEmptyFragment a) = ChainOrderConfig a
+
+  preferCandidate cfg = \cases
+    -- We prefer any non-empty fragment to the empty fragment.
+    EmptyFragment NonEmptyFragment{} -> True
+    -- We never prefer the empty fragment to our selection (even if it is also
+    -- empty).
+    _ EmptyFragment -> False
+    -- Otherwise, defer to @'ChainOrder' a@.
+    (NonEmptyFragment ours) (NonEmptyFragment cand) ->
+      preferCandidate cfg ours cand
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs
index 5e2da40bb7..d122f9da8e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs
@@ -24,9 +24,11 @@ module Ouroboros.Consensus.Peras.Weight
   , prunePerasWeightSnapshot
 
     -- * Query
+  , isEmptyPerasWeightSnapshot
   , weightBoostOfPoint
   , weightBoostOfFragment
   , totalWeightOfFragment
+  , takeVolatileSuffix
   ) where
 
 import Data.Foldable as Foldable (foldl')
@@ -35,6 +37,8 @@ import qualified Data.Map.Strict as Map
 import GHC.Generics (Generic)
 import NoThunks.Class
 import Ouroboros.Consensus.Block
+import Ouroboros.Consensus.Config.SecurityParam
+import Ouroboros.Consensus.Util.AnchoredSeq (takeLongestSuffix)
 import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 
@@ -161,6 +165,28 @@ prunePerasWeightSnapshot slot =
   isTooOld :: Point blk -> Bool
   isTooOld pt = pointSlot pt < NotOrigin slot
 
+-- | Check whether the snapshot contains weights for any blocks.
+--
+-- >>> isEmptyPerasWeightSnapshot emptyPerasWeightSnapshot
+-- True
+--
+-- >>> :{
+-- weights :: [(Point Blk, PerasWeight)]
+-- weights =
+--   [ (BlockPoint 2 "foo", PerasWeight 2)
+--   , (GenesisPoint,       PerasWeight 3)
+--   , (BlockPoint 3 "bar", PerasWeight 2)
+--   , (BlockPoint 2 "foo", PerasWeight 2)
+--   ]
+-- :}
+--
+-- >>> snap = mkPerasWeightSnapshot weights
+--
+-- >>> isEmptyPerasWeightSnapshot snap
+-- False
+isEmptyPerasWeightSnapshot :: PerasWeightSnapshot blk -> Bool
+isEmptyPerasWeightSnapshot = Map.null . getPerasWeightSnapshot
+
 -- | Get the weight boost for a point, or @'mempty' :: 'PerasWeight'@ otherwise.
 --
 -- >>> :{
@@ -291,9 +317,70 @@ totalWeightOfFragment weightSnap frag =
   weightLength = PerasWeight $ fromIntegral $ AF.length frag
   weightBoost = weightBoostOfFragment weightSnap frag
 
+-- | Take the longest suffix of the given fragment with total weight
+-- ('totalWeightOfFragment') at most @k@. This is the volatile suffix of blocks
+-- which are subject to rollback.
+--
+-- If the total weight of the input fragment is at least @k@, then the anchor of
+-- the output fragment is the most recent point on the input fragment that is
+-- buried under at least weight @k@ (also counting the weight boost of that
+-- point).
+--
+-- See 'mkPerasWeightSnapshot' for context.
+--
+-- >>> :{
+-- weights :: [(Point Blk, PerasWeight)]
+-- weights =
+--   [ (BlockPoint 2 "foo", PerasWeight 2)
+--   , (GenesisPoint,       PerasWeight 3)
+--   , (BlockPoint 3 "bar", PerasWeight 2)
+--   , (BlockPoint 2 "foo", PerasWeight 2)
+--   ]
+-- snap = mkPerasWeightSnapshot weights
+-- foo = HeaderFields (SlotNo 2) (BlockNo 1) "foo"
+-- bar = HeaderFields (SlotNo 3) (BlockNo 2) "bar"
+-- frag :: AnchoredFragment (HeaderFields Blk)
+-- frag = Empty AnchorGenesis :> foo :> bar
+-- :}
+--
+-- >>> k1 = SecurityParam $ knownNonZeroBounded @1
+-- >>> k3 = SecurityParam $ knownNonZeroBounded @3
+-- >>> k6 = SecurityParam $ knownNonZeroBounded @6
+-- >>> k9 = SecurityParam $ knownNonZeroBounded @9
+--
+-- >>> AF.toOldestFirst $ takeVolatileSuffix snap k1 frag
+-- []
+--
+-- >>> AF.toOldestFirst $ takeVolatileSuffix snap k3 frag
+-- [HeaderFields {headerFieldSlot = SlotNo 3, headerFieldBlockNo = BlockNo 2, headerFieldHash = "bar"}]
+--
+-- >>> AF.toOldestFirst $ takeVolatileSuffix snap k6 frag
+-- [HeaderFields {headerFieldSlot = SlotNo 3, headerFieldBlockNo = BlockNo 2, headerFieldHash = "bar"}]
+--
+-- >>> AF.toOldestFirst $ takeVolatileSuffix snap k9 frag
+-- [HeaderFields {headerFieldSlot = SlotNo 2, headerFieldBlockNo = BlockNo 1, headerFieldHash = "foo"},HeaderFields {headerFieldSlot = SlotNo 3, headerFieldBlockNo = BlockNo 2, headerFieldHash = "bar"}]
+takeVolatileSuffix ::
+  forall blk h.
+  (StandardHash blk, HasHeader h, HeaderHash blk ~ HeaderHash h) =>
+  PerasWeightSnapshot blk ->
+  -- | The security parameter @k@ is interpreted as a weight.
+  SecurityParam ->
+  AnchoredFragment h ->
+  AnchoredFragment h
+takeVolatileSuffix snap secParam
+  | Map.null $ getPerasWeightSnapshot snap =
+      -- Optimize the case where Peras is disabled.
+      AF.anchorNewest (unPerasWeight k)
+  | otherwise =
+      takeLongestSuffix (totalWeightOfFragment snap) (<= k)
+ where
+  k :: PerasWeight
+  k = maxRollbackWeight secParam
+
 -- $setup
 -- >>> import Cardano.Ledger.BaseTypes
 -- >>> import Ouroboros.Consensus.Block
+-- >>> import Ouroboros.Consensus.Config.SecurityParam
 -- >>> import Ouroboros.Network.AnchoredFragment (AnchoredFragment, AnchoredSeq(..), Anchor(..))
 -- >>> import qualified Ouroboros.Network.AnchoredFragment as AF
 -- >>> :set -XDataKinds -XTypeApplications -XTypeFamilies
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs
index 341a916495..676f01f023 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs
@@ -9,9 +9,9 @@ module Ouroboros.Consensus.Protocol.MockChainSel
 import Data.List (sortOn)
 import Data.Maybe (listToMaybe, mapMaybe)
 import Data.Ord (Down (..))
+import Ouroboros.Consensus.Peras.SelectView (WeightedSelectView (..), WithEmptyFragment (..))
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Network.Mock.Chain (Chain)
-import qualified Ouroboros.Network.Mock.Chain as Chain
 
 {-------------------------------------------------------------------------------
   Chain selection
@@ -33,8 +33,9 @@ selectChain ::
   forall proxy p hdr l.
   ConsensusProtocol p =>
   proxy p ->
-  ChainOrderConfig (SelectView p) ->
-  (hdr -> SelectView p) ->
+  ChainOrderConfig (WeightedSelectView p) ->
+  -- | Compute the 'WeightedSelectView' of a chain.
+  (Chain hdr -> WithEmptyFragment (WeightedSelectView p)) ->
   -- | Our chain
   Chain hdr ->
   -- | Upstream chains
@@ -51,24 +52,19 @@ selectChain _ cfg view ours =
   -- extract the 'SelectView' of the tip of the candidate.
   selectPreferredCandidate ::
     (Chain hdr, l) ->
-    Maybe (SelectView p, (Chain hdr, l))
-  selectPreferredCandidate x@(cand, _) =
-    case (Chain.head ours, Chain.head cand) of
-      (Nothing, Just candTip) ->
-        Just (view candTip, x)
-      (Just ourTip, Just candTip)
-        | let candView = view candTip
-        , preferCandidate cfg (view ourTip) candView ->
-            Just (candView, x)
-      _otherwise ->
-        Nothing
+    Maybe (WithEmptyFragment (WeightedSelectView p), (Chain hdr, l))
+  selectPreferredCandidate x@(cand, _)
+    | let candView = view cand
+    , preferCandidate cfg (view ours) candView =
+        Just (candView, x)
+    | otherwise = Nothing
 
 -- | Chain selection on unvalidated chains
 selectUnvalidatedChain ::
   ConsensusProtocol p =>
   proxy p ->
-  ChainOrderConfig (SelectView p) ->
-  (hdr -> SelectView p) ->
+  ChainOrderConfig (WeightedSelectView p) ->
+  (Chain hdr -> WithEmptyFragment (WeightedSelectView p)) ->
   Chain hdr ->
   [Chain hdr] ->
   Maybe (Chain hdr)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
index 303fbcf78e..8b89764c2c 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
@@ -25,6 +25,10 @@ module Ouroboros.Consensus.Storage.ChainDB.API
   , addBlockWaitWrittenToDisk
   , addBlock_
 
+    -- * Adding a Peras certificate
+  , AddPerasCertPromise (..)
+  , addPerasCertSync
+
     -- * Trigger chain selection
   , ChainSelectionPromise (..)
   , triggerChainSelection
@@ -83,6 +87,7 @@ import Ouroboros.Consensus.HeaderStateHistory
 import Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Extended
+import Ouroboros.Consensus.Peras.Weight (PerasWeightSnapshot)
 import Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
 import Ouroboros.Consensus.Storage.Common
 import Ouroboros.Consensus.Storage.LedgerDB
@@ -90,6 +95,7 @@ import Ouroboros.Consensus.Storage.LedgerDB
   , ReadOnlyForker'
   , Statistics
   )
+import Ouroboros.Consensus.Storage.PerasCertDB.API (PerasCertSnapshot)
 import Ouroboros.Consensus.Storage.Serialisation
 import Ouroboros.Consensus.Util.CallStack
 import Ouroboros.Consensus.Util.IOLike
@@ -188,6 +194,10 @@ data ChainDB m blk = ChainDB
   --
   -- NOTE: A direct consequence of this guarantee is that the anchor of the
   -- fragment will move as the chain grows.
+  --
+  -- Note that with Ouroboros Peras, the size of this fragment is defined in
+  -- terms /weight/ instead of /length/, see
+  -- 'Ouroboros.Consensus.Peras.Weight.takeVolatileSuffix'.
   , getCurrentChainWithTime ::
       STM m (AnchoredFragment (HeaderWithTime blk))
   -- ^ Exact same as 'getCurrentChain', except each header is annotated
@@ -386,6 +396,15 @@ data ChainDB m blk = ChainDB
   , getStatistics :: m (Maybe Statistics)
   -- ^ Get statistics from the LedgerDB, in particular the number of entries
   -- in the tables.
+  , addPerasCertAsync :: ValidatedPerasCert blk -> m (AddPerasCertPromise m)
+  -- ^ Asynchronously insert a certificate to the DB. If this leads to a fork to
+  -- be weightier than our current selection, this will trigger a fork switch.
+  , getPerasWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
+  -- ^ Get the 'PerasWeightSnapshot', representing the Peras weight boosts for
+  -- all blocks newer than the current immutable tip.
+  , getPerasCertSnapshot :: STM m (PerasCertSnapshot blk)
+  -- ^ Get the Peras certificate snapshot, containing the currently-known
+  -- certificates boosting blocks newer than the immutable tip.
   , closeDB :: m ()
   -- ^ Close the ChainDB
   --
@@ -505,6 +524,23 @@ triggerChainSelection :: IOLike m => ChainDB m blk -> m ()
 triggerChainSelection chainDB =
   waitChainSelectionPromise =<< chainSelAsync chainDB
 
+{-------------------------------------------------------------------------------
+  Adding a Peras certificate
+-------------------------------------------------------------------------------}
+
+newtype AddPerasCertPromise m = AddPerasCertPromise
+  { waitPerasCertProcessed :: m ()
+  -- ^ Wait until the Peras certificate has been processed (which potentially
+  -- includes switching to a different chain). If the PerasCertDB did already
+  -- contain a certificate for this round, the certificate is ignored (as the
+  -- two certificates must be identical because certificate equivocation is
+  -- impossible).
+  }
+
+addPerasCertSync :: IOLike m => ChainDB m blk -> ValidatedPerasCert blk -> m ()
+addPerasCertSync chainDB cert =
+  waitPerasCertProcessed =<< addPerasCertAsync chainDB cert
+
 {-------------------------------------------------------------------------------
   Serialised block/header with its point
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs
index e5f7b21014..a49173a15a 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs
@@ -16,6 +16,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl
     -- * Trace types
   , SelectionChangedInfo (..)
   , TraceAddBlockEvent (..)
+  , TraceAddPerasCertEvent (..)
   , TraceChainSelStarvationEvent (..)
   , TraceCopyToImmutableDBEvent (..)
   , TraceEvent (..)
@@ -79,6 +80,7 @@ import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import qualified Ouroboros.Consensus.Storage.ImmutableDB.Stream as ImmutableDB
 import Ouroboros.Consensus.Storage.LedgerDB (LedgerSupportsLedgerDB)
 import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
+import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util (newFuse, whenJust, withFuse)
 import Ouroboros.Consensus.Util.Args
@@ -173,12 +175,15 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
         ledgerDbGetVolatileSuffix
     traceWith tracer $ TraceOpenEvent OpenedLgrDB
 
+    perasCertDB <- PerasCertDB.openDB argsPerasCertDB
+
     varInvalid <- newTVarIO (WithFingerprint Map.empty (Fingerprint 0))
 
     let initChainSelTracer = TraceInitChainSelEvent >$< tracer
 
     traceWith initChainSelTracer StartedInitChainSelection
     initialLoE <- Args.cdbsLoE cdbSpecificArgs
+    initialWeights <- atomically $ PerasCertDB.getWeightSnapshot perasCertDB
     chain <- withRegistry $ \rr -> do
       chainAndLedger <-
         ChainSel.initialChainSelection
@@ -190,6 +195,7 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
           (Args.cdbsTopLevelConfig cdbSpecificArgs)
           varInvalid
           (void initialLoE)
+          (forgetFingerprint initialWeights)
       traceWith initChainSelTracer InitialChainSelected
 
       let chain = VF.validatedFragment chainAndLedger
@@ -250,6 +256,7 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
             , cdbChainSelQueue = chainSelQueue
             , cdbLoE = Args.cdbsLoE cdbSpecificArgs
             , cdbChainSelStarvation = varChainSelStarvation
+            , cdbPerasCertDB = perasCertDB
             }
 
     setGetCurrentChainForLedgerDB $ Query.getCurrentChain env
@@ -280,6 +287,9 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
             , getHeaderStateHistory = getEnvSTM h Query.getHeaderStateHistory
             , getReadOnlyForkerAtPoint = getEnv2 h Query.getReadOnlyForkerAtPoint
             , getStatistics = getEnv h Query.getStatistics
+            , addPerasCertAsync = getEnv1 h ChainSel.addPerasCertAsync
+            , getPerasWeightSnapshot = getEnvSTM h Query.getPerasWeightSnapshot
+            , getPerasCertSnapshot = getEnvSTM h Query.getPerasCertSnapshot
             }
     addBlockTestFuse <- newFuse "test chain selection"
     copyTestFuse <- newFuse "test copy to immutable db"
@@ -310,7 +320,12 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
   return ((chainDB, testing), env)
  where
   tracer = Args.cdbsTracer cdbSpecificArgs
-  Args.ChainDbArgs argsImmutableDb argsVolatileDb argsLgrDb cdbSpecificArgs = args
+  Args.ChainDbArgs
+    argsImmutableDb
+    argsVolatileDb
+    argsLgrDb
+    argsPerasCertDB
+    cdbSpecificArgs = args
 
   -- The LedgerDB requires a criterion ('LedgerDB.GetVolatileSuffix')
   -- determining which of its states are volatile/immutable. Once we have
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs
index a5b95d537d..0308b66dc3 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs
@@ -44,6 +44,7 @@ import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Backend as LedgerDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
+import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util.Args
 import Ouroboros.Consensus.Util.IOLike
@@ -57,6 +58,7 @@ data ChainDbArgs f m blk = ChainDbArgs
   { cdbImmDbArgs :: ImmutableDB.ImmutableDbArgs f m blk
   , cdbVolDbArgs :: VolatileDB.VolatileDbArgs f m blk
   , cdbLgrDbArgs :: LedgerDB.LedgerDbArgs f m blk
+  , cdbPerasCertDbArgs :: PerasCertDB.PerasCertDbArgs f m blk
   , cdbsArgs :: ChainDbSpecificArgs f m blk
   }
 
@@ -145,6 +147,7 @@ defaultArgs =
     ImmutableDB.defaultArgs
     VolatileDB.defaultArgs
     (LedgerDB.defaultArgs $ LedgerDB.SomeBackendArgs InMemory.InMemArgs)
+    PerasCertDB.defaultArgs
     defaultSpecificArgs
 
 ensureValidateAll ::
@@ -216,6 +219,10 @@ completeChainDbArgs
             , LedgerDB.lgrBackendArgs = flavorArgs
             , LedgerDB.lgrRegistry = registry
             }
+      , cdbPerasCertDbArgs =
+          PerasCertDB.PerasCertDbArgs
+            { PerasCertDB.pcdbaTracer = PerasCertDB.pcdbaTracer (cdbPerasCertDbArgs defArgs)
+            }
       , cdbsArgs =
           (cdbsArgs defArgs)
             { cdbsRegistry = registry
@@ -233,6 +240,8 @@ updateTracer trcr args =
     { cdbImmDbArgs = (cdbImmDbArgs args){ImmutableDB.immTracer = TraceImmutableDBEvent >$< trcr}
     , cdbVolDbArgs = (cdbVolDbArgs args){VolatileDB.volTracer = TraceVolatileDBEvent >$< trcr}
     , cdbLgrDbArgs = (cdbLgrDbArgs args){LedgerDB.lgrTracer = TraceLedgerDBEvent >$< trcr}
+    , cdbPerasCertDbArgs =
+        (cdbPerasCertDbArgs args){PerasCertDB.pcdbaTracer = TracePerasCertDbEvent >$< trcr}
     , cdbsArgs = (cdbsArgs args){cdbsTracer = trcr}
     }
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs
index 37cfd65e27..370e66114d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs
@@ -71,6 +71,7 @@ import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.Query as Query
 import Ouroboros.Consensus.Storage.ChainDB.Impl.Types
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
+import qualified Ouroboros.Consensus.Storage.PerasCertDB.API as PerasCertDB
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util
 import Ouroboros.Consensus.Util.Condense
@@ -399,6 +400,7 @@ garbageCollectBlocks CDB{..} slotNo = do
   VolatileDB.garbageCollect cdbVolatileDB slotNo
   atomically $ do
     modifyTVar cdbInvalid $ fmap $ Map.filter ((>= slotNo) . invalidBlockSlotNo)
+  PerasCertDB.garbageCollect cdbPerasCertDB slotNo
   traceWith cdbTracer $ TraceGCEvent $ PerformedGC slotNo
 
 {-------------------------------------------------------------------------------
@@ -632,6 +634,8 @@ addBlockRunner fuse cdb@CDB{..} = forever $ do
                   varBlockProcessed
                   (FailedToAddBlock "Failed to add block synchronously")
               pure ()
+            ChainSelAddPerasCert _cert varProcessed ->
+              void $ tryPutTMVar varProcessed ()
           closeChainSelQueue cdbChainSelQueue
       )
       ( \message -> do
@@ -640,6 +644,10 @@ addBlockRunner fuse cdb@CDB{..} = forever $ do
               trace PoppedReprocessLoEBlocksFromQueue
             ChainSelAddBlock BlockToAdd{blockToAdd} ->
               trace $ PoppedBlockFromQueue $ blockRealPoint blockToAdd
+            ChainSelAddPerasCert cert _varProcessed ->
+              traceWith cdbTracer $
+                TraceAddPerasCertEvent $
+                  PoppedPerasCertFromQueue (getPerasCertRound cert) (getPerasCertBoostedBlock cert)
           chainSelSync cdb message
           lift $ atomically $ processedChainSelMessage cdbChainSelQueue message
       )
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
index 8ac0f6db53..5278133580 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
@@ -13,6 +13,7 @@
 -- adding a block.
 module Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel
   ( addBlockAsync
+  , addPerasCertAsync
   , chainSelSync
   , chainSelectionForBlock
   , initialChainSelection
@@ -37,7 +38,7 @@ import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NE
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (fromJust, isJust)
+import Data.Maybe (fromJust, fromMaybe, isJust)
 import Data.Maybe.Strict (StrictMaybe (..), strictMaybeToMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -63,15 +64,19 @@ import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Extended
 import Ouroboros.Consensus.Ledger.Inspect
 import Ouroboros.Consensus.Ledger.SupportsProtocol
+import Ouroboros.Consensus.Peras.SelectView
+import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( AddBlockPromise (..)
   , AddBlockResult (..)
+  , AddPerasCertPromise
   , BlockComponent (..)
   , ChainType (..)
   , LoE (..)
   )
 import Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
   ( InvalidBlockPunishment
+  , noPunishment
   )
 import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as InvalidBlockPunishment
 import Ouroboros.Consensus.Storage.ChainDB.Impl.BlockCache
@@ -85,10 +90,12 @@ import Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import Ouroboros.Consensus.Storage.LedgerDB hiding (yield)
 import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
+import qualified Ouroboros.Consensus.Storage.PerasCertDB.API as PerasCertDB
 import Ouroboros.Consensus.Storage.VolatileDB (VolatileDB)
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util
 import Ouroboros.Consensus.Util.AnchoredFragment
+import Ouroboros.Consensus.Util.EarlyExit (exitEarly, withEarlyExit_)
 import Ouroboros.Consensus.Util.Enclose (encloseWith)
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.STM (WithFingerprint (..))
@@ -118,6 +125,7 @@ initialChainSelection ::
   TopLevelConfig blk ->
   StrictTVar m (WithFingerprint (InvalidBlocks blk)) ->
   LoE () ->
+  PerasWeightSnapshot blk ->
   m (ChainAndLedger m blk)
 initialChainSelection
   immutableDB
@@ -127,7 +135,8 @@ initialChainSelection
   tracer
   cfg
   varInvalid
-  loE = do
+  loE
+  weights = do
     -- TODO: Improve the user experience by trimming any potential
     -- blocks from the future from the VolatileDB.
     --
@@ -172,7 +181,7 @@ initialChainSelection
     let curChain = Empty (AF.castAnchor i)
     curChainAndLedger <- VF.newM curChain curForker
 
-    case NE.nonEmpty (filter (preferAnchoredCandidate bcfg curChain) chains) of
+    case NE.nonEmpty (filter (preferAnchoredCandidate bcfg weights curChain) chains) of
       -- If there are no candidates, no chain selection is needed
       Nothing -> return curChainAndLedger
       Just chains' ->
@@ -254,7 +263,7 @@ initialChainSelection
     chainSelection' curChainAndLedger candidates =
       atomically (forkerCurrentPoint ledger) >>= \curpt ->
         assert (all ((curpt ==) . castPoint . AF.anchorPoint) candidates) $
-          assert (all (preferAnchoredCandidate bcfg curChain) candidates) $ do
+          assert (all (preferAnchoredCandidate bcfg weights curChain) candidates) $ do
             cse <- chainSelEnv
             chainSelection cse rr (Diff.extend <$> candidates)
      where
@@ -269,6 +278,7 @@ initialChainSelection
             , bcfg
             , varInvalid
             , blockCache = BlockCache.empty
+            , weights
             , curChain
             , validationTracer = InitChainSelValidation >$< tracer
             , -- initial chain selection is not concerned about pipelining
@@ -314,6 +324,15 @@ addBlockAsync ::
 addBlockAsync CDB{cdbTracer, cdbChainSelQueue} =
   addBlockToAdd (TraceAddBlockEvent >$< cdbTracer) cdbChainSelQueue
 
+addPerasCertAsync ::
+  forall m blk.
+  (IOLike m, HasHeader blk) =>
+  ChainDbEnv m blk ->
+  ValidatedPerasCert blk ->
+  m (AddPerasCertPromise m)
+addPerasCertAsync CDB{cdbTracer, cdbChainSelQueue} =
+  addPerasCertToQueue (TraceAddPerasCertEvent >$< cdbTracer) cdbChainSelQueue
+
 -- | Schedule reprocessing of blocks postponed by the LoE.
 triggerChainSelectionAsync ::
   forall m blk.
@@ -358,14 +377,15 @@ chainSelSync ::
 -- blocks that were originally postponed by the LoE, but can be adopted once we
 -- conclude that we are caught-up (and hence are longer bound by the LoE).
 chainSelSync cdb@CDB{..} (ChainSelReprocessLoEBlocks varProcessed) = lift $ do
-  (succsOf, lookupBlockInfo, curChain) <- atomically $ do
+  (succsOf, lookupBlockInfo, curChain, weights) <- atomically $ do
     invalid <- forgetFingerprint <$> readTVar cdbInvalid
-    (,,)
+    (,,,)
       <$> ( ignoreInvalidSuc cdbVolatileDB invalid
               <$> VolatileDB.filterByPredecessor cdbVolatileDB
           )
       <*> VolatileDB.getBlockInfo cdbVolatileDB
       <*> Query.getCurrentChain cdb
+      <*> (forgetFingerprint <$> Query.getPerasWeightSnapshot cdb)
   let
     -- All immediate successor blocks of blocks on the current chain (including
     -- the anchor), excluding those on the current chain.
@@ -380,10 +400,10 @@ chainSelSync cdb@CDB{..} (ChainSelReprocessLoEBlocks varProcessed) = lift $ do
       , not $ AF.pointOnFragment (realPointToPoint loePt) curChain
       ]
 
-    chainSelEnv = mkChainSelEnv cdb BlockCache.empty curChain Nothing
+    chainSelEnv = mkChainSelEnv cdb BlockCache.empty weights curChain Nothing
 
   chainDiffs :: [[ChainDiff (Header blk)]] <-
-    for loePoints $ constructPreferableCandidates cdb curChain Map.empty
+    for loePoints $ constructPreferableCandidates cdb weights curChain Map.empty
 
   -- Consider all candidates at once, to avoid transient chain switches.
   case NE.nonEmpty $ concat chainDiffs of
@@ -392,7 +412,7 @@ chainSelSync cdb@CDB{..} (ChainSelReprocessLoEBlocks varProcessed) = lift $ do
       chainSelection chainSelEnv rr chainDiffs' >>= \case
         Just validatedChainDiff ->
           -- Switch to the new better chain.
-          switchTo cdb Nothing validatedChainDiff
+          switchTo cdb weights Nothing validatedChainDiff
         Nothing -> pure ()
     Nothing -> pure ()
 
@@ -463,6 +483,65 @@ chainSelSync cdb@CDB{..} (ChainSelAddBlock BlockToAdd{blockToAdd = b, ..}) = do
   deliverProcessed tip =
     atomically $
       putTMVar varBlockProcessed (SuccesfullyAddedBlock tip)
+-- Process a Peras certificate by adding it to the PerasCertDB and potentially
+-- performing chain selection if a candidate is now better than our selection.
+chainSelSync cdb@CDB{..} (ChainSelAddPerasCert cert varProcessed) = do
+  curChain <- lift $ atomically $ Query.getCurrentChain cdb
+  let immTip = AF.castAnchor $ AF.anchor curChain
+
+  withEarlyExit_ $ do
+    -- Ignore the certificate if it boosts a block that is so old that it can't
+    -- influence our selection.
+    when (pointSlot boostedBlock < AF.anchorToSlotNo immTip) $ do
+      lift $ lift $ traceWith tracer $ IgnorePerasCertTooOld certRound boostedBlock immTip
+      exitEarly
+
+    -- Add the certificate to the PerasCertDB.
+    lift (lift $ PerasCertDB.addCert cdbPerasCertDB cert) >>= \case
+      PerasCertDB.AddedPerasCertToDB -> pure ()
+      -- If it already is in the PerasCertDB, we are done.
+      PerasCertDB.PerasCertAlreadyInDB -> exitEarly
+
+    -- If the certificate boosts a block on our current chain (including the
+    -- anchor), then it just makes our selection even stronger.
+    when (AF.withinFragmentBounds (castPoint boostedBlock) curChain) $ do
+      lift $ lift $ traceWith tracer $ PerasCertBoostsCurrentChain certRound boostedBlock
+      exitEarly
+
+    boostedHash <- case pointHash boostedBlock of
+      -- If the certificate boosts the Genesis point, then it can not influence
+      -- chain selection as all chains contain it.
+      GenesisHash -> do
+        lift $ lift $ traceWith tracer $ PerasCertBoostsGenesis certRound
+        exitEarly
+      -- Otherwise, the certificate boosts a block potentially on a (future)
+      -- candidate.
+      BlockHash boostedHash -> pure boostedHash
+    boostedHdr <-
+      lift (lift $ VolatileDB.getBlockComponent cdbVolatileDB GetHeader boostedHash) >>= \case
+        -- If we have not (yet) received the boosted block, we don't need to do
+        -- anything further for now regarding chain selection. Once we receive
+        -- it, the additional weight of the certificate is taken into account.
+        Nothing -> do
+          lift $ lift $ traceWith tracer $ PerasCertBoostsBlockNotYetReceived certRound boostedBlock
+          exitEarly
+        Just boostedHdr -> pure boostedHdr
+
+    -- Trigger chain selection for the boosted block.
+    lift $ lift $ traceWith tracer $ ChainSelectionForBoostedBlock certRound boostedBlock
+    lift $ chainSelectionForBlock cdb BlockCache.empty boostedHdr noPunishment
+
+  -- Deliver promise indicating that we processed the cert.
+  lift $ atomically $ putTMVar varProcessed ()
+ where
+  tracer :: Tracer m (TraceAddPerasCertEvent blk)
+  tracer = TraceAddPerasCertEvent >$< cdbTracer
+
+  certRound :: PerasRoundNo
+  certRound = getPerasCertRound cert
+
+  boostedBlock :: Point blk
+  boostedBlock = getPerasCertBoostedBlock cert
 
 -- | Return 'True' when the given header should be ignored when adding it
 -- because it is too old, i.e., we wouldn't be able to switch to a chain
@@ -539,11 +618,12 @@ chainSelectionForBlock ::
   InvalidBlockPunishment m ->
   Electric m ()
 chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ withRegistry $ \rr -> do
-  (invalid, curChain) <-
+  (invalid, curChain, weights) <-
     atomically $
-      (,)
+      (,,)
         <$> (forgetFingerprint <$> readTVar cdbInvalid)
         <*> Query.getCurrentChain cdb
+        <*> (forgetFingerprint <$> Query.getPerasWeightSnapshot cdb)
 
   -- The current chain we're working with here is not longer than @k@ blocks
   -- (see 'getCurrentChain' and 'cdbChain'), which is easier to reason about
@@ -576,13 +656,14 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ withRegist
         chainDiffs <-
           constructPreferableCandidates
             cdb
+            weights
             curChain
             (Map.singleton (headerHash hdr) hdr)
             (headerRealPoint hdr)
 
         let noChange = traceWith addBlockTracer $ StoreButDontChange p
 
-            chainSelEnv = mkChainSelEnv cdb blockCache curChain (Just (p, punish))
+            chainSelEnv = mkChainSelEnv cdb blockCache weights curChain (Just (p, punish))
 
         case NE.nonEmpty chainDiffs of
           Just chainDiffs' -> do
@@ -590,7 +671,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ withRegist
             chainSelection chainSelEnv rr chainDiffs' >>= \case
               Just validatedChainDiff ->
                 -- Switch to the new better chain.
-                switchTo cdb (Just p) validatedChainDiff
+                switchTo cdb weights (Just p) validatedChainDiff
               -- No valid candidate better than our chain.
               Nothing -> noChange
           -- No candidate better than our chain.
@@ -617,6 +698,7 @@ constructPreferableCandidates ::
   , BlockSupportsProtocol blk
   ) =>
   ChainDbEnv m blk ->
+  PerasWeightSnapshot blk ->
   -- | The current chain.
   AnchoredFragment (Header blk) ->
   -- | Headers already in memory (to avoid loading them from disk).
@@ -626,7 +708,7 @@ constructPreferableCandidates ::
   -- | All candidates involving @p@ (ie containing @p@ in 'getSuffix') which are
   -- preferable to the current chain.
   m [ChainDiff (Header blk)]
-constructPreferableCandidates CDB{..} curChain hdrCache p = do
+constructPreferableCandidates CDB{..} weights curChain hdrCache p = do
   (succsOf, lookupBlockInfo) <- atomically $ do
     invalid <- forgetFingerprint <$> readTVar cdbInvalid
     (,)
@@ -666,10 +748,10 @@ constructPreferableCandidates CDB{..} curChain hdrCache p = do
             -- Translate the 'HeaderFields' to 'Header' by reading the headers
             -- from disk.
             mapM translateToHeaders
-              -- Filter out candidates that are shorter than the current chain.
-              -- We don't want to needlessly read the headers from disk for
-              -- those candidates.
-              . NE.filter (not . Diff.rollbackExceedsSuffix)
+              -- Filter out candidates that have less weight than the current
+              -- chain. We don't want to needlessly read the headers from disk
+              -- for those candidates.
+              . NE.filter (not . Diff.rollbackExceedsSuffix weights curChain)
               -- Extend the diff with candidates fitting on @p@
               . Paths.extendWithSuccessors succsOf lookupBlockInfo
               $ diff
@@ -677,7 +759,7 @@ constructPreferableCandidates CDB{..} curChain hdrCache p = do
         | otherwise -> pure []
   pure
     -- Only keep candidates preferable to the current chain.
-    . filter (preferAnchoredCandidate bcfg curChain . Diff.getSuffix)
+    . filter (preferAnchoredCandidate bcfg weights curChain . Diff.getSuffix)
     -- Trim fragments so that they follow the LoE, that is, they extend the LoE
     -- by at most @k@ blocks or are extended by the LoE.
     . fmap (trimToLoE loeFrag)
@@ -792,6 +874,7 @@ switchTo ::
   , HasCallStack
   ) =>
   ChainDbEnv m blk ->
+  PerasWeightSnapshot blk ->
   -- | Which block we performed chain selection for (if any). This is 'Nothing'
   -- when reprocessing blocks that were postponed due to the Limit on Eagerness
   -- (cf 'ChainSelReprocessLoEBlocks').
@@ -799,7 +882,7 @@ switchTo ::
   -- | Chain and ledger to switch to
   ValidatedChainDiff (Header blk) (Forker' m blk) ->
   m ()
-switchTo CDB{..} triggerPt vChainDiff = do
+switchTo CDB{..} weights triggerPt vChainDiff = do
   traceWith addBlockTracer $
     ChangingSelection $
       castPoint $
@@ -860,7 +943,11 @@ switchTo CDB{..} triggerPt vChainDiff = do
   let mkTraceEvent
         | getRollback (getChainDiff vChainDiff) == 0 = AddedToCurrentChain
         | otherwise = SwitchedToAFork
-      selChangedInfo = mkSelectionChangedInfo curChain newChain newLedger
+      selChangedInfo =
+        mkSelectionChangedInfo
+          curChain
+          (getChainDiff vChainDiff)
+          newLedger
   traceWith addBlockTracer $
     mkTraceEvent events selChangedInfo curChain newChain
   whenJust (strictMaybeToMaybe prevTentativeHeader) $
@@ -875,28 +962,29 @@ switchTo CDB{..} triggerPt vChainDiff = do
   addBlockTracer = TraceAddBlockEvent >$< cdbTracer
 
   mkSelectionChangedInfo ::
-    AnchoredFragment (Header blk) ->
-    -- \^ old chain
-    AnchoredFragment (Header blk) ->
-    -- \^ new chain
-    ExtLedgerState blk EmptyMK ->
-    -- \^ new tip
+    AnchoredFragment (Header blk) -> -- old selection
+    ChainDiff (Header blk) -> -- diff we are adopting
+    ExtLedgerState blk EmptyMK -> -- new tip
     SelectionChangedInfo blk
-  mkSelectionChangedInfo oldChain newChain newTip =
+  mkSelectionChangedInfo oldChain diff newTip =
     SelectionChangedInfo
       { newTipPoint = castRealPoint tipPoint
       , newTipEpoch = tipEpoch
       , newTipSlotInEpoch = tipSlotInEpoch
       , newTipTrigger = triggerPt
-      , newTipSelectView
-      , oldTipSelectView =
-          selectView (configBlock cfg)
-            <$> eitherToMaybe (AF.head oldChain)
+      , newSuffixSelectView
+      , oldSuffixSelectView =
+          withEmptyFragmentToMaybe $
+            weightedSelectView (configBlock cfg) weights oldSuffix
       }
    where
     cfg :: TopLevelConfig blk
     cfg = cdbTopLevelConfig
 
+    oldSuffix, newSuffix :: AnchoredFragment (Header blk)
+    oldSuffix = AF.anchorNewest (getRollback diff) oldChain
+    newSuffix = getSuffix diff
+
     ledger :: LedgerState blk EmptyMK
     ledger = ledgerState newTip
 
@@ -906,14 +994,13 @@ switchTo CDB{..} triggerPt vChainDiff = do
         (configLedger cfg)
         ledger
 
-    (tipPoint, (tipEpoch, tipSlotInEpoch), newTipSelectView) =
-      case AF.head newChain of
-        Left _anchor -> error "cannot have switched to an empty chain"
-        Right tipHdr ->
+    (tipPoint, (tipEpoch, tipSlotInEpoch), newSuffixSelectView) =
+      case (AF.head newSuffix, weightedSelectView (configBlock cfg) weights newSuffix) of
+        (Right tipHdr, NonEmptyFragment wsv) ->
           let query = History.slotToEpoch' (blockSlot tipHdr)
               tipEpochData = History.runQueryPure query summary
-              sv = selectView (configBlock cfg) tipHdr
-           in (blockRealPoint tipHdr, tipEpochData, sv)
+           in (blockRealPoint tipHdr, tipEpochData, wsv)
+        _ -> error "cannot have switched via a diff with an empty suffix"
 
 -- | Check whether the header for the hash is in the cache, if not, get
 -- the corresponding header from the VolatileDB and store it in the cache.
@@ -943,6 +1030,7 @@ data ChainSelEnv m blk = ChainSelEnv
   , varTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
   , getTentativeFollowers :: STM m [FollowerHandle m blk]
   , blockCache :: BlockCache blk
+  , weights :: PerasWeightSnapshot blk
   , curChain :: AnchoredFragment (Header blk)
   , punish :: Maybe (RealPoint blk, InvalidBlockPunishment m)
   -- ^ The block that this chain selection invocation is processing, and the
@@ -968,12 +1056,14 @@ mkChainSelEnv ::
   ChainDbEnv m blk ->
   -- | See 'blockCache'
   BlockCache blk ->
+  -- | See 'weights'
+  PerasWeightSnapshot blk ->
   -- | See 'curChain'
   AnchoredFragment (Header blk) ->
   -- | See 'punish'.
   Maybe (RealPoint blk, InvalidBlockPunishment m) ->
   ChainSelEnv m blk
-mkChainSelEnv CDB{..} blockCache curChain punish =
+mkChainSelEnv CDB{..} blockCache weights curChain punish =
   ChainSelEnv
     { lgrDB = cdbLedgerDB
     , bcfg = configBlock cdbTopLevelConfig
@@ -984,6 +1074,7 @@ mkChainSelEnv CDB{..} blockCache curChain punish =
         filter ((TentativeChain ==) . fhChainType) . Map.elems
           <$> readTVar cdbFollowers
     , blockCache
+    , weights
     , curChain
     , validationTracer =
         TraceAddBlockEvent . AddBlockValidation >$< cdbTracer
@@ -1017,7 +1108,7 @@ chainSelection ::
 chainSelection chainSelEnv rr chainDiffs =
   assert
     ( all
-        (preferAnchoredCandidate bcfg curChain . Diff.getSuffix)
+        (preferAnchoredCandidate bcfg weights curChain . Diff.getSuffix)
         chainDiffs
     )
     $ assert
@@ -1030,8 +1121,7 @@ chainSelection chainSelEnv rr chainDiffs =
   ChainSelEnv{..} = chainSelEnv
 
   sortCandidates :: [ChainDiff (Header blk)] -> [ChainDiff (Header blk)]
-  sortCandidates =
-    sortBy (flip (compareAnchoredFragments bcfg) `on` Diff.getSuffix)
+  sortCandidates = sortBy (flip $ compareChainDiffs bcfg weights curChain)
 
   -- 1. Take the first candidate from the list of sorted candidates
   -- 2. Validate it
@@ -1067,7 +1157,7 @@ chainSelection chainSelEnv rr chainDiffs =
         -- it will be dropped here, as it will not be preferred over the
         -- current chain.
         let candidates2
-              | preferAnchoredCandidate bcfg curChain (Diff.getSuffix candidate') =
+              | preferAnchoredCandidate bcfg weights curChain (Diff.getSuffix candidate') =
                   candidate' : candidates1
               | otherwise =
                   candidates1
@@ -1125,7 +1215,7 @@ chainSelection chainSelEnv rr chainDiffs =
     let isRejected hdr =
           Map.member (headerHash hdr) (forgetFingerprint invalid)
     return $
-      filter (preferAnchoredCandidate bcfg curChain . Diff.getSuffix) $
+      filter (preferAnchoredCandidate bcfg weights curChain . Diff.getSuffix) $
         map (Diff.takeWhileOldest (not . isRejected)) cands
 
 -- [Ouroboros]
@@ -1333,3 +1423,26 @@ ignoreInvalidSuc ::
   (ChainHash blk -> Set (HeaderHash blk))
 ignoreInvalidSuc _ invalid succsOf =
   Set.filter (`Map.notMember` invalid) . succsOf
+
+-- | Compare two 'ChainDiff's w.r.t. the chain order.
+--
+-- PRECONDITION: Both 'ChainDiff's fit onto the given current chain.
+compareChainDiffs ::
+  forall blk.
+  BlockSupportsProtocol blk =>
+  BlockConfig blk ->
+  PerasWeightSnapshot blk ->
+  -- | Current chain.
+  AnchoredFragment (Header blk) ->
+  ChainDiff (Header blk) ->
+  ChainDiff (Header blk) ->
+  Ordering
+compareChainDiffs bcfg weights curChain =
+  -- The precondition of 'compareAnchoredFragment's is satisfied as the result
+  -- of @mkCand@ has the same anchor as @curChain@, and so any two fragments
+  -- returned by @mkCand@ do intersect.
+  compareAnchoredFragments bcfg weights `on` mkCand
+ where
+  mkCand =
+    fromMaybe (error "compareChainDiffs: precondition violated")
+      . Diff.apply curChain
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
index 821586f745..1dbd00c530 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- | Queries
 module Ouroboros.Consensus.Storage.ChainDB.Impl.Query
@@ -18,6 +19,8 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Query
   , getIsValid
   , getMaxSlotNo
   , getPastLedger
+  , getPerasWeightSnapshot
+  , getPerasCertSnapshot
   , getReadOnlyForkerAtPoint
   , getStatistics
   , getTipBlock
@@ -31,7 +34,6 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Query
   , getChainSelStarvation
   ) where
 
-import Cardano.Ledger.BaseTypes (unNonZero)
 import Control.ResourceRegistry (ResourceRegistry)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -43,6 +45,10 @@ import Ouroboros.Consensus.HeaderStateHistory
 import Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
 import Ouroboros.Consensus.Ledger.Abstract (EmptyMK)
 import Ouroboros.Consensus.Ledger.Extended
+import Ouroboros.Consensus.Peras.Weight
+  ( PerasWeightSnapshot
+  , takeVolatileSuffix
+  )
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( BlockComponent (..)
@@ -52,6 +58,8 @@ import Ouroboros.Consensus.Storage.ChainDB.Impl.Types
 import Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
+import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
+import Ouroboros.Consensus.Storage.PerasCertDB.API (PerasCertSnapshot)
 import Ouroboros.Consensus.Storage.VolatileDB (VolatileDB)
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util (eitherToMaybe)
@@ -67,45 +75,63 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type
 
 -- | Return the last @k@ headers.
 --
--- While the in-memory fragment ('cdbChain') might temporarily be longer than
--- @k@ (until the background thread has copied those blocks to the
--- ImmutableDB), this function will never return a fragment longer than @k@.
+-- While the in-memory fragment ('cdbChain') might temporarily have more weight
+-- than @k@ (until the background thread has copied those blocks to the
+-- ImmutableDB), this function will never return a fragment heavier than @k@.
 --
 -- The anchor point of the returned fragment will be the most recent
 -- \"immutable\" block, i.e. a block that cannot be rolled back. In
 -- ChainDB.md, we call this block @i@.
 --
--- Note that the returned fragment may be shorter than @k@ in case the whole
--- chain itself is shorter than @k@ or in case the VolatileDB was corrupted.
--- In the latter case, we don't take blocks already in the ImmutableDB into
--- account, as we know they /must/ have been \"immutable\" at some point, and,
--- therefore, /must/ still be \"immutable\".
+-- Note that the returned fragment may have weight less than @k@ in case the
+-- whole chain itself weights less than @k@, or in case the VolatileDB was
+-- corrupted. In the latter case, we don't take blocks already in the
+-- ImmutableDB into account, as we know they /must/ have been \"immutable\" at
+-- some point, and, therefore, /must/ still be \"immutable\".
 getCurrentChain ::
   forall m blk.
   ( IOLike m
+  , StandardHash blk
   , HasHeader (Header blk)
   , ConsensusProtocol (BlockProtocol blk)
   ) =>
   ChainDbEnv m blk ->
   STM m (AnchoredFragment (Header blk))
-getCurrentChain CDB{..} =
-  AF.anchorNewest (unNonZero k) . icWithoutTime <$> readTVar cdbChain
- where
-  SecurityParam k = configSecurityParam cdbTopLevelConfig
+getCurrentChain cdb@CDB{..} =
+  getCurrentChainLike cdb $ icWithoutTime <$> readTVar cdbChain
 
 -- | Same as 'getCurrentChain', /mutatis mutandi/.
 getCurrentChainWithTime ::
   forall m blk.
   ( IOLike m
+  , StandardHash blk
   , HasHeader (HeaderWithTime blk)
   , ConsensusProtocol (BlockProtocol blk)
   ) =>
   ChainDbEnv m blk ->
   STM m (AnchoredFragment (HeaderWithTime blk))
-getCurrentChainWithTime CDB{..} =
-  AF.anchorNewest (unNonZero k) . icWithTime <$> readTVar cdbChain
+getCurrentChainWithTime cdb@CDB{..} =
+  getCurrentChainLike cdb $ icWithTime <$> readTVar cdbChain
+
+-- | This function is the generalised helper for 'getCurrentChain' and
+-- 'getCurrentChainWithTime'. See 'getCurrentChain' for the explanation of it's
+-- behaviour.
+getCurrentChainLike ::
+  forall m blk h.
+  ( IOLike m
+  , StandardHash blk
+  , HasHeader h
+  , HeaderHash blk ~ HeaderHash h
+  , ConsensusProtocol (BlockProtocol blk)
+  ) =>
+  ChainDbEnv m blk ->
+  STM m (AnchoredFragment h) ->
+  STM m (AnchoredFragment h)
+getCurrentChainLike cdb@CDB{..} getCurChain = do
+  weights <- forgetFingerprint <$> getPerasWeightSnapshot cdb
+  takeVolatileSuffix weights k <$> getCurChain
  where
-  SecurityParam k = configSecurityParam cdbTopLevelConfig
+  k = configSecurityParam cdbTopLevelConfig
 
 -- | Get a 'HeaderStateHistory' populated with the 'HeaderState's of the
 -- last @k@ blocks of the current chain.
@@ -262,6 +288,14 @@ getReadOnlyForkerAtPoint CDB{..} = LedgerDB.getReadOnlyForker cdbLedgerDB
 getStatistics :: IOLike m => ChainDbEnv m blk -> m (Maybe LedgerDB.Statistics)
 getStatistics CDB{..} = LedgerDB.getTipStatistics cdbLedgerDB
 
+getPerasWeightSnapshot ::
+  ChainDbEnv m blk -> STM m (WithFingerprint (PerasWeightSnapshot blk))
+getPerasWeightSnapshot CDB{..} = PerasCertDB.getWeightSnapshot cdbPerasCertDB
+
+getPerasCertSnapshot ::
+  ChainDbEnv m blk -> STM m (PerasCertSnapshot blk)
+getPerasCertSnapshot CDB{..} = PerasCertDB.getCertSnapshot cdbPerasCertDB
+
 {-------------------------------------------------------------------------------
   Unifying interface over the immutable DB and volatile DB, but independent
   of the ledger DB. These functions therefore do not require the entire
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
index 4a88b8d40b..3336ba527f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
@@ -55,6 +55,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Types
   , ChainSelMessage (..)
   , ChainSelQueue -- opaque
   , addBlockToAdd
+  , addPerasCertToQueue
   , addReprocessLoEBlocks
   , closeChainSelQueue
   , getChainSelMessage
@@ -66,6 +67,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Types
     -- * Trace types
   , SelectionChangedInfo (..)
   , TraceAddBlockEvent (..)
+  , TraceAddPerasCertEvent (..)
   , TraceChainSelStarvationEvent (..)
   , TraceCopyToImmutableDBEvent (..)
   , TraceEvent (..)
@@ -83,7 +85,6 @@ import Control.ResourceRegistry
 import Control.Tracer
 import Data.Foldable (traverse_)
 import Data.Map.Strict (Map)
-import Data.Maybe (mapMaybe)
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.MultiSet (MultiSet)
 import qualified Data.MultiSet as MultiSet
@@ -99,10 +100,12 @@ import Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
 import Ouroboros.Consensus.Ledger.Inspect
 import Ouroboros.Consensus.Ledger.SupportsProtocol
+import Ouroboros.Consensus.Peras.SelectView (WeightedSelectView)
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( AddBlockPromise (..)
   , AddBlockResult (..)
+  , AddPerasCertPromise (..)
   , ChainDbError (..)
   , ChainSelectionPromise (..)
   , ChainType
@@ -124,6 +127,8 @@ import Ouroboros.Consensus.Storage.LedgerDB
   , LedgerDbSerialiseConstraints
   )
 import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
+import Ouroboros.Consensus.Storage.PerasCertDB (PerasCertDB)
+import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
 import Ouroboros.Consensus.Storage.Serialisation
 import Ouroboros.Consensus.Storage.VolatileDB
   ( VolatileDB
@@ -136,7 +141,7 @@ import Ouroboros.Consensus.Util.Enclose (Enclosing, Enclosing' (..))
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.Orphans ()
 import Ouroboros.Consensus.Util.STM (WithFingerprint)
-import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
+import Ouroboros.Network.AnchoredFragment (Anchor, AnchoredFragment)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import Ouroboros.Network.Block (MaxSlotNo (..))
 import Ouroboros.Network.BlockFetch.ConsensusInterface
@@ -349,6 +354,7 @@ data ChainDbEnv m blk = CDB
   , cdbChainSelStarvation :: !(StrictTVar m ChainSelStarvation)
   -- ^ Information on the last starvation of ChainSel, whether ongoing or
   -- ended recently.
+  , cdbPerasCertDB :: !(PerasCertDB m blk)
   }
   deriving Generic
 
@@ -545,6 +551,11 @@ data BlockToAdd m blk = BlockToAdd
 data ChainSelMessage m blk
   = -- | Add a new block
     ChainSelAddBlock !(BlockToAdd m blk)
+  | -- | Add a Peras certificate
+    ChainSelAddPerasCert
+      !(ValidatedPerasCert blk)
+      -- | Used for 'AddPerasCertPromise'.
+      !(StrictTMVar m ())
   | -- | Reprocess blocks that have been postponed by the LoE.
     ChainSelReprocessLoEBlocks
       -- | Used for 'ChainSelectionPromise'.
@@ -593,6 +604,27 @@ addBlockToAdd tracer (ChainSelQueue{varChainSelQueue, varChainSelPoints}) punish
       , blockProcessed = readTMVar varBlockProcessed
       }
 
+-- | Add a Peras certificate to the background queue.
+addPerasCertToQueue ::
+  (IOLike m, StandardHash blk) =>
+  Tracer m (TraceAddPerasCertEvent blk) ->
+  ChainSelQueue m blk ->
+  ValidatedPerasCert blk ->
+  m (AddPerasCertPromise m)
+addPerasCertToQueue tracer ChainSelQueue{varChainSelQueue} cert = do
+  varProcessed <- newEmptyTMVarIO
+  traceWith tracer $ addedToQueue RisingEdge
+  queueSize <- atomically $ do
+    writeTBQueue varChainSelQueue $ ChainSelAddPerasCert cert varProcessed
+    lengthTBQueue varChainSelQueue
+  traceWith tracer $ addedToQueue $ FallingEdgeWith $ fromIntegral queueSize
+  pure
+    AddPerasCertPromise
+      { waitPerasCertProcessed = atomically $ readTMVar varProcessed
+      }
+ where
+  addedToQueue = AddedPerasCertToQueue (getPerasCertRound cert) (getPerasCertBoostedBlock cert)
+
 -- | Try to add blocks again that were postponed due to the LoE.
 addReprocessLoEBlocks ::
   IOLike m =>
@@ -647,23 +679,21 @@ getChainSelMessage starvationTracer starvationVar chainSelQueue =
       let pt = blockRealPoint block
       traceWith starvationTracer $ ChainSelStarvation (FallingEdgeWith pt)
       atomically . writeTVar starvationVar . ChainSelStarvationEndedAt =<< getMonotonicTime
+    ChainSelAddPerasCert{} -> pure ()
     ChainSelReprocessLoEBlocks{} -> pure ()
 
 -- | Flush the 'ChainSelQueue' queue and notify the waiting threads.
 closeChainSelQueue :: IOLike m => ChainSelQueue m blk -> STM m ()
 closeChainSelQueue ChainSelQueue{varChainSelQueue = queue} = do
-  as <- mapMaybe blockAdd <$> flushTBQueue queue
-  traverse_
-    ( \a ->
-        tryPutTMVar
-          (varBlockProcessed a)
-          (FailedToAddBlock "Queue flushed")
-    )
-    as
+  traverse_ deliverPromise =<< flushTBQueue queue
  where
-  blockAdd = \case
-    ChainSelAddBlock ab -> Just ab
-    ChainSelReprocessLoEBlocks _ -> Nothing
+  deliverPromise = \case
+    ChainSelAddBlock ab ->
+      tryPutTMVar (varBlockProcessed ab) (FailedToAddBlock "Queue flushed")
+    ChainSelAddPerasCert _cert varProcessed ->
+      tryPutTMVar varProcessed ()
+    ChainSelReprocessLoEBlocks varProcessed ->
+      tryPutTMVar varProcessed ()
 
 -- | To invoke when the given 'ChainSelMessage' has been processed by ChainSel.
 -- This is used to remove the respective point from the multiset of points in
@@ -676,6 +706,8 @@ processedChainSelMessage ::
 processedChainSelMessage ChainSelQueue{varChainSelPoints} = \case
   ChainSelAddBlock BlockToAdd{blockToAdd = blk} ->
     modifyTVar varChainSelPoints $ MultiSet.delete (blockRealPoint blk)
+  ChainSelAddPerasCert{} ->
+    pure ()
   ChainSelReprocessLoEBlocks{} ->
     pure ()
 
@@ -717,8 +749,10 @@ data TraceEvent blk
   | TraceLedgerDBEvent (LedgerDB.TraceEvent blk)
   | TraceImmutableDBEvent (ImmutableDB.TraceEvent blk)
   | TraceVolatileDBEvent (VolatileDB.TraceEvent blk)
+  | TracePerasCertDbEvent (PerasCertDB.TraceEvent blk)
   | TraceLastShutdownUnclean
   | TraceChainSelStarvationEvent (TraceChainSelStarvationEvent blk)
+  | TraceAddPerasCertEvent (TraceAddPerasCertEvent blk)
   deriving Generic
 
 deriving instance
@@ -791,21 +825,23 @@ data SelectionChangedInfo blk = SelectionChangedInfo
   -- Due to the Ouroboros Genesis (Limit on Eagerness), chain selection can also
   -- be triggered without any particular trigger block, in which case this is
   -- 'Nothing'.
-  , newTipSelectView :: SelectView (BlockProtocol blk)
-  -- ^ The 'SelectView' of the new tip. It is guaranteed that
+  , newSuffixSelectView :: WeightedSelectView (BlockProtocol blk)
+  -- ^ The 'WeightedSelectView' of the suffix of our new selection that was not
+  -- already present in the old selection. It is guaranteed that
   --
-  -- > Just newTipSelectView > oldTipSelectView
-  -- True
-  , oldTipSelectView :: Maybe (SelectView (BlockProtocol blk))
-  -- ^ The 'SelectView' of the old, previous tip. This can be 'Nothing' when
-  -- the previous chain/tip was Genesis.
+  -- > preferCandidate cfg
+  -- >   (withEmptyFragmentFromMaybe oldSuffixSelectView)
+  -- >   newSuffixSelectView
+  , oldSuffixSelectView :: Maybe (WeightedSelectView (BlockProtocol blk))
+  -- ^ The 'WeightedSelectView' of the orphaned suffix of our old selection.
+  -- This is 'Nothing' when we extended our selection.
   }
   deriving Generic
 
 deriving stock instance
-  (Show (SelectView (BlockProtocol blk)), StandardHash blk) => Show (SelectionChangedInfo blk)
+  (Show (TiebreakerView (BlockProtocol blk)), StandardHash blk) => Show (SelectionChangedInfo blk)
 deriving stock instance
-  (Eq (SelectView (BlockProtocol blk)), StandardHash blk) => Eq (SelectionChangedInfo blk)
+  (Eq (TiebreakerView (BlockProtocol blk)), StandardHash blk) => Eq (SelectionChangedInfo blk)
 
 -- | Trace type for the various events that occur when adding a block.
 data TraceAddBlockEvent blk
@@ -1021,3 +1057,26 @@ data TraceIteratorEvent blk
 newtype TraceChainSelStarvationEvent blk
   = ChainSelStarvation (Enclosing' (RealPoint blk))
   deriving (Generic, Eq, Show)
+
+data TraceAddPerasCertEvent blk
+  = -- | The Peras certificate from the given round boosting the given block was
+    -- added to the queue. The size of the queue is included.
+    AddedPerasCertToQueue PerasRoundNo (Point blk) (Enclosing' Word)
+  | -- | The Peras certificate from the given round boosting the given block was
+    -- popped from the queue.
+    PoppedPerasCertFromQueue PerasRoundNo (Point blk)
+  | -- | The Peras certificate from the given round boosting the given block was
+    -- too old, ie its slot was older than the current immutable slot (the third
+    -- argument).
+    IgnorePerasCertTooOld PerasRoundNo (Point blk) (Anchor blk)
+  | -- | The Peras certificate from the given round boosts a block on the
+    -- current selection.
+    PerasCertBoostsCurrentChain PerasRoundNo (Point blk)
+  | -- | The Peras certificate from the given round boosts the Genesis point.
+    PerasCertBoostsGenesis PerasRoundNo
+  | -- | The Peras certificate from the given round boosts a block that we have
+    -- not (yet) received.
+    PerasCertBoostsBlockNotYetReceived PerasRoundNo (Point blk)
+  | -- | Perform chain selection for a block boosted by a Peras certificate.
+    ChainSelectionForBoostedBlock PerasRoundNo (Point blk)
+  deriving (Generic, Eq, Show)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
index cfcb5c3050..7a82c46226 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
@@ -10,7 +10,7 @@ module Ouroboros.Consensus.Util.AnchoredFragment
   ( compareAnchoredFragments
   , compareHeadBlockNo
   , cross
-  , forksAtMostKBlocks
+  , forksAtMostKWeight
   , preferAnchoredCandidate
   , stripCommonPrefix
   ) where
@@ -21,9 +21,10 @@ import qualified Data.Foldable1 as F1
 import Data.Function (on)
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe (isJust)
-import Data.Word (Word64)
 import GHC.Stack
 import Ouroboros.Consensus.Block
+import Ouroboros.Consensus.Peras.SelectView
+import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Util.Assert
 import Ouroboros.Network.AnchoredFragment
@@ -59,76 +60,96 @@ compareHeadBlockNo ::
   Ordering
 compareHeadBlockNo = compare `on` AF.headBlockNo
 
-forksAtMostKBlocks ::
-  HasHeader b =>
-  -- | How many blocks can it fork?
-  Word64 ->
-  -- | Our chain.
+-- | Check that we can switch from @ours@ to @theirs@ by rolling back our chain
+-- by at most @k@ weight.
+--
+-- If @ours@ and @cand@ do not intersect, this returns 'False'. If they do
+-- intersect, then we check that the suffix of @ours@ after the intersection has
+-- total weight at most @k@.
+forksAtMostKWeight ::
+  ( StandardHash blk
+  , HasHeader b
+  , HeaderHash blk ~ HeaderHash b
+  ) =>
+  PerasWeightSnapshot blk ->
+  -- | By how much weight can we roll back our chain at most?
+  PerasWeight ->
+  -- | Our chain @ours@.
   AnchoredFragment b ->
-  -- | Their chain
+  -- | Their chain @theirs@.
   AnchoredFragment b ->
-  -- | Indicates whether their chain forks at most the
-  -- specified number of blocks.
+  -- | Indicates whether their chain forks at most the given the amount of
+  -- weight. Returns 'False' if the two fragments do not intersect.
   Bool
-forksAtMostKBlocks k ours theirs = case ours `AF.intersect` theirs of
-  Nothing -> False
-  Just (_, _, ourSuffix, _) -> fromIntegral (AF.length ourSuffix) <= k
+forksAtMostKWeight weights maxWeight ours theirs =
+  case ours `AF.intersect` theirs of
+    Nothing -> False
+    Just (_, _, ourSuffix, _) ->
+      totalWeightOfFragment weights ourSuffix <= maxWeight
 
 -- | Compare two (potentially empty!) 'AnchoredFragment's.
 --
--- PRECONDITION: Either both fragments are non-empty or they intersect.
---
--- For a detailed discussion of this precondition, and a justification for the
--- definition of this function, please refer to the Consensus Report.
+-- PRECONDITION: The fragments must intersect.
 --
 -- Usage note: the primary user of this function is the chain database when
 -- sorting fragments that are preferred over our selection. It establishes the
 -- precondition in the following way: It will only compare candidate fragments
--- that it has previously verified are preferable to our current chain.
--- Therefore, they are non-empty, as an empty fragment anchored in our chain can
--- never be preferable to our chain.
+-- that it has previously verified are preferable to our current chain. Since
+-- these fragments intersect with our current chain, we can enlarge them to all
+-- be anchored in the immutable tip. Therefore, they intersect pairwise.
 compareAnchoredFragments ::
   forall blk h.
   ( BlockSupportsProtocol blk
   , HasCallStack
   , GetHeader1 h
   , HasHeader (h blk)
+  , HeaderHash (h blk) ~ HeaderHash blk
   ) =>
   BlockConfig blk ->
+  PerasWeightSnapshot blk ->
   AnchoredFragment (h blk) ->
   AnchoredFragment (h blk) ->
   Ordering
-compareAnchoredFragments cfg frag1 frag2 =
-  assertWithMsg (precondition frag1 frag2) $
-    case (frag1, frag2) of
-      (Empty _, Empty _) ->
-        -- The fragments intersect but are equal: their anchors must be equal,
-        -- and hence the fragments represent the same chain. They are therefore
-        -- equally preferable.
-        EQ
-      (Empty anchor, _ :> tip') ->
-        -- Since the fragments intersect, but the first one is empty, its anchor
-        -- must lie somewhere along the the second. If it is the tip, the two
-        -- fragments represent the same chain and are equally preferable. If
-        -- not, the second chain is a strict extension of the first and is
-        -- therefore strictly preferable.
-        if blockPoint tip' == AF.castPoint (AF.anchorToPoint anchor)
-          then EQ
-          else LT
-      (_ :> tip, Empty anchor') ->
-        -- This case is symmetric to the previous
-        if blockPoint tip == AF.castPoint (AF.anchorToPoint anchor')
-          then EQ
-          else GT
-      (_ :> tip, _ :> tip') ->
-        -- Case 4
-        compare
-          (selectView cfg (getHeader1 tip))
-          (selectView cfg (getHeader1 tip'))
+compareAnchoredFragments cfg weights frag1 frag2
+  -- Optimize the case where Peras is disabled.
+  | isEmptyPerasWeightSnapshot weights =
+      assertWithMsg (precondition frag1 frag2) $
+        case (frag1, frag2) of
+          (Empty _, Empty _) ->
+            -- The fragments intersect but are equal: their anchors must be equal,
+            -- and hence the fragments represent the same chain. They are therefore
+            -- equally preferable.
+            EQ
+          (Empty anchor, _ :> tip') ->
+            -- Since the fragments intersect, but the first one is empty, its anchor
+            -- must lie somewhere along the the second. If it is the tip, the two
+            -- fragments represent the same chain and are equally preferable. If
+            -- not, the second chain is a strict extension of the first and is
+            -- therefore strictly preferable.
+            if blockPoint tip' == AF.castPoint (AF.anchorToPoint anchor)
+              then EQ
+              else LT
+          (_ :> tip, Empty anchor') ->
+            -- This case is symmetric to the previous
+            if blockPoint tip == AF.castPoint (AF.anchorToPoint anchor')
+              then EQ
+              else GT
+          (_ :> tip, _ :> tip') ->
+            -- Case 4
+            compare
+              (selectView cfg (getHeader1 tip))
+              (selectView cfg (getHeader1 tip'))
+  | otherwise =
+      case AF.intersect frag1 frag2 of
+        Nothing -> error "precondition violated: fragments must intersect"
+        Just (_oursPrefix, _candPrefix, oursSuffix, candSuffix) ->
+          compare
+            (weightedSelectView cfg weights oursSuffix)
+            (weightedSelectView cfg weights candSuffix)
 
 -- | Lift 'preferCandidate' to 'AnchoredFragment'
 --
--- PRECONDITION: Either both fragments are non-empty or they intersect.
+-- PRECONDITION: The fragments must intersect.
 --
 -- Usage note: the primary user of this function is the chain database. It
 -- establishes the precondition when comparing a candidate fragment to our
@@ -142,27 +163,39 @@ preferAnchoredCandidate ::
   , HasCallStack
   , GetHeader1 h
   , GetHeader1 h'
+  , HeaderHash (h blk) ~ HeaderHash blk
   , HeaderHash (h blk) ~ HeaderHash (h' blk)
   , HasHeader (h blk)
   , HasHeader (h' blk)
   ) =>
   BlockConfig blk ->
+  -- | Peras weights used to judge this chain.
+  PerasWeightSnapshot blk ->
   -- | Our chain
   AnchoredFragment (h blk) ->
   -- | Candidate
   AnchoredFragment (h' blk) ->
   Bool
-preferAnchoredCandidate cfg ours cand =
-  assertWithMsg (precondition ours cand) $
-    case (ours, cand) of
-      (_, Empty _) -> False
-      (Empty ourAnchor, _ :> theirTip) ->
-        blockPoint theirTip /= castPoint (AF.anchorToPoint ourAnchor)
-      (_ :> ourTip, _ :> theirTip) ->
-        preferCandidate
-          (projectChainOrderConfig cfg)
-          (selectView cfg (getHeader1 ourTip))
-          (selectView cfg (getHeader1 theirTip))
+preferAnchoredCandidate cfg weights ours cand
+  | isEmptyPerasWeightSnapshot weights =
+      assertWithMsg (precondition ours cand) $
+        case (ours, cand) of
+          (_, Empty _) -> False
+          (Empty ourAnchor, _ :> theirTip) ->
+            blockPoint theirTip /= castPoint (AF.anchorToPoint ourAnchor)
+          (_ :> ourTip, _ :> theirTip) ->
+            preferCandidate
+              (projectChainOrderConfig cfg)
+              (selectView cfg (getHeader1 ourTip))
+              (selectView cfg (getHeader1 theirTip))
+  | otherwise =
+      case AF.intersect ours cand of
+        Nothing -> error "precondition violated: fragments must intersect"
+        Just (_oursPrefix, _candPrefix, oursSuffix, candSuffix) ->
+          preferCandidate
+            (projectChainOrderConfig cfg)
+            (weightedSelectView cfg weights oursSuffix)
+            (weightedSelectView cfg weights candSuffix)
 
 -- For 'compareAnchoredFragment' and 'preferAnchoredCandidate'.
 precondition ::
@@ -174,9 +207,6 @@ precondition ::
   AnchoredFragment (h' blk) ->
   Either String ()
 precondition frag1 frag2
-  | not (AF.null frag1)
-  , not (AF.null frag2) =
-      return ()
   | isJust (AF.intersectionPoint frag1 frag2) =
       return ()
   | otherwise =
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredSeq.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredSeq.hs
new file mode 100644
index 0000000000..06a74fd456
--- /dev/null
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredSeq.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Utilities on 'AnchoredSeq's.
+module Ouroboros.Consensus.Util.AnchoredSeq
+  ( takeLongestSuffix
+  ) where
+
+import Data.Maybe (fromMaybe)
+import Ouroboros.Network.AnchoredSeq (AnchoredSeq)
+import qualified Ouroboros.Network.AnchoredSeq as AS
+
+-- | Take the longest suffix of an 'AnchoredSeq' @as@ satisfying the given
+-- predicate @p@ on the monoidal summary given by @f@.
+--
+-- TODO: upstream this function
+--
+-- === PRECONDITIONS:
+--
+-- For @as0, as1@ such that @AS.join as0 as1 = Just as2@, we must have the
+-- following homomorphism property:
+--
+-- > f as0 <> f as1 ≡ f as2
+--
+-- For empty @ase@, we must have @f ase ≡ mempty@.
+--
+-- The predicate must be monotonic, ie when @suf0@ is a suffix of @as@ and
+-- @suf1@ is a suffix of @suf0@, then @p (f suf0)@ must imply @p (f suf1)@.
+-- Furthermore, we must have @p mempty@.
+takeLongestSuffix ::
+  forall s v a b.
+  (Monoid s, AS.Anchorable v a b) =>
+  -- | @f@: Compute a monoidal summary of a fragment.
+  (AnchoredSeq v a b -> s) ->
+  -- | @p@: Predicate on the summary of a fragment.
+  (s -> Bool) ->
+  -- | Input sequence @as@.
+  AnchoredSeq v a b ->
+  -- | A suffix of the input sequence.
+  AnchoredSeq v a b
+takeLongestSuffix f p as =
+  go (AS.Empty $ AS.headAnchor as) mempty as
+ where
+  go ::
+    -- @suf@: the longest suffix of @as@ for which we currently know that @p (f
+    -- suf)@.
+    AnchoredSeq v a b ->
+    -- Equal to @f suf@.
+    s ->
+    -- @pre@: longest infix of @as@ ending just before @suf@ such that we don't
+    -- know whether @p (f (AS.join pre suf))@.
+    AnchoredSeq v a b ->
+    -- Longest suffix of @as@ satisfying @p . f@.
+    AnchoredSeq v a b
+  go suf sufS pre
+    | AS.null pre = suf
+    | p suf'S = go suf' suf'S pre0
+    | AS.null pre0 = suf
+    | otherwise = go suf sufS pre1
+   where
+    (pre0, pre1) = AS.splitAt (AS.length pre `div` 2) pre
+    suf' =
+      fromMaybe (error "takeLongestSuffix: internal invariant violation") $
+        AS.join (\_ _ -> True) pre1 suf
+    suf'S = f pre1 <> sufS
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/STM.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/STM.hs
index ebbfe8bef7..e3f23eace8 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/STM.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/STM.hs
@@ -1,9 +1,5 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -38,10 +34,12 @@ import Control.Monad (void)
 import Control.Monad.State (StateT (..))
 import Control.ResourceRegistry
 import Data.Void
-import Data.Word (Word64)
-import GHC.Generics (Generic)
 import GHC.Stack
 import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Network.BlockFetch.ConsensusInterface
+  ( Fingerprint (..)
+  , WithFingerprint (..)
+  )
 
 {-------------------------------------------------------------------------------
   Misc
@@ -85,20 +83,6 @@ blockUntilJust getMaybeA = do
 blockUntilAllJust :: MonadSTM m => [STM m (Maybe a)] -> STM m [a]
 blockUntilAllJust = mapM blockUntilJust
 
--- | Simple type that can be used to indicate something in a @TVar@ is
--- changed.
-newtype Fingerprint = Fingerprint Word64
-  deriving stock (Show, Eq, Generic)
-  deriving newtype Enum
-  deriving anyclass NoThunks
-
--- | Store a value together with its fingerprint.
-data WithFingerprint a = WithFingerprint
-  { forgetFingerprint :: !a
-  , getFingerprint :: !Fingerprint
-  }
-  deriving (Show, Eq, Functor, Generic, NoThunks)
-
 {-------------------------------------------------------------------------------
   Simulate monad stacks
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
index 8c22333ac4..702c22a89c 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
@@ -32,6 +32,7 @@ import Ouroboros.Consensus.Storage.LedgerDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB.Snapshots as LedgerDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Backend as V2
 import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
+import Ouroboros.Consensus.Storage.PerasCertDB (PerasCertDbArgs (..))
 import Ouroboros.Consensus.Storage.VolatileDB
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util.Args
@@ -134,6 +135,10 @@ fromMinimalChainDbArgs MinimalChainDbArgs{..} =
           , lgrQueryBatchSize = DefaultQueryBatchSize
           , lgrStartSnapshot = Nothing
           }
+    , cdbPerasCertDbArgs =
+        PerasCertDbArgs
+          { pcdbaTracer = nullTracer
+          }
     , cdbsArgs =
         ChainDbSpecificArgs
           { cdbsBlocksToAddSize = 1
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
index f1f397011b..27a8d0c641 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
@@ -139,6 +139,8 @@ import Ouroboros.Consensus.Ledger.Tables.Utils
 import Ouroboros.Consensus.Node.NetworkProtocolVersion
 import Ouroboros.Consensus.Node.ProtocolInfo
 import Ouroboros.Consensus.NodeId
+import Ouroboros.Consensus.Peras.SelectView (weightedSelectView)
+import Ouroboros.Consensus.Peras.Weight (PerasWeightSnapshot)
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Protocol.BFT
 import Ouroboros.Consensus.Protocol.MockChainSel
@@ -859,15 +861,21 @@ treeToBlocks = Tree.flatten . blockTree
 treeToChains :: BlockTree -> [Chain TestBlock]
 treeToChains = map Chain.fromOldestFirst . allPaths . blockTree
 
-treePreferredChain :: BlockTree -> Chain TestBlock
-treePreferredChain =
+treePreferredChain ::
+  PerasWeightSnapshot TestBlock ->
+  BlockTree ->
+  Chain TestBlock
+treePreferredChain weights =
   fromMaybe Genesis
     . selectUnvalidatedChain
       (Proxy @(BlockProtocol TestBlock))
       (() :: ChainOrderConfig (SelectView (BlockProtocol TestBlock)))
-      (\hdr -> SelectView (blockNo hdr) NoTiebreaker)
+      (weightedSelectView bcfg weights . Chain.toAnchoredFragment . fmap getHeader)
       Genesis
     . treeToChains
+ where
+  -- inconsequential for this function
+  bcfg = TestBlockConfig (NumCoreNodes 0)
 
 instance Show BlockTree where
   show (BlockTree t) = Tree.drawTree (fmap show t)
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
index e45c89ab65..1a440370e7 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
@@ -306,6 +306,7 @@ runBlockFetchTest BlockFetchClientTestSetup{..} = withRegistry \registry -> do
       getMaxSlotNo = ChainDB.getMaxSlotNo chainDB
       addBlockAsync = ChainDB.addBlockAsync chainDB
       getChainSelStarvation = ChainDB.getChainSelStarvation chainDB
+      getPerasWeightSnapshot = ChainDB.getPerasWeightSnapshot chainDB
     pure BlockFetchClientInterface.ChainDbView{..}
    where
     cdbTracer = Tracer \case
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs
index 8ff1e4de74..cc86a428bd 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs
@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Ledger.Query (Query (..))
 import Ouroboros.Consensus.MiniProtocol.LocalStateQuery.Server
 import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..))
 import Ouroboros.Consensus.NodeId
+import Ouroboros.Consensus.Peras.Weight (emptyPerasWeightSnapshot)
 import Ouroboros.Consensus.Protocol.BFT
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.BlockCache as BlockCache
 import Ouroboros.Consensus.Storage.ImmutableDB.Stream hiding
@@ -101,7 +102,7 @@ prop_localStateQueryServer ::
 prop_localStateQueryServer k bt p (Positive (Small n)) = checkOutcome k chain actualOutcome
  where
   chain :: Chain TestBlock
-  chain = treePreferredChain bt
+  chain = treePreferredChain emptyPerasWeightSnapshot bt
 
   points :: [Target (Point TestBlock)]
   points =
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs
index 21c84f7050..d300f2d4ec 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs
@@ -14,12 +14,15 @@
 -- and fragments.
 module Test.Consensus.Peras.WeightSnapshot (tests) where
 
+import Cardano.Ledger.BaseTypes (unNonZero)
 import Data.Containers.ListUtils (nubOrd)
+import Data.List (find)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromJust)
 import Data.Traversable (for)
 import Ouroboros.Consensus.Block
+import Ouroboros.Consensus.Config.SecurityParam
 import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Consensus.Util.Condense
 import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
@@ -59,12 +62,32 @@ prop_perasWeightSnapshot testSetup =
               ]
           | frag <- tsFragments
           ]
+      , conjoin
+          [ conjoin
+              [ counterexample ("Incorrect volatile suffix for " <> condense frag) $
+                  takeVolatileSuffixReference frag =:= volSuffix
+              , counterexample ("Volatile suffix must be a suffix of" <> condense frag) $
+                  AF.headPoint frag =:= AF.headPoint volSuffix
+                    .&&. AF.withinFragmentBounds (AF.anchorPoint volSuffix) frag
+              , counterexample ("A longer volatile suffix still has total weight at most k") $
+                  let isImproperSuffix = AF.length volSuffix == AF.length frag
+                      fragSuffixOneLonger =
+                        AF.anchorNewest (fromIntegral (AF.length volSuffix) + 1) frag
+                      weightOneLonger = totalWeightOfFragment snap fragSuffixOneLonger
+                   in isImproperSuffix .||. weightOneLonger `gt` maxRollbackWeight tsSecParam
+              , counterexample ("Volatile suffix of " <> condense frag <> " must contain at most k blocks") $
+                  AF.length volSuffix `le` fromIntegral (unNonZero (maxRollbacks tsSecParam))
+              ]
+          | frag <- tsFragments
+          , let volSuffix = takeVolatileSuffix snap tsSecParam frag
+          ]
       ]
  where
   TestSetup
     { tsWeights
     , tsPoints
     , tsFragments
+    , tsSecParam
     } = testSetup
 
   snap = mkPerasWeightSnapshot $ Map.toList tsWeights
@@ -78,6 +101,24 @@ prop_perasWeightSnapshot testSetup =
       (weightBoostOfPointReference . blockPoint)
       (AF.toOldestFirst frag)
 
+  takeVolatileSuffixReference ::
+    AnchoredFragment TestBlock -> AnchoredFragment TestBlock
+  takeVolatileSuffixReference =
+    fromJust . find hasWeightAtMostK . suffixes
+   where
+    -- Consider suffixes of @frag@, longest first
+    suffixes frag =
+      [ AF.anchorNewest (fromIntegral len) frag
+      | len <- reverse [0 .. AF.length frag]
+      ]
+
+    hasWeightAtMostK frag =
+      totalWeight <= maxRollbackWeight tsSecParam
+     where
+      weightBoost = weightBoostOfFragmentReference frag
+      lengthWeight = PerasWeight (fromIntegral (AF.length frag))
+      totalWeight = lengthWeight <> weightBoost
+
 -- | Test that the weight of a fragment is equal to the weight of its
 -- first\/last point plus the weight of the remaining suffix\/infix.
 prop_fragmentInduction ::
@@ -109,6 +150,7 @@ data TestSetup = TestSetup
   -- ^ Check the weight of these points.
   , tsFragments :: [AnchoredFragment TestBlock]
   -- ^ Check the weight of these fragments.
+  , tsSecParam :: SecurityParam
   }
   deriving stock Show
 
@@ -136,11 +178,13 @@ instance Arbitrary TestSetup where
     tsFragments <-
       for treeChains genInfixFragment
 
+    tsSecParam <- arbitrary
     pure
       TestSetup
         { tsWeights
         , tsPoints
         , tsFragments
+        , tsSecParam
         }
    where
     -- Generate a weight boost (for some point).
@@ -176,6 +220,9 @@ instance Arbitrary TestSetup where
       , [ ts{tsFragments = tsFragments'}
         | tsFragments' <- shrinkList (\_frag -> []) tsFragments
         ]
+      , [ ts{tsSecParam = tsSecParam'}
+        | tsSecParam' <- shrink tsSecParam
+        ]
       ]
    where
     -- Decrease by @1@, unless this would mean that it is non-positive.
@@ -188,4 +235,5 @@ instance Arbitrary TestSetup where
       { tsWeights
       , tsPoints
       , tsFragments
+      , tsSecParam
       } = ts
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
index d8cbf1acb0..910c7e1130 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
@@ -25,6 +25,7 @@ module Test.Ouroboros.Storage.ChainDB.Model
   , addBlock
   , addBlockPromise
   , addBlocks
+  , addPerasCert
   , empty
 
     -- * Queries
@@ -44,7 +45,7 @@ module Test.Ouroboros.Storage.ChainDB.Model
   , invalid
   , isOpen
   , isValid
-  , lastK
+  , maxPerasRoundNo
   , tipBlock
   , tipPoint
   , volatileChain
@@ -90,6 +91,7 @@ import Control.Monad.Except (runExcept)
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Lazy as Lazy
 import Data.Containers.ListUtils (nubOrdOn)
+import Data.Foldable (foldMap')
 import Data.Function (on, (&))
 import Data.Functor (($>), (<&>))
 import Data.List (isInfixOf, isPrefixOf, sortBy)
@@ -100,7 +102,6 @@ import Data.Proxy
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.TreeDiff
-import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Config
@@ -108,6 +109,8 @@ import Ouroboros.Consensus.HeaderValidation
 import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Extended
 import Ouroboros.Consensus.Ledger.SupportsProtocol
+import Ouroboros.Consensus.Peras.SelectView
+import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Protocol.MockChainSel
 import Ouroboros.Consensus.Storage.ChainDB.API
@@ -145,6 +148,7 @@ data Model blk = Model
   -- ^ The VolatileDB
   , immutableDbChain :: Chain blk
   -- ^ The ImmutableDB
+  , perasCerts :: Map PerasRoundNo (ValidatedPerasCert blk)
   , cps :: CPS.ChainProducerState blk
   , currentLedger :: ExtLedgerState blk EmptyMK
   , initLedger :: ExtLedgerState blk EmptyMK
@@ -231,72 +235,78 @@ tipPoint = maybe GenesisPoint blockPoint . tipBlock
 getMaxSlotNo :: HasHeader blk => Model blk -> MaxSlotNo
 getMaxSlotNo = foldMap (MaxSlotNo . blockSlot) . blocks
 
-lastK ::
-  HasHeader a =>
-  SecurityParam ->
-  -- | Provided since `AnchoredFragment` is not a functor
-  (blk -> a) ->
-  Model blk ->
-  AnchoredFragment a
-lastK (SecurityParam k) f =
-  Fragment.anchorNewest (unNonZero k)
-    . Chain.toAnchoredFragment
-    . fmap f
-    . currentChain
-
--- | Actual number of blocks that can be rolled back. Equal to @k@, except
--- when:
+-- | Actual amount of weight that can be rolled back. This can non-trivially
+-- smaller than @k@ in the following cases:
 --
--- * Near genesis, the chain might not be @k@ blocks long yet.
--- * After VolatileDB corruption, the whole chain might be >= @k@ blocks, but
---   the tip of the ImmutableDB might be closer than @k@ blocks away from the
---   current chain's tip.
-maxActualRollback :: HasHeader blk => SecurityParam -> Model blk -> Word64
+-- * Near genesis, the chain might not have grown sufficiently yet.
+-- * After VolatileDB corruption, the whole chain might have more than weight
+--   @k@, but the tip of the ImmutableDB might be buried under significantly
+--   less than weight @k@ worth of blocks.
+maxActualRollback :: HasHeader blk => SecurityParam -> Model blk -> PerasWeight
 maxActualRollback k m =
-  fromIntegral
-    . length
+  foldMap' (weightBoostOfPoint weights)
     . takeWhile (/= immutableTipPoint)
     . map blockPoint
     . Chain.toNewestFirst
     . currentChain
     $ m
  where
+  weights = perasWeights m
+
   immutableTipPoint = Chain.headPoint (immutableChain k m)
 
 -- | Return the immutable prefix of the current chain.
 --
 -- This is the longest of the given two chains:
 --
--- 1. The current chain with the last @k@ blocks dropped.
+-- 1. The current chain with the longest suffix of weight at most @k@ dropped.
 -- 2. The chain formed by the blocks in 'immutableDbChain', i.e., the
 --    \"ImmutableDB\". We need to take this case in consideration because the
 --    VolatileDB might have been wiped.
 --
--- We need this because we do not allow rolling back more than @k@ blocks, but
+-- We need this because we do not allow rolling back more than weight @k@, but
 -- the background thread copying blocks from the VolatileDB to the ImmutableDB
 -- might not have caught up yet. This means we cannot use the tip of the
 -- ImmutableDB to know the most recent \"immutable\" block.
 immutableChain ::
+  forall blk.
+  HasHeader blk =>
   SecurityParam ->
   Model blk ->
   Chain blk
-immutableChain (SecurityParam k) m =
+immutableChain k m =
   maxBy
+    -- As one of the two chains is a prefix of the other, Peras weight doesn't
+    -- matter here.
     Chain.length
-    (Chain.drop (fromIntegral $ unNonZero k) (currentChain m))
+    (dropAtMostWeight (maxRollbackWeight k) (currentChain m))
     (immutableDbChain m)
  where
   maxBy f a b
     | f a >= f b = a
     | otherwise = b
 
+  weights = perasWeights m
+
+  -- Drop the longest suffix with at most the given weight.
+  dropAtMostWeight :: PerasWeight -> Chain blk -> Chain blk
+  dropAtMostWeight budget = go mempty
+   where
+    go w = \case
+      Genesis -> Genesis
+      c@(c' :> b)
+        | w' <= budget -> go w' c'
+        | otherwise -> c
+       where
+        w' = w <> PerasWeight 1 <> weightBoostOfPoint weights (blockPoint b)
+
 -- | Return the volatile suffix of the current chain.
 --
 -- The opposite of 'immutableChain'.
 --
 -- This is the shortest of the given two chain fragments:
 --
--- 1. The last @k@ blocks of the current chain.
+-- 1. The longest suffix of the current chain with weight at most @k@.
 -- 2. The suffix of the current chain not part of the 'immutableDbChain', i.e.,
 --    the \"ImmutableDB\".
 volatileChain ::
@@ -368,6 +378,16 @@ isValid = flip getIsValid
 getLoEFragment :: Model blk -> LoE (AnchoredFragment blk)
 getLoEFragment = loeFragment
 
+perasWeights :: StandardHash blk => Model blk -> PerasWeightSnapshot blk
+perasWeights =
+  mkPerasWeightSnapshot
+    . fmap (\cert -> (getPerasCertBoostedBlock cert, getPerasCertBoost cert))
+    . Map.elems
+    . perasCerts
+
+maxPerasRoundNo :: Model blk -> Maybe PerasRoundNo
+maxPerasRoundNo m = fst <$> Map.lookupMax (perasCerts m)
+
 {-------------------------------------------------------------------------------
   Construction
 -------------------------------------------------------------------------------}
@@ -381,6 +401,7 @@ empty loe initLedger =
   Model
     { volatileDbBlocks = Map.empty
     , immutableDbChain = Chain.Genesis
+    , perasCerts = Map.empty
     , cps = CPS.initChainProducerState Chain.Genesis
     , currentLedger = initLedger
     , initLedger = initLedger
@@ -420,6 +441,23 @@ addBlock cfg blk m
       -- If it's an invalid block we've seen before, ignore it.
       Map.member (blockHash blk) (invalid m)
 
+addPerasCert ::
+  forall blk.
+  (LedgerSupportsProtocol blk, LedgerTablesAreTrivial (ExtLedgerState blk)) =>
+  TopLevelConfig blk ->
+  ValidatedPerasCert blk ->
+  Model blk ->
+  Model blk
+addPerasCert cfg cert m
+  -- Do not alter the model when a certificate for that round already exists.
+  | Map.member certRound (perasCerts m) = m
+  | otherwise =
+      chainSelection
+        cfg
+        m{perasCerts = Map.insert certRound cert (perasCerts m)}
+ where
+  certRound = getPerasCertRound cert
+
 chainSelection ::
   forall blk.
   ( LedgerTablesAreTrivial (ExtLedgerState blk)
@@ -432,6 +470,7 @@ chainSelection cfg m =
   Model
     { volatileDbBlocks = volatileDbBlocks m
     , immutableDbChain = immutableDbChain m
+    , perasCerts = perasCerts m
     , cps = CPS.switchFork newChain (cps m)
     , currentLedger = newLedger
     , initLedger = initLedger m
@@ -531,7 +570,10 @@ chainSelection cfg m =
       . selectChain
         (Proxy @(BlockProtocol blk))
         (projectChainOrderConfig (configBlock cfg))
-        (selectView (configBlock cfg) . getHeader)
+        ( weightedSelectView (configBlock cfg) (perasWeights m)
+            . Chain.toAnchoredFragment
+            . fmap getHeader
+        )
         (currentChain m)
       $ consideredCandidates
 
@@ -863,7 +905,7 @@ validChains cfg m bs =
   sortChains =
     sortBy $
       flip
-        ( Fragment.compareAnchoredFragments (configBlock cfg)
+        ( Fragment.compareAnchoredFragments (configBlock cfg) (perasWeights m)
             `on` (Chain.toAnchoredFragment . fmap getHeader)
         )
 
@@ -899,7 +941,11 @@ between k from to m = do
   fork <- errFork
   -- See #871.
   if partOfCurrentChain fork
-    || Fragment.forksAtMostKBlocks (maxActualRollback k m) currentFrag fork
+    || Fragment.forksAtMostKWeight
+      (perasWeights m)
+      (maxActualRollback k m)
+      currentFrag
+      fork
     then return $ Fragment.toOldestFirst fork
     -- We cannot stream from an old fork
     else Left $ ForkTooOld from
@@ -1039,6 +1085,8 @@ garbageCollect ::
 garbageCollect secParam m@Model{..} =
   m
     { volatileDbBlocks = Map.filter (not . collectable) volatileDbBlocks
+    -- TODO garbage collection Peras certs?
+    -- See https://github.com/tweag/cardano-peras/issues/121
     }
  where
   -- TODO what about iterators that will stream garbage collected blocks?
@@ -1078,6 +1126,8 @@ closeDB m@Model{..} =
 reopen :: Model blk -> Model blk
 reopen m = m{isOpen = True}
 
+-- TODO: update to account for persisted Peras certificates.
+-- see https://github.com/tweag/cardano-peras/issues/122
 wipeVolatileDB ::
   forall blk.
   (LedgerSupportsProtocol blk, LedgerTablesAreTrivial (ExtLedgerState blk)) =>
@@ -1090,6 +1140,7 @@ wipeVolatileDB cfg m =
   m' =
     (closeDB m)
       { volatileDbBlocks = Map.empty
+      , perasCerts = Map.empty
       , cps = CPS.switchFork newChain (cps m)
       , currentLedger = newLedger
       , invalid = Map.empty
@@ -1108,7 +1159,11 @@ wipeVolatileDB cfg m =
       $ selectChain
         (Proxy @(BlockProtocol blk))
         (projectChainOrderConfig (configBlock cfg))
-        (selectView (configBlock cfg) . getHeader)
+        -- Weight is inconsequential as there is only a single candidate.
+        ( weightedSelectView (configBlock cfg) emptyPerasWeightSnapshot
+            . Chain.toAnchoredFragment
+            . fmap getHeader
+        )
         Chain.genesis
       $ snd
       $ validChains cfg m (immutableDbBlocks m)
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs
index 6293e11968..b991a13da6 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs
@@ -22,11 +22,11 @@
 -- chain DB, we always pick the most preferred chain.
 module Test.Ouroboros.Storage.ChainDB.Model.Test (tests) where
 
-import Cardano.Ledger.BaseTypes (unNonZero)
 import GHC.Stack
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.Ledger.Tables
+import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( LoE (..)
   , StreamFrom (..)
@@ -96,16 +96,21 @@ prop_alwaysPickPreferredChain bt p =
 
   curFragment = Chain.toAnchoredFragment (getHeader <$> current)
 
-  SecurityParam k = configSecurityParam singleNodeTestConfig
+  k = configSecurityParam singleNodeTestConfig
 
   bcfg = configBlock singleNodeTestConfig
 
   preferCandidate' candidate =
-    AF.preferAnchoredCandidate bcfg curFragment candFragment
-      && AF.forksAtMostKBlocks (unNonZero k) curFragment candFragment
+    AF.preferAnchoredCandidate bcfg weights curFragment candFragment
+      && AF.forksAtMostKWeight weights (maxRollbackWeight k) curFragment candFragment
    where
     candFragment = Chain.toAnchoredFragment (getHeader <$> candidate)
 
+    -- TODO test with non-trivial weights
+    -- see https://github.com/tweag/cardano-peras/issues/123
+    weights :: PerasWeightSnapshot TestBlock
+    weights = emptyPerasWeightSnapshot
+
 -- TODO add properties about forks too
 prop_between_currentChain :: LoE () -> BlockTree -> Property
 prop_between_currentChain loe bt =
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
index 4e97810d90..e3a787a6c6 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -127,6 +127,7 @@ import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
 import Ouroboros.Consensus.Storage.LedgerDB (LedgerSupportsLedgerDB)
 import qualified Ouroboros.Consensus.Storage.LedgerDB.TraceEvent as LedgerDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.DbChangelog as DbChangelog
+import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util (split)
 import Ouroboros.Consensus.Util.CallStack
@@ -178,6 +179,7 @@ import Test.Util.WithEq
 -- | Commands
 data Cmd blk it flr
   = AddBlock blk
+  | AddPerasCert (ValidatedPerasCert blk)
   | GetCurrentChain
   | GetTipBlock
   | GetTipHeader
@@ -402,8 +404,9 @@ run ::
   Cmd blk (TestIterator m blk) (TestFollower m blk) ->
   m (Success blk (TestIterator m blk) (TestFollower m blk))
 run cfg env@ChainDBEnv{varDB, ..} cmd =
-  readTVarIO varDB >>= \st@ChainDBState{chainDB = ChainDB{..}, internal} -> case cmd of
+  readTVarIO varDB >>= \st@ChainDBState{chainDB = chainDB@ChainDB{..}, internal} -> case cmd of
     AddBlock blk -> Point <$> advanceAndAdd st blk
+    AddPerasCert cert -> Unit <$> addPerasCertSync chainDB cert
     GetCurrentChain -> Chain <$> atomically getCurrentChain
     GetTipBlock -> MbBlock <$> getTipBlock
     GetTipHeader -> MbHeader <$> getTipHeader
@@ -638,6 +641,7 @@ runPure ::
   (Resp blk IteratorId FollowerId, DBModel blk)
 runPure cfg = \case
   AddBlock blk -> ok Point $ update (add blk)
+  AddPerasCert cert -> ok Unit $ ((),) . update (Model.addPerasCert cfg cert)
   GetCurrentChain -> ok Chain $ query (Model.volatileChain k getHeader)
   GetTipBlock -> ok MbBlock $ query Model.tipBlock
   GetTipHeader -> ok MbHeader $ query (fmap getHeader . Model.tipBlock)
@@ -909,6 +913,11 @@ generator loe genBlock m@Model{..} =
   At
     <$> frequency
       [ (30, genAddBlock)
+      , let freq = case loe of
+              LoEDisabled -> 10
+              -- The LoE does not yet support Peras.
+              LoEEnabled () -> 0
+         in (freq, AddPerasCert <$> genAddPerasCert)
       , (if empty then 1 else 10, return GetCurrentChain)
       , --    , (if empty then 1 else 10, return GetLedgerDB)
         (if empty then 1 else 10, return GetTipBlock)
@@ -1034,6 +1043,24 @@ generator loe genBlock m@Model{..} =
 
   genAddBlock = AddBlock <$> genBlock m
 
+  genAddPerasCert :: Gen (ValidatedPerasCert blk)
+  genAddPerasCert = do
+    -- TODO should we be more strict on which blocks we add certs to?
+    -- see https://github.com/tweag/cardano-peras/issues/124
+    blk <- genBlock m
+    let roundNo = case Model.maxPerasRoundNo dbModel of
+          Nothing -> PerasRoundNo 0
+          Just (PerasRoundNo r) -> PerasRoundNo (r + 1)
+    pure $
+      ValidatedPerasCert
+        { vpcCert =
+            PerasCert
+              { pcCertRound = roundNo
+              , pcCertBoostedBlock = blockPoint blk
+              }
+        , vpcCertBoost = boostPerCert
+        }
+
   genBounds :: Gen (StreamFrom blk, StreamTo blk)
   genBounds =
     frequency
@@ -1232,16 +1259,33 @@ invariant cfg Model{..} =
 
 postcondition ::
   TestConstraints blk =>
+  TopLevelConfig blk ->
   Model blk m Concrete ->
   At Cmd blk m Concrete ->
   At Resp blk m Concrete ->
   Logic
-postcondition model cmd resp =
+postcondition cfg model cmd resp =
   (toMock (eventAfter ev) resp .== eventMockResp ev)
     .// "real response didn't match model response"
+    .&& immutableTipMonotonicity
  where
   ev = lockstep model cmd resp
 
+  immutableTipMonotonicity = case unAt cmd of
+    -- When we wipe the VolatileDB (and haven't persisted all immutable blocks),
+    -- the immutable tip can recede.
+    WipeVolatileDB -> Top
+    _ ->
+      Annotate ("Immutable tip non-monotonicity: " <> show before <> " > " <> show after) $
+        Boolean (before <= after)
+   where
+    before = immTipBlockNo $ eventBefore ev
+    after = immTipBlockNo $ eventAfter ev
+    immTipBlockNo =
+      Chain.headBlockNo
+        . Model.immutableChain (configSecurityParam cfg)
+        . dbModel
+
 semantics ::
   forall blk.
   TestConstraints blk =>
@@ -1271,7 +1315,7 @@ sm loe env genBlock cfg initLedger =
     { initModel = initModel loe cfg initLedger
     , transition = transition
     , precondition = precondition
-    , postcondition = postcondition
+    , postcondition = postcondition cfg
     , generator = Just . generator loe genBlock
     , shrinker = shrinker
     , semantics = semantics cfg env
@@ -1329,14 +1373,19 @@ deriving instance SOP.Generic (ImmutableDB.TraceEvent blk)
 deriving instance SOP.HasDatatypeInfo (ImmutableDB.TraceEvent blk)
 deriving instance SOP.Generic (VolatileDB.TraceEvent blk)
 deriving instance SOP.HasDatatypeInfo (VolatileDB.TraceEvent blk)
+deriving instance SOP.Generic (PerasCertDB.TraceEvent blk)
+deriving instance SOP.HasDatatypeInfo (PerasCertDB.TraceEvent blk)
 deriving anyclass instance SOP.Generic (TraceChainSelStarvationEvent blk)
 deriving anyclass instance SOP.HasDatatypeInfo (TraceChainSelStarvationEvent blk)
+deriving anyclass instance SOP.Generic (TraceAddPerasCertEvent blk)
+deriving anyclass instance SOP.HasDatatypeInfo (TraceAddPerasCertEvent blk)
 
 data Tag
   = TagGetIsValidJust
   | TagGetIsValidNothing
   | TagChainSelReprocessChangedSelection
   | TagChainSelReprocessKeptSelection
+  | TagSwitchedToShorterChain
   deriving (Show, Eq)
 
 -- | Predicate on events
@@ -1363,6 +1412,7 @@ tag =
     , tagGetIsValidNothing
     , tagChainSelReprocess TagChainSelReprocessChangedSelection (/=)
     , tagChainSelReprocess TagChainSelReprocessKeptSelection (==)
+    , tagSwitchedToShorterChain
     ]
  where
   tagGetIsValidJust :: EventPred m
@@ -1387,6 +1437,21 @@ tag =
           Left t
     _ -> Right $ tagChainSelReprocess t test
 
+  -- Tag this test case if we ever switch from a longer to a shorter chain in a
+  -- non-degenerate case.
+  tagSwitchedToShorterChain :: EventPred m
+  tagSwitchedToShorterChain = C.predicate $ \case
+    ev
+      | case unAt $ eventCmd ev of
+          -- Wiping the VolatileDB is not interesting here.
+          WipeVolatileDB{} -> False
+          _ -> True
+      , ((>) `on` curChainLength) (eventBefore ev) (eventAfter ev) ->
+          Left TagSwitchedToShorterChain
+      | otherwise -> Right tagSwitchedToShorterChain
+   where
+    curChainLength = Chain.length . Model.currentChain . dbModel
+
 -- | Step the model using a 'QSM.Command' (i.e., a command associated with
 -- an explicit set of variables)
 execCmd ::
@@ -1755,8 +1820,10 @@ traceEventName = \case
   TraceLedgerDBEvent ev -> "Ledger." <> constrName ev
   TraceImmutableDBEvent ev -> "ImmutableDB." <> constrName ev
   TraceVolatileDBEvent ev -> "VolatileDB." <> constrName ev
+  TracePerasCertDbEvent ev -> "PerasCertDB." <> constrName ev
   TraceLastShutdownUnclean -> "LastShutdownUnclean"
   TraceChainSelStarvationEvent ev -> "ChainSelStarvation." <> constrName ev
+  TraceAddPerasCertEvent ev -> "AddPerasCert." <> constrName ev
 
 mkArgs ::
   IOLike m =>
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasCertDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasCertDB/StateMachine.hs
index 881338825e..a4b9f0fd12 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasCertDB/StateMachine.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasCertDB/StateMachine.hs
@@ -25,11 +25,11 @@ import Ouroboros.Consensus.Storage.PerasCertDB.API (AddPerasCertResult (..), Per
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.STM
 import qualified Test.Ouroboros.Storage.PerasCertDB.Model as Model
-import Test.QuickCheck
+import Test.QuickCheck hiding (Some (..))
 import qualified Test.QuickCheck.Monadic as QC
 import Test.QuickCheck.StateModel
 import Test.Tasty
-import Test.Tasty.QuickCheck
+import Test.Tasty.QuickCheck hiding (Some (..))
 import Test.Util.TestBlock (TestBlock, TestHash (..))
 import Test.Util.TestEnv (adjustQuickCheckTests)