diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal
index 74b14729e73..621a698cd92 100644
--- a/lib/core/cardano-wallet-core.cabal
+++ b/lib/core/cardano-wallet-core.cabal
@@ -422,6 +422,7 @@ test-suite unit
       Cardano.Wallet.CoinSelection.Internal.BalanceSpec
       Cardano.Wallet.CoinSelection.Internal.CollateralSpec
       Cardano.Wallet.DB.Arbitrary
+      Cardano.Wallet.DB.CheckpointsSpec
       Cardano.Wallet.DB.MVarSpec
       Cardano.Wallet.DB.Properties
       Cardano.Wallet.DB.SqliteSpec
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
index d0ec641bc83..6b9a3b0c9ce 100644
--- a/lib/core/src/Cardano/Wallet.hs
+++ b/lib/core/src/Cardano/Wallet.hs
@@ -246,16 +246,20 @@ import Cardano.Wallet.DB
     , ErrPutLocalTxSubmission (..)
     , ErrRemoveTx (..)
     , ErrWalletAlreadyExists (..)
-    , SparseCheckpointsConfig (..)
-    , defaultSparseCheckpointsConfig
-    , sparseCheckpoints
     )
 import Cardano.Wallet.DB.Checkpoints
-    ( DeltaCheckpoints (..) )
+    ( extendAndPrune )
 import Cardano.Wallet.DB.Sqlite.AddressBook
     ( AddressBookIso, getPrologue )
 import Cardano.Wallet.DB.WalletState
-    ( DeltaMap (..), DeltaWalletState1 (..), fromWallet, getLatest, getSlot )
+    ( DeltaWalletState1 (..)
+    , WalletState (..)
+    , adjustNoSuchWallet
+    , fromWallet
+    , getBlockHeight
+    , getLatest
+    , getSlot
+    )
 import Cardano.Wallet.Logging
     ( BracketLog
     , BracketLog' (..)
@@ -1041,48 +1045,30 @@ restoreBlocks ctx tr wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomic
         liftIO $ logDelegation delegation
         putDelegationCertificate wid cert slotNo
 
-    let unstable = Set.fromList $ sparseCheckpoints cfg (nodeTip ^. #blockHeight)
-            where
-                -- NOTE
-                -- The edge really is an optimization to avoid rolling back too
-                -- "far" in the past. Yet, we let the edge construct itself
-                -- organically once we reach the tip of the chain and start
-                -- processing blocks one by one.
-                --
-                -- This prevents the wallet from trying to create too many
-                -- checkpoints at once during restoration which causes massive
-                -- performance degradation on large wallets.
-                --
-                -- Rollback may still occur during this short period, but
-                -- rolling back from a few hundred blocks is relatively fast
-                -- anyway.
-                cfg = (defaultSparseCheckpointsConfig epochStability) { edgeSize = 0 }
-
-        getBlockHeight cp = fromIntegral $
-            cp ^. #currentTip . #blockHeight . #getQuantity
-        willKeep cp = getBlockHeight cp `Set.member` unstable
-        cpsKeep = filter willKeep (NE.init cps) <> [NE.last cps]
-
-        -- NOTE: We have to update the 'Prologue' as well,
-        -- as it can contain addresses for pending transactions,
-        -- which are removed from the 'Prologue' once the
-        -- transactions are accepted onto the chain and discovered.
-        --
-        -- I'm not so sure that the approach here is correct with
-        -- respect to rollbacks, but it is functionally the same
-        -- as the code that came before.
-        deltaPrologue =
-            [ ReplacePrologue $ getPrologue $ getState $ NE.last cps ]
-        delta = deltaPrologue ++ reverse
-            [ UpdateCheckpoints $ PutCheckpoint (getSlot wcp) wcp
-            | wcp <- map (snd . fromWallet) cpsKeep
-            ]
-
-    liftIO $ mapM_ logCheckpoint cpsKeep
     ExceptT $ modifyDBMaybe walletsDB $
-        adjustNoSuchWallet wid id $ \_ -> Right ( delta, () )
+        adjustNoSuchWallet wid id $ \wal ->
+            let
+                wcps = snd . fromWallet <$> cps
+                deltaCheckpoints =
+                    [ UpdateCheckpoints
+                      $ extendAndPrune getSlot (Quantity . getBlockHeight) epochStability
+                        (nodeTip ^. #blockHeight) wcps (checkpoints wal)
+                    ]
+                -- NOTE: We have to update the 'Prologue' as well,
+                -- as it can contain addresses for pending transactions,
+                -- which are removed from the 'Prologue' once the
+                -- transactions are accepted onto the chain and discovered.
+                --
+                -- I'm not so sure that the approach here is correct with
+                -- respect to rollbacks, but it is functionally the same
+                -- as the code that came before.
+                deltaPrologue =
+                    [ ReplacePrologue $ getPrologue $ getState $ NE.last cps ]
+            in Right ( deltaPrologue ++ deltaCheckpoints, () )
 
-    prune wid epochStability
+    -- Note: At this point, checkpoints have already been pruned
+    -- we only prune LocalTxSubmission and TxHistory here.
+    pruneTxs wid epochStability
 
     liftIO $ do
         traceWith tr $ MsgDiscoveredTxs txs
@@ -1091,9 +1077,6 @@ restoreBlocks ctx tr wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomic
     nl = ctx ^. networkLayer
     db = ctx ^. dbLayer @IO @s @k
 
-    logCheckpoint :: Wallet s -> IO ()
-    logCheckpoint cp = traceWith tr $ MsgCheckpoint (currentTip cp)
-
     logDelegation :: (SlotNo, DelegationCertificate) -> IO ()
     logDelegation = traceWith tr . uncurry MsgDiscoveredDelegationCert
 
@@ -1402,18 +1385,6 @@ importRandomAddresses ctx wid addrs = db & \DBLayer{..} ->
         s0  = getState $ getLatest wal
         es1 = foldl' (\s addr -> s >>= Rnd.importAddress addr) (Right s0) addrs
 
--- | Adjust a specific wallet if it exists or return 'ErrNoSuchWallet'.
-adjustNoSuchWallet
-    :: WalletId
-    -> (ErrNoSuchWallet -> e)
-    -> (w -> Either e (dw, b))
-    -> (Map WalletId w -> (Maybe (DeltaMap WalletId dw), Either e b))
-adjustNoSuchWallet wid err update wallets = case Map.lookup wid wallets of
-    Nothing -> (Nothing, Left $ err $ ErrNoSuchWallet wid)
-    Just wal -> case update wal of
-        Left e -> (Nothing, Left e)
-        Right (dw, b) -> (Just $ Adjust wid dw, Right b)
-
 -- NOTE
 -- Addresses coming from the transaction history might be payment or
 -- delegation addresses. So we normalize them all to be delegation addresses
diff --git a/lib/core/src/Cardano/Wallet/DB.hs b/lib/core/src/Cardano/Wallet/DB.hs
index e9879d8b204..7f1a98ca6ab 100644
--- a/lib/core/src/Cardano/Wallet/DB.hs
+++ b/lib/core/src/Cardano/Wallet/DB.hs
@@ -1,8 +1,5 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -19,12 +16,6 @@ module Cardano.Wallet.DB
     , DBFactory (..)
     , cleanDB
 
-      -- * Checkpoints
-    , sparseCheckpoints
-    , SparseCheckpointsConfig (..)
-    , defaultSparseCheckpointsConfig
-    , gapSize
-
       -- * Errors
     , ErrBadFormat(..)
     , ErrNoSuchWallet(..)
@@ -39,7 +30,7 @@ import Prelude
 import Cardano.Address.Derivation
     ( XPrv )
 import Cardano.Wallet.DB.WalletState
-    ( DeltaMap, DeltaWalletState )
+    ( DeltaMap, DeltaWalletState, ErrNoSuchWallet (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..) )
 import Cardano.Wallet.Primitive.Model
@@ -76,12 +67,10 @@ import Data.DBVar
 import Data.Quantity
     ( Quantity (..) )
 import Data.Word
-    ( Word32, Word8 )
+    ( Word32 )
 import UnliftIO.Exception
     ( Exception )
 
-import qualified Data.List as L
-
 -- | Instantiate database layers at will
 data DBFactory m s k = DBFactory
     { withDatabase :: forall a. WalletId -> (DBLayer m s k -> IO a) -> IO a
@@ -328,11 +317,11 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
         -- point of rollback but can't be guaranteed to be exactly the same
         -- because the database may only keep sparse checkpoints.
 
-    , prune
+    , pruneTxs
         :: WalletId
         -> Quantity "block" Word32
         -> ExceptT ErrNoSuchWallet stm ()
-        -- ^ Prune database entities and remove entities that can be discarded.
+        -- ^ Prune and remove local tx submission and outdated transactions.
         --
         -- The second argument represents the stability window, or said
         -- length of the deepest rollback.
@@ -351,11 +340,6 @@ data ErrBadFormat
 
 instance Exception ErrBadFormat
 
--- | Can't perform given operation because there's no wallet
-newtype ErrNoSuchWallet
-    = ErrNoSuchWallet WalletId -- Wallet is gone or doesn't exist yet
-    deriving (Eq, Show)
-
 -- | Can't add a transaction to the local tx submission pool.
 data ErrPutLocalTxSubmission
     = ErrPutLocalTxSubmissionNoSuchWallet ErrNoSuchWallet
@@ -384,117 +368,3 @@ newtype ErrWalletAlreadyExists
 cleanDB :: DBLayer m s k -> m ()
 cleanDB DBLayer{..} = atomically $
     listWallets >>= mapM_ (runExceptT . removeWallet)
-
--- | Storing EVERY checkpoints in the database is quite expensive and useless.
--- We make the following assumptions:
---
--- - We can't rollback for more than `k=epochStability` blocks in the past
--- - It is pretty fast to re-sync a few hundred blocks
--- - Small rollbacks may occur more often than long one
---
--- So, as we insert checkpoints, we make sure to:
---
--- - Prune any checkpoint that more than `k` blocks in the past
--- - Keep only one checkpoint every 100 blocks
--- - But still keep ~10 most recent checkpoints to cope with small rollbacks
---
--- __Example 1__: Inserting `cp153`
---
---  ℹ: `cp142` is discarded and `cp153` inserted.
---
---  @
---  Currently in DB:
--- ┌───┬───┬───┬─  ──┬───┐
--- │cp000 │cp100 │cp142 │..    ..│cp152 │
--- └───┴───┴───┴─  ──┴───┘
---  Want in DB:
--- ┌───┬───┬───┬─  ──┬───┐
--- │cp000 │cp100 │cp143 │..    ..│cp153 │
--- └───┴───┴───┴─  ──┴───┘
---  @
---
---
---  __Example 2__: Inserting `cp111`
---
---  ℹ: `cp100` is kept and `cp111` inserted.
---
---  @
---  Currently in DB:
--- ┌───┬───┬───┬─  ──┬───┐
--- │cp000 │cp100 │cp101 │..    ..│cp110 │
--- └───┴───┴───┴─  ──┴───┘
---  Want in DB:
--- ┌───┬───┬───┬─  ──┬───┐
--- │cp000 │cp100 │cp101 │..    ..│cp111 │
--- └───┴───┴───┴─  ──┴───┘
---  @
---
--- NOTE: There might be cases where the chain following "fails" (because, for
--- example, the node has switch to a different chain, different by more than k),
--- and in such cases, we have no choice but rolling back from genesis.
--- Therefore, we need to keep the very first checkpoint in the database, no
--- matter what.
-sparseCheckpoints
-    :: SparseCheckpointsConfig
-        -- ^ Parameters for the function.
-    -> Quantity "block" Word32
-        -- ^ A given block height
-    -> [Word32]
-        -- ^ The list of checkpoint heights that should be kept in DB.
-sparseCheckpoints cfg blkH  =
-    let
-        SparseCheckpointsConfig{edgeSize,epochStability} = cfg
-        g = gapSize cfg
-        h = getQuantity blkH
-        e = fromIntegral edgeSize
-
-        minH =
-            let x = if h < epochStability + g then 0 else h - epochStability - g
-            in g * (x `div` g)
-
-        initial   = 0
-        longTerm  = [minH,minH+g..h]
-        shortTerm = if h < e
-            then [0..h]
-            else [h-e,h-e+1..h]
-    in
-        L.sort (L.nub $ initial : (longTerm ++ shortTerm))
-
--- | Captures the configuration for the `sparseCheckpoints` function.
---
--- NOTE: large values of 'edgeSize' aren't recommended as they would mean
--- storing many unnecessary checkpoints. In Ouroboros Praos, there's a
--- reasonable probability for small forks of a few blocks so it makes sense to
--- maintain a small part that is denser near the edge.
-data SparseCheckpointsConfig = SparseCheckpointsConfig
-    { edgeSize :: Word8
-    , epochStability :: Word32
-    } deriving Show
-
--- | A sensible default to use in production. See also 'SparseCheckpointsConfig'
-defaultSparseCheckpointsConfig :: Quantity "block" Word32 -> SparseCheckpointsConfig
-defaultSparseCheckpointsConfig (Quantity epochStability) =
-    SparseCheckpointsConfig
-        { edgeSize = 5
-        , epochStability
-        }
-
--- | A reasonable gap size used internally in 'sparseCheckpoints'.
---
--- 'Reasonable' means that it's not _too frequent_ and it's not too large. A
--- value that is too small in front of k would require generating much more
--- checkpoints than necessary.
---
--- A value that is larger than `k` may have dramatic consequences in case of
--- deep rollbacks.
---
--- As a middle ground, we current choose `k / 3`, which is justified by:
---
--- - The current speed of the network layer (several thousands blocks per seconds)
--- - The current value of k = 2160
---
--- So, `k / 3` = 720, which should remain around a second of time needed to catch
--- up in case of large rollbacks.
-gapSize :: SparseCheckpointsConfig -> Word32
-gapSize SparseCheckpointsConfig{epochStability} =
-    epochStability `div` 3
diff --git a/lib/core/src/Cardano/Wallet/DB/Checkpoints.hs b/lib/core/src/Cardano/Wallet/DB/Checkpoints.hs
index b35e944bc5c..78391ca73c0 100644
--- a/lib/core/src/Cardano/Wallet/DB/Checkpoints.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Checkpoints.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -19,7 +20,16 @@ module Cardano.Wallet.DB.Checkpoints
     , findNearestPoint
     
     -- * Delta types
-    , DeltaCheckpoints (..)
+    , DeltaCheckpoints
+    , DeltaCheckpoints1 (..)
+
+    -- * Checkpoint hygiene
+    , extendAndPrune
+
+    -- * Internal / Testing
+    , CheckpointPolicy (..)
+    , gapSize
+    , sparseArithmeticPolicy
     ) where
 
 import Prelude
@@ -32,12 +42,17 @@ import Data.Map.Strict
     ( Map )
 import Data.Maybe
     ( fromMaybe )
+import Data.Quantity
+    ( Quantity (..) )
+import Data.Word
+    ( Word32 )
 import Fmt
     ( Buildable (..), listF )
 import GHC.Generics
     ( Generic )
 
 import qualified Cardano.Wallet.Primitive.Types as W
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
@@ -111,7 +126,9 @@ findNearestPoint m key = fst <$> Map.lookupLE key (view #checkpoints m)
 {-------------------------------------------------------------------------------
     Delta type for Checkpoints
 -------------------------------------------------------------------------------}
-data DeltaCheckpoints a
+type DeltaCheckpoints a = [DeltaCheckpoints1 a]
+
+data DeltaCheckpoints1 a
     = PutCheckpoint W.Slot a
     | RollbackTo W.Slot
         -- Rolls back to the latest checkpoint at or before this slot.
@@ -120,15 +137,159 @@ data DeltaCheckpoints a
         -- the checkpoints that are already present.
         -- The genesis checkpoint will always be present.
 
-instance Delta (DeltaCheckpoints a) where
-    type Base (DeltaCheckpoints a) = Checkpoints a
+instance Delta (DeltaCheckpoints1 a) where
+    type Base (DeltaCheckpoints1 a) = Checkpoints a
     apply (PutCheckpoint pt a) = over #checkpoints $ Map.insert pt a
     apply (RollbackTo pt) = over #checkpoints $
         Map.filterWithKey (\k _ -> k <= pt)
     apply (RestrictTo pts) = over #checkpoints $ \m ->
         Map.restrictKeys m $ Set.fromList (W.Origin:pts)
 
-instance Buildable (DeltaCheckpoints a) where
+instance Buildable (DeltaCheckpoints1 a) where
     build (PutCheckpoint slot _) = "PutCheckpoint " <> build slot
     build (RollbackTo slot) = "RollbackTo " <> build slot
     build (RestrictTo slots) = "RestrictTo " <> listF slots
+
+{-------------------------------------------------------------------------------
+    Checkpoint hygiene
+-------------------------------------------------------------------------------}
+type BlockHeight = Quantity "block" Word32
+
+-- | Extend the known checkpoints and prune past ones.
+extendAndPrune
+    :: (a -> W.Slot)
+    -> (a -> BlockHeight)
+        -- ^ Convert checkpoint to block height.
+    -> BlockHeight
+        -- ^ Epoch stability window
+    -> BlockHeight
+        -- ^ Current tip of the blockchain
+    -> NE.NonEmpty a
+        -- ^ Checkpoints, ordered by increasing @Slot@.
+    -> Checkpoints a -> DeltaCheckpoints a
+extendAndPrune getSlot getHeight epochStability tip xs (Checkpoints cps) =
+    prunes ++ additions
+  where
+    additions = reverse -- largest slot needs to be applied last
+        [ PutCheckpoint (getSlot x) x | x <- new ]
+    prunes = [ RestrictTo $ map getSlot (old ++ new) ]
+
+    new    = filter willKeep (NE.toList xs)
+    old    = filter willKeep (Map.elems cps)
+
+    latest = NE.last xs
+    isLatest x = getHeight x == getHeight latest
+
+    policy = sparseArithmeticPolicy epochStability
+    willKeep x = isLatest x || keepWhereTip policy (getHeight x) tip
+        -- We must keep the most recent checkpoint or nothing will be extended
+
+{- | Note [CheckpointPolicy]
+
+To save memory and time, we do not store every checkpoint.
+Instead, a 'CheckpointPolicy' determines which checkpoints
+to store and which ones to discard.
+The 'extendAndPrune' functions consults such a policy and
+drops checkpoints as it deems necessary.
+
+A 'CheckpointPolicy' determines whether a checkpoint is worth storing
+only based on its block height. The boolean
+
+  keepWhereTip policy tip blockheight
+
+indicates whether the checkpoint should be stored ('True') or
+not ('False').
+It is important that this function does not oscillate:
+If @blockheight <= tip@, the function result may change from 'True'
+to 'False' as the @tip@ increases, but not the other way round.
+This is because we can only create checkpoints the first time we
+read the corresponding block.
+
+TODO:
+The 'Checkpoints' collection currently relies on 'Slot' instead
+of 'BlockHeight' to store checkpoints. We need to better integrate
+this with 'BlockHeight'.
+
+I (Heinrich) actually prefer 'Slot'. However, not every slot contains a block,
+and we would lose too many checkpoints if we based the decision of
+whether to keep a checkpoint or not based on the slot number alone.
+In contrast, block height is "dense".
+-}
+newtype CheckpointPolicy
+    = CheckpointPolicy { keepWhereTip :: BlockHeight -> BlockHeight -> Bool }
+
+{- | Note [sparseArithmeticPolicy]
+
+The 'sparseArithmeticPolicy' checkpoint policy contains essentially two
+sets of checkpoints: One fairly dense set near the tip of the chain
+in order to handle frequent potential rollbacks, and one sparse
+set that spans the entire epoch stability window. These two sets
+are arranged as arithmetic sequences.
+
+This policy is motivated by the following observations:
+
+  - We can't rollback for more than `k = epochStability` blocks in the past
+  - It is pretty fast to re-sync a few hundred blocks
+  - Small rollbacks near the tip may occur more often than long ones
+
+Hence, we should strive to
+
+- Prune any checkpoint that are more than `k` blocks in the past
+- Keep only one checkpoint every `largeGap` ~100 blocks
+- But still keep ~10 most recent checkpoints to cope with small rollbacks.
+
+Roughly, the 'sparseArithmeticPolicy' 
+
+0 ..... N*largeGap .... (N+1)*largeGap .. .. M*smallGap (M+1)*smallGap tip
+        |_______________________________________________________________|
+                 epochStability
+
+Note: In the event where chain following "fails completely" (because, for
+example, the node has switch to a different chain, different by more than `k`),
+we have no choice but rolling back from genesis.
+Therefore, we need to keep the very first checkpoint in the database, no
+matter what.
+
+-}
+sparseArithmeticPolicy :: BlockHeight -> CheckpointPolicy
+sparseArithmeticPolicy epochStability = CheckpointPolicy $ \height tip ->
+    keep (getQuantity height) (getQuantity tip)
+  where
+    smallGap = 1
+    largeGap = (gapSize epochStability `div` smallGap) * smallGap
+        -- integer multiple of smallGap for better retention
+
+    keep height tip
+        = notFuture && (
+            isOrigin
+            || isTip
+            || inWindow (5*smallGap) smallGap
+            || inWindow (getQuantity epochStability) largeGap
+        )
+      where
+        isTip = height == tip
+        isOrigin = height == 0
+        notFuture = height <= tip
+        inWindow width gap =
+            (tip <= height + width + gap-1) && (height `divisibleBy` gap)
+        divisibleBy a b = a `mod` b == 0
+
+{- | A reasonable gap size used internally in 'sparseArithmeticPolicy'.
+
+'Reasonable' means that it's not _too frequent_ and it's not too large. A
+value that is too small in front of k would require generating much more
+checkpoints than necessary.
+
+A value that is larger than `k` may have dramatic consequences in case of
+deep rollbacks.
+
+As a middle ground, we current choose `k / 3`, which is justified by:
+
+- The current bandwidth of the network layer (several thousands blocks per seconds)
+- The current value of k = 2160
+
+So, `k / 3` = 720, which corresponds to around a second of time needed to catch
+up in case of large rollbacks (if our local node has caught up already).
+-}
+gapSize :: BlockHeight -> Word32
+gapSize epochStability = max 1 (getQuantity epochStability  `div` 3)
diff --git a/lib/core/src/Cardano/Wallet/DB/MVar.hs b/lib/core/src/Cardano/Wallet/DB/MVar.hs
index 19136e13993..58ad8336f5e 100644
--- a/lib/core/src/Cardano/Wallet/DB/MVar.hs
+++ b/lib/core/src/Cardano/Wallet/DB/MVar.hs
@@ -121,7 +121,7 @@ newDBLayer timeInterpreter = do
             alterDB errNoSuchWallet db $
             mRollbackTo pk pt
 
-        , prune = \_ _ -> error "MVar.prune: not implemented"
+        , pruneTxs = \_ _ -> error "MVar.pruneTxs: not implemented"
 
         {-----------------------------------------------------------------------
                                    Wallet Metadata
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
index 56e8aa78021..1b01ca28456 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
@@ -83,11 +83,9 @@ import Cardano.Wallet.DB
     , ErrPutLocalTxSubmission (..)
     , ErrRemoveTx (..)
     , ErrWalletAlreadyExists (..)
-    , defaultSparseCheckpointsConfig
-    , sparseCheckpoints
     )
 import Cardano.Wallet.DB.Checkpoints
-    ( DeltaCheckpoints (..) )
+    ( DeltaCheckpoints1 (..) )
 import Cardano.Wallet.DB.Sqlite.CheckpointsOld
     ( PersistAddressBook (..), blockHeaderFromEntity, mkStoreWallets )
 import Cardano.Wallet.DB.Sqlite.Migration
@@ -118,7 +116,6 @@ import Cardano.Wallet.DB.WalletState
     , findNearestPoint
     , fromGenesis
     , fromWallet
-    , getBlockHeight
     , getLatest
     , getSlot
     )
@@ -224,7 +221,6 @@ import qualified Cardano.Wallet.Primitive.Types.Hash as W
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
 import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 import qualified Data.Text as T
 
 {-------------------------------------------------------------------------------
@@ -539,24 +535,6 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do
         readCheckpoint_ wid =
             fmap getLatest . Map.lookup wid <$> readDBVar walletsDB_
 
-    let pruneCheckpoints
-            :: W.WalletId
-            -> Quantity "block" Word32 -> W.BlockHeader
-            -> SqlPersistT IO ()
-        pruneCheckpoints wid epochStability tip = do
-            let heights = Set.fromList $ sparseCheckpoints
-                    (defaultSparseCheckpointsConfig epochStability)
-                    (tip ^. #blockHeight)
-            modifyDBMaybe walletsDB_ $ \ws ->
-                case Map.lookup wid ws of
-                    Nothing  -> (Nothing, ())
-                    Just wal ->
-                        let willKeep cp = getBlockHeight cp `Set.member` heights
-                            slots = Map.filter willKeep (wal ^. #checkpoints ^. #checkpoints)
-                            delta = Adjust wid
-                                [ UpdateCheckpoints $ RestrictTo $ Map.keys slots ]
-                        in  (Just delta, ())
-
     -- Delete the a wallet from the checkpoint DBVar
     let deleteCheckpoints :: W.WalletId -> SqlPersistT IO ()
         deleteCheckpoints wid = updateDBVar walletsDB_ $ Delete wid
@@ -600,7 +578,7 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do
                         let (prologue, wcp) = fromWallet cp
                             slot = getSlot wcp
                             delta = Just $ Adjust wid
-                                [ UpdateCheckpoints $ PutCheckpoint slot wcp
+                                [ UpdateCheckpoints [ PutCheckpoint slot wcp ]
                                 , ReplacePrologue prologue
                                 ]
                         in  (delta, Right ())
@@ -624,7 +602,7 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do
                             )
                         Just nearestPoint ->
                             ( Just $ Adjust wid
-                                [ UpdateCheckpoints $ RollbackTo nearestPoint ]
+                                [ UpdateCheckpoints [ RollbackTo nearestPoint ] ]
                             , pure $ Map.lookup nearestPoint $
                                 wal ^. #checkpoints ^. #checkpoints
                             )
@@ -655,12 +633,11 @@ newDBLayerWith _cacheBehavior _tr ti SqliteContext{runQuery} = do
                         $ W.chainPointFromBlockHeader
                         $ view #currentTip wcp
 
-        , prune = \wid epochStability -> ExceptT $ do
+        , pruneTxs = \wid epochStability -> ExceptT $ do
             readCheckpoint_ wid >>= \case
                 Nothing -> pure $ Left $ ErrNoSuchWallet wid
                 Just cp -> Right <$> do
                     let tip = cp ^. #currentTip
-                    pruneCheckpoints wid epochStability tip
                     pruneLocalTxSubmission wid epochStability tip
                     deleteLooseTransactions
 
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs
index 7b1bf26c9a9..1e29b2937c4 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs
@@ -50,7 +50,7 @@ import Cardano.DB.Sqlite
 import Cardano.Wallet.DB
     ( ErrBadFormat (..) )
 import Cardano.Wallet.DB.Checkpoints
-    ( DeltaCheckpoints (..), loadCheckpoints )
+    ( DeltaCheckpoints, DeltaCheckpoints1 (..), loadCheckpoints )
 import Cardano.Wallet.DB.Sqlite.AddressBook
     ( AddressBookIso (..)
     , Discoveries (..)
@@ -256,18 +256,21 @@ mkStoreCheckpoints wid =
     load = bimap toException loadCheckpoints <$> selectAllCheckpoints wid
 
     write cps = forM_ (Map.toList $ cps ^. #checkpoints) $ \(pt,cp) ->
-            update (PutCheckpoint pt cp)
+            update1 (PutCheckpoint pt cp)
 
-    update (PutCheckpoint _ state) =
+         -- first update in list is the last to be applied!
+    update = mapM_ update1 . reverse
+
+    update1 (PutCheckpoint _ state) =
         insertCheckpoint wid state
-    update (RollbackTo (W.At slot)) =
+    update1 (RollbackTo (W.At slot)) =
         deleteWhere [ CheckpointWalletId ==. wid, CheckpointSlot >. slot ]
-    update (RollbackTo W.Origin) =
+    update1 (RollbackTo W.Origin) =
         deleteWhere
             [ CheckpointWalletId ==. wid
             , CheckpointParentHash !=. BlockId hashOfNoParent
             ]
-    update (RestrictTo pts) = do
+    update1 (RestrictTo pts) = do
         let points = W.Origin : pts
         let pseudoSlot W.Origin    = W.SlotNo 0
             pseudoSlot (W.At slot) = slot
diff --git a/lib/core/src/Cardano/Wallet/DB/WalletState.hs b/lib/core/src/Cardano/Wallet/DB/WalletState.hs
index eb50ecd4a4e..fc70083403a 100644
--- a/lib/core/src/Cardano/Wallet/DB/WalletState.hs
+++ b/lib/core/src/Cardano/Wallet/DB/WalletState.hs
@@ -31,7 +31,11 @@ module Cardano.Wallet.DB.WalletState
     -- * Delta types
     , DeltaWalletState1 (..)
     , DeltaWalletState
+
+    -- * Multiple wallets
     , DeltaMap (..)
+    , adjustNoSuchWallet
+    , ErrNoSuchWallet (..)
     ) where
 
 import Prelude
@@ -41,7 +45,7 @@ import Cardano.Wallet.DB.Checkpoints
 import Cardano.Wallet.DB.Sqlite.AddressBook
     ( AddressBookIso (..), Discoveries, Prologue )
 import Cardano.Wallet.Primitive.Types
-    ( BlockHeader )
+    ( BlockHeader, WalletId )
 import Cardano.Wallet.Primitive.Types.UTxO
     ( UTxO )
 import Data.Delta
@@ -158,10 +162,9 @@ instance Show (DeltaWalletState1 s) where
     show = pretty
 
 {-------------------------------------------------------------------------------
-    A Delta type for Maps,
-    useful for handling multiple wallets.
+    Multiple wallets.
 -------------------------------------------------------------------------------}
--- | Delta type for 'Map'.
+-- | Delta type for 'Map'
 data DeltaMap key da
     = Insert key (Base da)
     | Delete key
@@ -172,3 +175,23 @@ instance (Ord key, Delta da) => Delta (DeltaMap key da) where
     apply (Insert key a) = Map.insert key a
     apply (Delete key) = Map.delete key
     apply (Adjust key da) = Map.adjust (apply da) key
+
+-- | Adjust a specific wallet if it exists or return 'ErrNoSuchWallet'.
+adjustNoSuchWallet
+    :: WalletId
+    -> (ErrNoSuchWallet -> e)
+    -> (w -> Either e (dw, b))
+    -> (Map WalletId w -> (Maybe (DeltaMap WalletId dw), Either e b))
+adjustNoSuchWallet wid err update wallets = case Map.lookup wid wallets of
+    Nothing -> (Nothing, Left $ err $ ErrNoSuchWallet wid)
+    Just wal -> case update wal of
+        Left e -> (Nothing, Left e)
+        Right (dw, b) -> (Just $ Adjust wid dw, Right b)
+
+{-------------------------------------------------------------------------------
+    Errors
+-------------------------------------------------------------------------------}
+-- | Can't perform given operation because there's no wallet
+newtype ErrNoSuchWallet
+    = ErrNoSuchWallet WalletId -- Wallet is gone or doesn't exist yet
+    deriving (Eq, Show)
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/CheckpointsSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/CheckpointsSpec.hs
new file mode 100644
index 00000000000..895b3172284
--- /dev/null
+++ b/lib/core/test/unit/Cardano/Wallet/DB/CheckpointsSpec.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE DataKinds #-}
+module Cardano.Wallet.DB.CheckpointsSpec
+    ( spec
+    ) where
+
+import Prelude
+
+import Cardano.Wallet.DB.Checkpoints
+    ( CheckpointPolicy (..), gapSize, sparseArithmeticPolicy )
+import Data.Function
+    ( (&) )
+import Data.Quantity
+    ( Quantity (..) )
+import Data.Set
+    ( Set )
+import Data.Word
+    ( Word32 )
+import Test.Hspec
+    ( Spec, describe, it )
+import Test.QuickCheck
+    ( Arbitrary (..)
+    , Gen
+    , Property
+    , choose
+    , counterexample
+    , elements
+    , forAll
+    , oneof
+    , property
+    , (===)
+    , (==>)
+    )
+
+import qualified Data.Set as Set
+
+
+spec :: Spec
+spec = do
+    describe "sparseArithmeticPolicy" $ do
+        it "predicate ⊇ constructive" $
+            property $ \(GenHeightContext epochStability tip) ->
+                let policy = sparseArithmeticPolicy epochStability
+                    predicate = \height -> keepWhereTip policy height tip
+                    constructive = sparseArithmeticSet epochStability tip
+                in  all predicate constructive
+                    & counterexample ("Heights: " <> show constructive)
+                    & counterexample ("Predicate: " <> show
+                        (map predicate $ Set.toList constructive))
+
+        it "predicate ⊆ constructive" $
+            property $ \ctx@(GenHeightContext epochStability tip) ->
+                let policy = sparseArithmeticPolicy epochStability
+                    predicate = \height -> keepWhereTip policy height tip
+                    constructive = sparseArithmeticSet epochStability tip
+                in  forAll (genBlockHeight ctx) $ \height ->
+                        predicate height === height `Set.member` constructive
+
+        it "monotonicity - old checkpoints are only discarded" $
+            property prop_monotonicity
+
+{-------------------------------------------------------------------------------
+    Checkpoint hygiene
+-------------------------------------------------------------------------------}
+type BlockHeight = Quantity "block" Word32
+
+-- | Constructive counterpart of the 'sparseArithmeticPolicy'
+sparseArithmeticSet
+    :: BlockHeight
+        -- ^ Epoch stability
+    -> BlockHeight
+        -- ^ Tip of the blockchain
+    -> Set BlockHeight
+sparseArithmeticSet (Quantity epochStability) (Quantity tip) =
+    Set.map Quantity $ Set.fromList [0,tip] <> smallWindow <> largeWindow
+  where
+    toGrid x g = (x `div` g) * g
+
+    smallWindow = Set.fromList [smallMin .. tip]
+    smallSize = 5
+    smallMin = if tip < smallSize then 0 else tip - smallSize
+    -- I would prefer  max 0 (..)  but this doesn't work as Word32 is unsigned
+
+    largeWindow = Set.fromList [largeMin, largeMin + largeGap .. tip]
+    largeGap = gapSize $ Quantity epochStability
+    largeMin = if tip < epochStability then 0
+        else toGrid (tip - epochStability) largeGap
+
+prop_monotonicity :: GenHeightContext -> Property
+prop_monotonicity (GenHeightContext epochStability tip2) =
+    forAll (Quantity <$> choose (0,getQuantity tip2)) $ \tip1 ->
+    forAll (Quantity <$> choose (0,getQuantity tip1)) $ \height ->
+        not (keep height tip1) ==> not (keep height tip2)
+  where
+    keep = keepWhereTip (sparseArithmeticPolicy epochStability)
+
+-- | Data type for generating sensible blockchein heights
+data GenHeightContext = GenHeightContext
+    { _epochStability :: BlockHeight
+    , _tip :: BlockHeight
+    } deriving Show
+
+instance Arbitrary GenHeightContext where
+    arbitrary = do
+        es <- max 1 <$> oneof [choose (0,1000000), elements [1,3,10,30,100,300,1000] ]
+        tip <- oneof [choose (0,1000000), choose (0,10), choose (es-200,es+200)]
+            -- ^ do not generate values near upper limit of Word32
+        pure $ GenHeightContext (Quantity es) (Quantity tip)
+
+genBlockHeight :: GenHeightContext -> Gen BlockHeight
+genBlockHeight (GenHeightContext (Quantity epochStability) (Quantity tip)) =
+    Quantity <$> oneof
+        [ arbitrary
+        , choose (0,10)
+        , choose (tip-2*epochStability,tip+2*epochStability)
+        ]
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs b/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs
index 3892d217cbc..c19c747836b 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs
@@ -26,11 +26,7 @@ import Cardano.Wallet.DB
     ( DBLayer (..)
     , ErrNoSuchWallet (..)
     , ErrWalletAlreadyExists (..)
-    , SparseCheckpointsConfig (..)
     , cleanDB
-    , defaultSparseCheckpointsConfig
-    , gapSize
-    , sparseCheckpoints
     )
 import Cardano.Wallet.DB.Arbitrary
     ( GenState
@@ -287,64 +283,6 @@ properties = do
         it "Correctly re-construct tx history on rollbacks"
             (checkCoverage . prop_rollbackTxHistory)
 
-    describe "sparseCheckpoints" $ do
-        it "k=2160, h=42" $ \_ -> do
-            let cfg = SparseCheckpointsConfig
-                    { edgeSize = 10
-                    , epochStability = 2160
-                    }
-            let h = Quantity 42
-
-            -- First unstable block: 0
-            sparseCheckpoints cfg h `shouldBe`
-                [ 0
-                , 32,33,34,35,36,37,38,39,40,41 -- Short-term checkpoints
-                , 42 -- Tip
-                ]
-
-        it "k=2160, h=2414" $ \_ -> do
-            let cfg = SparseCheckpointsConfig
-                    { edgeSize = 10
-                    , epochStability = 2160
-                    }
-            let h = Quantity 2714
-            -- First unstable block: 554
-            sparseCheckpoints cfg h `shouldBe`
-                [ 0
-                , 720, 1440, 2160               -- Long-term checkpoints
-
-                , 2704, 2705, 2706, 2707, 2708  -- Short-term checkpoints
-                , 2709, 2710, 2711, 2712, 2713  -- edgeSize = 10
-
-                , 2714  -- Tip
-                ]
-
-        it "k=2160, h=2414" $ \_ -> do
-            let cfg = SparseCheckpointsConfig
-                    { edgeSize = 0
-                    , epochStability = 2160
-                    }
-            let h = Quantity 2714
-            -- First unstable block: 554
-            sparseCheckpoints cfg h `shouldBe`
-                [ 0
-                , 720, 1440, 2160               -- Long-term checkpoints
-                , 2714  -- Tip
-                ]
-
-
-        it "The tip is always a checkpoint" $ \_ ->
-            property prop_sparseCheckpointTipAlwaysThere
-
-        it "There's at least (min h edgeSize) checkpoints" $ \_ ->
-            property prop_sparseCheckpointMinimum
-
-        it "∀ cfg. sparseCheckpoints (cfg { edgeSize = 0 }) ⊆ sparseCheckpoints cfg" $ \_ ->
-            property prop_sparseCheckpointEdgeSize0
-
-        it "Checkpoints are eventually stored in a sparse manner" $ \_ ->
-            property prop_checkpointsEventuallyEqual
-
 -- | Wrap the result of 'readTxHistory' in an arbitrary identity Applicative
 readTxHistoryF
     :: Functor m
@@ -897,178 +835,5 @@ prop_rollbackTxHistory db@DBLayer{..} (InitialCheckpoint cp0) (GenTxHistory txs0
     knownAfterRollback slot =
         rescheduled slot ++ filterTxs (isBefore slot) txs0
 
--- | No matter what, the current tip is always a checkpoint.
-prop_sparseCheckpointTipAlwaysThere
-    :: GenSparseCheckpointsArgs
-    -> Property
-prop_sparseCheckpointTipAlwaysThere (GenSparseCheckpointsArgs cfg h) = prop
-    & counterexample ("Checkpoints: " <> show cps)
-    & counterexample ("h=" <> show h)
-  where
-    cps = sparseCheckpoints cfg (Quantity h)
-
-    prop :: Property
-    prop = property $ fromIntegral h `elem` cps
-
--- | Check that sparseCheckpoints always return at least edgeSize checkpoints (or
--- exactly the current height if h < edgeSize).
-prop_sparseCheckpointMinimum
-    :: GenSparseCheckpointsArgs
-    -> Property
-prop_sparseCheckpointMinimum (GenSparseCheckpointsArgs cfg h) = prop
-    & counterexample ("Checkpoints: " <> show cps)
-    & counterexample ("h=" <> show h)
-  where
-    cps = sparseCheckpoints cfg (Quantity h)
-
-    prop :: Property
-    prop = property $ fromIntegral (length cps) >= min e h
-      where
-        e = fromIntegral $ edgeSize cfg
-
--- | This property checks that, the checkpoints kept for an edge size of 0 are
--- included in the list with a non-null edge size, all else equals.
-prop_sparseCheckpointEdgeSize0
-    :: GenSparseCheckpointsArgs
-    -> Property
-prop_sparseCheckpointEdgeSize0 (GenSparseCheckpointsArgs cfg h) = prop
-    & counterexample ("Checkpoints: " <> show cps)
-    & counterexample ("h=" <> show h)
-  where
-    cps  = sparseCheckpoints cfg (Quantity h)
-    cps' = sparseCheckpoints (cfg { edgeSize = 0 }) (Quantity h)
-
-    prop :: Property
-    prop = property (cps' `L.isSubsequenceOf` cps)
-
--- | This property shows that, for all possible cuts (i.e. non-null batches) of
--- a sequence of blocks, the following steps:
---
---  For all batch B in sequence:
---
---  - Keep all checkpoints in B yielded by sparseCheckpoint with and
---    edge size of 0.
---
---  - Keep the last checkpoint of the batch regardless
---
---  - Prune all checkpoints not yielded by sparseCheckpoint with a non-null edge
---    size
---
--- are equivalent to calling `sparseCheckpoints` on the flattened batch
--- sequence.
---
--- Note that the batch creation mimics the way blocks are served by the network
--- layer to wallets: first by batches of arbitrary size, and then one by one.
---
--- The property shows that regardless of how batches are served, after
--- 'edgeSize' one-by-one step, the end result is the same as if the entire
--- stream of blocks had been processed in one go.
-prop_checkpointsEventuallyEqual
-    :: GenSparseCheckpointsArgs
-    -> Property
-prop_checkpointsEventuallyEqual args@(GenSparseCheckpointsArgs cfg h) =
-    h > epochStability cfg ==> forAll (genBatches args) $ \(Batches batches) ->
-        let
-            tip =
-                Quantity $ last $ mconcat batches
-            emptyDB =
-                SparseCheckpointsDB []
-            dbs =
-                L.scanl (\db batch -> prune $ step batch db) emptyDB batches
-        in
-            ( prop_eventuallyReachesExpectedTip tip dbs
-              .&&.
-              prop_canNeverRollbackMoreThanKPlusGap tip dbs
-            )
-  where
-    prop_eventuallyReachesExpectedTip
-        :: Quantity "block" Word32
-        -> [SparseCheckpointsDB]
-        -> Property
-    prop_eventuallyReachesExpectedTip tip dbs =
-        last dbs === SparseCheckpointsDB (sparseCheckpoints cfg tip)
-
-    prop_canNeverRollbackMoreThanKPlusGap
-        :: Quantity "block" Word32
-        -> [SparseCheckpointsDB]
-        -> Property
-    prop_canNeverRollbackMoreThanKPlusGap (Quantity tip) dbs =
-        conjoin (forEachStep <$> L.tail dbs)
-      where
-        forEachStep (SparseCheckpointsDB db) =
-            let
-                -- db' contains all the _stable checkpoints_ in the database,
-                -- i.e. those that are in the interval [0; network tip - k)
-                --
-                -- So, if we are asked to rollback for a full k, we'll end up
-                -- rolling back to the closest checkpoint from that interval.
-                db' = filter (< (tip - epochStability cfg)) db
-                farthestRollback = last db - last db'
-            in
-                property
-                    (farthestRollback <= epochStability cfg + gapSize cfg)
-                & counterexample
-                    ("database: " <> show db)
-                & counterexample
-                    ("stable checkpoints: " <> show db')
-
-    step :: [Word32] -> SparseCheckpointsDB -> SparseCheckpointsDB
-    step cps (SparseCheckpointsDB db) =
-        let
-            toKeep =
-                sparseCheckpoints (cfg { edgeSize = 0 }) (Quantity h)
-            cps' =
-                last cps : (toKeep `L.intersect` cps)
-        in
-            SparseCheckpointsDB $ L.sort $ cps' ++ db
-
-    prune :: SparseCheckpointsDB -> SparseCheckpointsDB
-    prune (SparseCheckpointsDB db) =
-        let
-            tip =
-                Quantity $ last db
-            db' =
-                sparseCheckpoints cfg tip `L.intersect` db
-        in
-            SparseCheckpointsDB db'
-
-newtype Batches = Batches [[Word32]] deriving Show
-
-newtype SparseCheckpointsDB = SparseCheckpointsDB [Word32] deriving (Show, Eq)
-
 gp :: GenesisParameters
 gp = dummyGenesisParameters
-
-data GenSparseCheckpointsArgs
-    = GenSparseCheckpointsArgs SparseCheckpointsConfig Word32
-    deriving Show
-
-instance Arbitrary GenSparseCheckpointsArgs where
-    arbitrary = do
-        k <- (\x -> 10 + (x `mod` 1000)) <$> arbitrary
-        h <- (`mod` 10000) <$> arbitrary
-        cfg <- SparseCheckpointsConfig <$> arbitrary <*> pure k
-        pure $ GenSparseCheckpointsArgs cfg h
-
--- This functions generate `h` "block header" (modeled as a Word32), grouped in
--- batches of arbitrary (albeit meaningful) sizes.
---
--- Batches always end with `edgeSize` "block header" in singleton batches, to
--- simulate a fast and slow mode.
-genBatches
-    :: GenSparseCheckpointsArgs
-    -> Gen Batches
-genBatches (GenSparseCheckpointsArgs cfg h) = do
-    bs <- go [0..h] []
-    let e = fromIntegral $ edgeSize cfg
-    let oneByOne = pure <$> [h+1..h+e]
-    pure (Batches (bs ++ oneByOne))
-  where
-    go :: [Word32] -> [[Word32]] -> Gen [[Word32]]
-    go []     batches = pure $ reverse batches
-    go source batches = do
-        -- NOTE:
-        -- Generate batches that can be larger than the chosen gap size, to make
-        -- sure we generate realistic cases.
-        n <- fromIntegral <$> choose (1, 3 * gapSize cfg)
-        go (drop n source) (take n source : batches)
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs
index 83b168e1740..8f981c23c46 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/Sqlite/StoresSpec.hs
@@ -15,7 +15,7 @@ import Cardano.DB.Sqlite
 import Cardano.Wallet.DB.Arbitrary
     ( GenState, InitialCheckpoint (..) )
 import Cardano.Wallet.DB.Checkpoints
-    ( DeltaCheckpoints (..) )
+    ( DeltaCheckpoints1 (..) )
 import Cardano.Wallet.DB.Sqlite.AddressBook
     ( AddressBookIso (..), Prologue, getPrologue )
 import Cardano.Wallet.DB.Sqlite.Stores
@@ -183,7 +183,7 @@ genDeltaWalletState wallet = frequency . map (second updateCheckpoints) $
     , (1, pure $ RestrictTo [])
     ]
   where
-    updateCheckpoints gen = (\x -> [UpdateCheckpoints x]) <$> gen
+    updateCheckpoints gen = (\x -> [UpdateCheckpoints [x]]) <$> gen
 
     slotLatest = case getSlot . snd . fromWallet $ getLatest wallet of
         Origin -> 0
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
index 9a7b99cc751..21d03dfcf68 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
@@ -55,6 +55,8 @@ import Cardano.Wallet.DB
     ( DBFactory (..), DBLayer (..), ErrNoSuchWallet (..), cleanDB )
 import Cardano.Wallet.DB.Arbitrary
     ( GenState, KeyValPairs (..) )
+import Cardano.Wallet.DB.Checkpoints
+    ( extendAndPrune )
 import Cardano.Wallet.DB.Properties
     ( properties )
 import Cardano.Wallet.DB.Sqlite
@@ -66,6 +68,8 @@ import Cardano.Wallet.DB.Sqlite
     , withDBLayer
     , withDBLayerInMemory
     )
+import Cardano.Wallet.DB.Sqlite.AddressBook
+    ( AddressBookIso, getPrologue )
 import Cardano.Wallet.DB.Sqlite.Migration
     ( InvalidDatabaseSchemaVersion (..)
     , SchemaVersion (..)
@@ -73,6 +77,16 @@ import Cardano.Wallet.DB.Sqlite.Migration
     )
 import Cardano.Wallet.DB.StateMachine
     ( TestConstraints, prop_parallel, prop_sequential, validateGenerators )
+import Cardano.Wallet.DB.WalletState
+    ( DeltaMap (..)
+    , DeltaWalletState1 (..)
+    , WalletState (..)
+    , adjustNoSuchWallet
+    , fromWallet
+    , getBlockHeight
+    , getLatest
+    , getSlot
+    )
 import Cardano.Wallet.DummyTarget.Primitive.Types
     ( block0, dummyGenesisParameters, dummyTimeInterpreter )
 import Cardano.Wallet.Gen
@@ -170,13 +184,15 @@ import Control.Monad
 import Control.Monad.IO.Class
     ( liftIO )
 import Control.Monad.Trans.Except
-    ( ExceptT, mapExceptT )
+    ( ExceptT (..), mapExceptT )
 import Crypto.Hash
     ( hash )
 import Data.ByteString
     ( ByteString )
 import Data.Coerce
     ( coerce )
+import Data.DBVar
+    ( modifyDBMaybe )
 import Data.Generics.Internal.VL.Lens
     ( over, view, (^.) )
 import Data.Generics.Labels
@@ -274,6 +290,7 @@ import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.List as L
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -554,11 +571,28 @@ fileModeSpec =  do
                             mockTxs
                             mempty
                     let (FilteredBlock{transactions=txs}, (_,cpB)) = applyBlock fakeBlock cpA
+                    let epochStability = Quantity 2160
+                        putAndPruneCheckpoint wid cp =
+                          ExceptT $ modifyDBMaybe walletsDB $
+                            adjustNoSuchWallet wid id $ \wal ->
+                                let wcp = snd $ fromWallet cp
+                                    delta =
+                                        [ ReplacePrologue $ getPrologue $ getState cp
+                                        , UpdateCheckpoints $
+                                            extendAndPrune
+                                                getSlot
+                                                (Quantity . getBlockHeight)
+                                                epochStability
+                                                (currentTip cp ^. #blockHeight)
+                                                (wcp NE.:| [])
+                                                (checkpoints wal)
+                                        ]
+                                in Right (delta, ())
                     print $ utxo cpB
                     atomically $ do
-                        unsafeRunExceptT $ putCheckpoint testWid cpB
+                        unsafeRunExceptT $ putAndPruneCheckpoint testWid cpB
                         unsafeRunExceptT $ putTxHistory testWid txs
-                        unsafeRunExceptT $ prune testWid (Quantity 2160)
+                        unsafeRunExceptT $ pruneTxs testWid epochStability
 
             it "Should remove collateral inputs from the UTxO set if \
                 \validation fails" $
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs
index f6b00e779ae..69df8f39311 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs
@@ -741,9 +741,9 @@ generatorWithWid wids =
         $ ReadPrivateKey <$> genId
     , declareGenerator "RollbackTo" 1
         $ RollbackTo <$> genId <*> arbitrary
-    -- TODO: Implement mPrune
-    -- , declareGenerator "Prune" 1
-    --     $ Prune <$> genId <*> arbitrary
+    -- TODO: Implement mPruneTxs
+    -- , declareGenerator "PruneTxs" 1
+    --     $ PruneTxs <$> genId <*> arbitrary
     , declareGenerator "ReadGenesisParameters" 1
         $ ReadGenesisParameters <$> genId
     ]
diff --git a/nix/materialized/stack-nix/cardano-wallet-core.nix b/nix/materialized/stack-nix/cardano-wallet-core.nix
index c662508473b..dfdd8a5de88 100644
--- a/nix/materialized/stack-nix/cardano-wallet-core.nix
+++ b/nix/materialized/stack-nix/cardano-wallet-core.nix
@@ -390,6 +390,7 @@
             "Cardano/Wallet/CoinSelection/Internal/BalanceSpec"
             "Cardano/Wallet/CoinSelection/Internal/CollateralSpec"
             "Cardano/Wallet/DB/Arbitrary"
+            "Cardano/Wallet/DB/CheckpointsSpec"
             "Cardano/Wallet/DB/MVarSpec"
             "Cardano/Wallet/DB/Properties"
             "Cardano/Wallet/DB/SqliteSpec"