diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
index 358048c796..ad3d6e60a1 100644
--- a/ouroboros-consensus/ouroboros-consensus.cabal
+++ b/ouroboros-consensus/ouroboros-consensus.cabal
@@ -598,6 +598,7 @@ test-suite consensus-test
     Test.Consensus.MiniProtocol.ChainSync.CSJ
     Test.Consensus.MiniProtocol.ChainSync.Client
     Test.Consensus.MiniProtocol.LocalStateQuery.Server
+    Test.Consensus.Peras.WeightSnapshot
     Test.Consensus.Util.MonadSTM.NormalForm
     Test.Consensus.Util.Versioned
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs
index e2d559d9c3..7709e759cf 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs
@@ -21,6 +21,7 @@ import Data.Word (Word64)
 import GHC.Generics (Generic)
 import NoThunks.Class
 import Ouroboros.Consensus.Block.Abstract
+import Ouroboros.Consensus.Util.Condense
 import Quiet (Quiet (..))
 
 newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64}
@@ -28,12 +29,18 @@ newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64}
   deriving stock Generic
   deriving newtype (Eq, Ord, NoThunks)
 
+instance Condense PerasRoundNo where
+  condense = show . unPerasRoundNo
+
 newtype PerasWeight = PerasWeight {unPerasWeight :: Word64}
   deriving Show via Quiet PerasWeight
   deriving stock Generic
   deriving newtype (Eq, Ord, NoThunks)
   deriving (Semigroup, Monoid) via Sum Word64
 
+instance Condense PerasWeight where
+  condense = show . unPerasWeight
+
 -- | TODO this will become a Ledger protocol parameter
 boostPerCert :: PerasWeight
 boostPerCert = PerasWeight 15
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..2aade1eeb9 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,39 @@
 {-# 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 (Ouroboros Peras), we interpret this as the
+-- maximum amount of weight we can roll back.
+--
+-- i.e. k == 30: we can roll back at most 30 unweighted blocks, or two blocks
+-- each having additional weight 14.
 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/Peras/Weight.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs
index baa72875a3..fed6d63844 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Weight.hs
@@ -26,14 +26,18 @@ module Ouroboros.Consensus.Peras.Weight
     -- * Query
   , weightBoostOfPoint
   , weightBoostOfFragment
+  , totalWeightOfFragment
+  , takeVolatileSuffix
   ) where
 
 import Data.Foldable as Foldable (foldl')
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import Data.Word (Word64)
 import GHC.Generics (Generic)
 import NoThunks.Class
 import Ouroboros.Consensus.Block
+import Ouroboros.Consensus.Config.SecurityParam
 import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 
@@ -236,11 +240,140 @@ weightBoostOfFragment weightSnap frag =
     (weightBoostOfPoint weightSnap . castPoint . blockPoint)
     (AF.toOldestFirst frag)
 
+-- | Get the total weight for a fragment, ie the length plus the weight boost
+-- ('weightBoostOfFragment') of the fragment.
+--
+-- Note that this quantity is relative to the anchor of the fragment, so it
+-- should only be compared against other fragments with the same anchor.
+--
+-- >>> :{
+-- 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"
+-- frag0 :: AnchoredFragment (HeaderFields Blk)
+-- frag0 = Empty AnchorGenesis :> foo :> bar
+-- :}
+--
+-- >>> totalWeightOfFragment snap frag0
+-- PerasWeight 8
+--
+-- Only keeping the last block from @frag0@:
+--
+-- >>> frag1 = AF.anchorNewest 1 frag0
+-- >>> totalWeightOfFragment snap frag1
+-- PerasWeight 3
+--
+-- Dropping the head from @frag0@, and instead adding an unboosted point:
+--
+-- >>> frag2 = AF.dropNewest 1 frag0 :> HeaderFields (SlotNo 4) (BlockNo 2) "baz"
+-- >>> totalWeightOfFragment snap frag2
+-- PerasWeight 6
+totalWeightOfFragment ::
+  forall blk h.
+  (StandardHash blk, HasHeader h, HeaderHash blk ~ HeaderHash h) =>
+  PerasWeightSnapshot blk ->
+  AnchoredFragment h ->
+  PerasWeight
+totalWeightOfFragment weightSnap frag =
+  weightLength <> weightBoost
+ where
+  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).
+--
+-- >>> :{
+-- 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 frag
+  | Map.null $ getPerasWeightSnapshot snap =
+      -- Optimize the case where Peras is disabled.
+      AF.anchorNewest (unPerasWeight k) frag
+  | hasAtMostWeightK frag = frag
+  | otherwise = go 0 lenFrag (AF.Empty $ AF.headAnchor frag)
+ where
+  k :: PerasWeight
+  k = maxRollbackWeight secParam
+
+  hasAtMostWeightK :: AnchoredFragment h -> Bool
+  hasAtMostWeightK f = totalWeightOfFragment snap f <= k
+
+  lenFrag = fromIntegral $ AF.length frag
+
+  -- Binary search for the longest suffix of @frag@ which 'hasAtMostWeightK'.
+  go ::
+    Word64 -> -- lb. The length lb suffix satisfies 'hasAtMostWeightK'.
+    Word64 -> -- ub. The length ub suffix does not satisfy 'hasAtMostWeightK'.
+    AnchoredFragment h -> -- The length lb suffix.
+    AnchoredFragment h
+  go lb ub lbFrag
+    | lb + 1 == ub = lbFrag
+    | hasAtMostWeightK midFrag = go mid ub midFrag
+    | otherwise = go lb mid lbFrag
+   where
+    mid = (lb + ub) `div` 2
+    midFrag = AF.anchorNewest mid frag
+
 -- $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 -XTypeFamilies
+-- >>> :set -XDataKinds -XTypeApplications -XTypeFamilies
 -- >>> data Blk = Blk
 -- >>> type instance HeaderHash Blk = String
 -- >>> instance StandardHash Blk
diff --git a/ouroboros-consensus/test/consensus-test/Main.hs b/ouroboros-consensus/test/consensus-test/Main.hs
index 88681b82fa..beddd1f7d2 100644
--- a/ouroboros-consensus/test/consensus-test/Main.hs
+++ b/ouroboros-consensus/test/consensus-test/Main.hs
@@ -16,6 +16,7 @@ import qualified Test.Consensus.MiniProtocol.BlockFetch.Client (tests)
 import qualified Test.Consensus.MiniProtocol.ChainSync.CSJ (tests)
 import qualified Test.Consensus.MiniProtocol.ChainSync.Client (tests)
 import qualified Test.Consensus.MiniProtocol.LocalStateQuery.Server (tests)
+import qualified Test.Consensus.Peras.WeightSnapshot (tests)
 import qualified Test.Consensus.Util.MonadSTM.NormalForm (tests)
 import qualified Test.Consensus.Util.Versioned (tests)
 import Test.Tasty
@@ -43,6 +44,7 @@ tests =
         , Test.Consensus.Mempool.Fairness.tests
         , Test.Consensus.Mempool.StateMachine.tests
         ]
+    , Test.Consensus.Peras.WeightSnapshot.tests
     , Test.Consensus.Util.MonadSTM.NormalForm.tests
     , Test.Consensus.Util.Versioned.tests
     , testGroup
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs
new file mode 100644
index 0000000000..59fd52d636
--- /dev/null
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/Peras/WeightSnapshot.hs
@@ -0,0 +1,176 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
+#if __GLASGOW_HASKELL__ >= 910
+{-# OPTIONS_GHC -Wno-x-partial #-}
+#endif
+
+-- | Test that 'PerasWeightSnapshot' can correctly compute the weight of points
+-- and fragments.
+module Test.Consensus.Peras.WeightSnapshot (tests) where
+
+import Cardano.Ledger.BaseTypes (unNonZero)
+import Data.Containers.ListUtils (nubOrd)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (catMaybes)
+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)
+import qualified Ouroboros.Network.AnchoredFragment as AF
+import qualified Ouroboros.Network.Mock.Chain as Chain
+import Test.QuickCheck
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Util.Orphans.Arbitrary ()
+import Test.Util.QuickCheck
+import Test.Util.TestBlock
+
+tests :: TestTree
+tests =
+  testGroup
+    "PerasWeightSnapshot"
+    [ testProperty "correctness" prop_perasWeightSnapshot
+    ]
+
+prop_perasWeightSnapshot :: TestSetup -> Property
+prop_perasWeightSnapshot testSetup =
+  tabulate "log₂ # of points" [show $ round @Double @Int $ logBase 2 (fromIntegral (length tsPoints))]
+    . counterexample ("PerasWeightSnapshot: " <> show snap)
+    $ conjoin
+      [ conjoin
+          [ counterexample ("Incorrect weight for " <> condense pt) $
+              weightBoostOfPointReference pt =:= weightBoostOfPoint snap pt
+          | pt <- tsPoints
+          ]
+      , conjoin
+          [ counterexample ("Incorrect weight for " <> condense frag) $
+              weightBoostOfFragmentReference frag =:= weightBoostOfFragment snap frag
+          | 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 ("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
+
+  weightBoostOfPointReference :: Point TestBlock -> PerasWeight
+  weightBoostOfPointReference pt = Map.findWithDefault mempty pt tsWeights
+
+  weightBoostOfFragmentReference :: AnchoredFragment TestBlock -> PerasWeight
+  weightBoostOfFragmentReference frag =
+    foldMap
+      (weightBoostOfPointReference . blockPoint)
+      (AF.toOldestFirst frag)
+
+  takeVolatileSuffixReference ::
+    AnchoredFragment TestBlock -> AnchoredFragment TestBlock
+  takeVolatileSuffixReference frag =
+    head
+      [ suffix
+      | len <- reverse [0 .. AF.length frag]
+      , -- Consider suffixes of @frag@, longest first
+      let suffix = AF.anchorNewest (fromIntegral len) frag
+          weightBoost = weightBoostOfFragmentReference suffix
+          lengthWeight = PerasWeight (fromIntegral (AF.length suffix))
+          totalWeight = lengthWeight <> weightBoost
+      , totalWeight <= maxRollbackWeight tsSecParam
+      ]
+
+data TestSetup = TestSetup
+  { tsWeights :: Map (Point TestBlock) PerasWeight
+  , tsPoints :: [Point TestBlock]
+  -- ^ Check the weight of these points.
+  , tsFragments :: [AnchoredFragment TestBlock]
+  -- ^ Check the weight of these fragments.
+  , tsSecParam :: SecurityParam
+  }
+  deriving stock Show
+
+instance Arbitrary TestSetup where
+  arbitrary = do
+    tree :: BlockTree <- arbitrary
+    let tsPoints = nubOrd $ GenesisPoint : (blockPoint <$> treeToBlocks tree)
+        treeChains = treeToChains tree
+    tsWeights <- do
+      boostedChain <- elements treeChains
+      let boostablePts =
+            GenesisPoint : (blockPoint <$> Chain.toOldestFirst boostedChain)
+      Map.fromList . catMaybes <$> for boostablePts \pt -> do
+        weight <-
+          frequency
+            [ (3, pure Nothing)
+            , (1, Just . PerasWeight <$> choose (1, 10))
+            ]
+        pure $ (pt,) <$> weight
+    tsFragments <- for treeChains \chain -> do
+      let lenChain = Chain.length chain
+          fullFrag = Chain.toAnchoredFragment chain
+      nTakeNewest <- choose (0, lenChain)
+      nDropNewest <- choose (0, nTakeNewest)
+      pure $
+        AF.dropNewest nDropNewest $
+          AF.anchorNewest (fromIntegral nTakeNewest) fullFrag
+    tsSecParam <- arbitrary
+    pure
+      TestSetup
+        { tsWeights
+        , tsPoints
+        , tsFragments
+        , tsSecParam
+        }
+
+  shrink ts =
+    concat
+      [ [ ts{tsWeights = Map.fromList tsWeights'}
+        | tsWeights' <-
+            shrinkList
+              -- Shrink boosted points to have weight 1.
+              (\(pt, w) -> [(pt, w1) | w1 /= w])
+              $ Map.toList tsWeights
+        ]
+      , [ ts{tsPoints = tsPoints'}
+        | tsPoints' <- shrinkList (\_pt -> []) tsPoints
+        ]
+      , [ ts{tsFragments = tsFragments'}
+        | tsFragments' <- shrinkList (\_frag -> []) tsFragments
+        ]
+      , [ ts{tsSecParam = tsSecParam'}
+        | tsSecParam' <- shrink tsSecParam
+        ]
+      ]
+   where
+    w1 = PerasWeight 1
+
+    TestSetup
+      { tsWeights
+      , tsPoints
+      , tsFragments
+      , tsSecParam
+      } = ts