diff --git a/ouroboros-consensus-cardano/app/snapshot-converter.hs b/ouroboros-consensus-cardano/app/snapshot-converter.hs
index 8acd4b3b4c..6802074a06 100644
--- a/ouroboros-consensus-cardano/app/snapshot-converter.hs
+++ b/ouroboros-consensus-cardano/app/snapshot-converter.hs
@@ -365,7 +365,7 @@ main = withStdTerminalHandles $ do
         InEnv
           st
           fp
-          (\a b -> SomeBackend <$> mkInMemYieldArgs (fp F.</> "tables" F.</> "tvar") a b)
+          (\a b -> SomeBackend <$> mkInMemYieldArgs (fp F.</> "tables") a b)
           ("InMemory@[" <> fp <> "]")
           c
           mtd
@@ -423,7 +423,7 @@ main = withStdTerminalHandles $ do
       pure $
         OutEnv
           fp
-          (\a b -> SomeBackend <$> mkInMemSinkArgs (fp F.</> "tables" F.</> "tvar") a b)
+          (\a b -> SomeBackend <$> mkInMemSinkArgs (fp F.</> "tables") a b)
           (Just "tables")
           (Nothing)
           ("InMemory@[" <> fp <> "]")
diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs
index 7dffcff9f0..40756a4c10 100644
--- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs
+++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs
@@ -214,6 +214,48 @@ instance
       toPlainEncoding (eraProtVerLow @era) $
         encodeMap encodeMemPack (eliminateCardanoTxOut (const encodeMemPack)) tbs
 
+  encodeTxInWithHint (HardForkLedgerState (HardForkState idx)) txin =
+    let
+      -- These could be made into a CAF to avoid recomputing it, but
+      -- it is only used in serialization so it is not critical.
+      np =
+        (Fn $ const $ K $ Codec.CBOR.Encoding.encodeMapLen 0)
+          :* (Fn $ const $ K $ encOne (Proxy @ShelleyEra))
+          :* (Fn $ const $ K $ encOne (Proxy @AllegraEra))
+          :* (Fn $ const $ K $ encOne (Proxy @MaryEra))
+          :* (Fn $ const $ K $ encOne (Proxy @AlonzoEra))
+          :* (Fn $ const $ K $ encOne (Proxy @BabbageEra))
+          :* (Fn $ const $ K $ encOne (Proxy @ConwayEra))
+          :* (Fn $ const $ K $ encOne (Proxy @DijkstraEra))
+          :* Nil
+     in
+      hcollapse $ hap np $ Telescope.tip idx
+   where
+    encOne :: forall era. Era era => Proxy era -> Encoding
+    encOne _ =
+      toPlainEncoding (eraProtVerLow @era) $ encodeMemPack txin
+
+  encodeTxOutWithHint (HardForkLedgerState (HardForkState idx)) txout =
+    let
+      -- These could be made into a CAF to avoid recomputing it, but
+      -- it is only used in serialization so it is not critical.
+      np =
+        (Fn $ const $ K $ Codec.CBOR.Encoding.encodeMapLen 0)
+          :* (Fn $ const $ K $ encOne (Proxy @ShelleyEra))
+          :* (Fn $ const $ K $ encOne (Proxy @AllegraEra))
+          :* (Fn $ const $ K $ encOne (Proxy @MaryEra))
+          :* (Fn $ const $ K $ encOne (Proxy @AlonzoEra))
+          :* (Fn $ const $ K $ encOne (Proxy @BabbageEra))
+          :* (Fn $ const $ K $ encOne (Proxy @ConwayEra))
+          :* (Fn $ const $ K $ encOne (Proxy @DijkstraEra))
+          :* Nil
+     in
+      hcollapse $ hap np $ Telescope.tip idx
+   where
+    encOne :: forall era. Era era => Proxy era -> Encoding
+    encOne _ =
+      toPlainEncoding (eraProtVerLow @era) $ eliminateCardanoTxOut (const encodeMemPack) txout
+
   decodeTablesWithHint ::
     forall s.
     LedgerState (HardForkBlock (CardanoEras c)) EmptyMK ->
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs
index 07478efcd7..e58d23f786 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs
@@ -367,6 +367,8 @@ instance
   where
   encodeTablesWithHint _ (LedgerTables (ValuesMK tbs)) =
     toPlainEncoding (Core.eraProtVerLow @era) $ encodeMap encodeMemPack encodeMemPack tbs
+  encodeTxInWithHint _ = toPlainEncoding (Core.eraProtVerLow @era) . encodeMemPack
+  encodeTxOutWithHint _ = toPlainEncoding (Core.eraProtVerLow @era) . encodeMemPack
   decodeTablesWithHint st =
     let certInterns =
           internsFromMap $
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
index f03c7320ea..0662e46873 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
@@ -503,6 +503,8 @@ instance
     encOne :: Encoding
     encOne = toPlainEncoding (SL.eraProtVerLow @era) $ encodeMap encodeMemPack encodeMemPack tbs
 
+  encodeTxInWithHint _ = toPlainEncoding (SL.eraProtVerLow @era) . encodeMemPack
+  encodeTxOutWithHint _ = toPlainEncoding (SL.eraProtVerLow @era) . encodeMemPack
   decodeTablesWithHint ::
     forall s.
     LedgerState (HardForkBlock '[ShelleyBlock proto era]) EmptyMK ->
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs
index 7394a16518..496ea2def0 100644
--- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs
+++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs
@@ -557,6 +557,34 @@ instance
           )
           tbs
 
+  encodeTxInWithHint (HardForkLedgerState (HardForkState idx)) txin =
+    let
+      np =
+        (Fn $ const $ K $ encOne (Proxy @era1))
+          :* (Fn $ const $ K $ encOne (Proxy @era2))
+          :* Nil
+     in
+      hcollapse $ hap np $ Telescope.tip idx
+   where
+    encOne :: forall era. SL.Era era => Proxy era -> Encoding
+    encOne _ =
+      toPlainEncoding (SL.eraProtVerLow @era) $ encodeMemPack (getShelleyHFCTxIn txin)
+
+  encodeTxOutWithHint (HardForkLedgerState (HardForkState idx)) txout0 =
+    let
+      np =
+        (Fn $ const $ K $ encOne (Proxy @era1))
+          :* (Fn $ const $ K $ encOne (Proxy @era2))
+          :* Nil
+     in
+      hcollapse $ hap np $ Telescope.tip idx
+   where
+    encOne :: forall era. SL.Era era => Proxy era -> Encoding
+    encOne _ =
+      toPlainEncoding (SL.eraProtVerLow @era) $ case txout0 of
+        Z txout -> encodeMemPack $ unwrapTxOut txout
+        S (Z txout) -> encodeMemPack $ unwrapTxOut txout
+
   decodeTablesWithHint ::
     forall s.
     LedgerState (HardForkBlock (ShelleyBasedHardForkEras proto1 era1 proto2 era2)) EmptyMK ->
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs
index 5a2fe7776b..8db33dc4f2 100644
--- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs
+++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs
@@ -75,7 +75,7 @@ openLedgerDB ::
 openLedgerDB args = do
   (ldb, _, od) <- case LedgerDB.lgrBackendArgs args of
     LedgerDB.LedgerDbBackendArgsV1 bss ->
-      let snapManager = LedgerDB.V1.snapshotManager args
+      let snapManager = LedgerDB.V1.snapshotManager args bss
           initDb =
             LedgerDB.V1.mkInitDb
               args
@@ -99,6 +99,11 @@ openLedgerDB args = do
               (configCodec . getExtLedgerCfg . LedgerDB.ledgerDbCfg $ LedgerDB.lgrConfig args)
               (LedgerDBSnapshotEvent >$< LedgerDB.lgrTracer args)
               (LedgerDB.lgrHasFS args)
+              ( flip
+                  LedgerDB.V2.CanonicalSnapshotsFS
+                  (LedgerDB.lgrHasFS args)
+                  <$> LedgerDB.lgrCanonicalSnapshotsFS args
+              )
       let initDb =
             LedgerDB.V2.mkInitDb
               args
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
index efd7018046..b937208a60 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
@@ -359,6 +359,7 @@ data
   , srnChainDbValidateOverride :: Bool
   -- ^ If @True@, validate the ChainDB on init no matter what
   , srnDatabasePath :: NodeDatabasePaths
+  , srnCanonicalSnapshotsPath :: Maybe FilePath
   -- ^ Location of the DBs
   , srnDiffusionArguments :: Cardano.Diffusion.CardanoNodeArguments m
   , srnDiffusionConfiguration :: Cardano.Diffusion.CardanoConfiguration m
@@ -1062,6 +1063,10 @@ stdLowLevelRunNodeArgsIO
       ChainDB.updateSnapshotPolicyArgs srnSnapshotPolicyArgs
         . ChainDB.updateQueryBatchSize srnQueryBatchSize
         . ChainDB.updateTracer srnTraceChainDB
+        . maybe
+          id
+          (\fp -> ChainDB.enableCanonicalSnapshots (SomeHasFS $ ioHasFS $ MountPoint fp))
+          srnCanonicalSnapshotsPath
         . ( if not srnChainDbValidateOverride
               then id
               else ChainDB.ensureValidateAll
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs
index fdd205031b..2c02241d5f 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs
@@ -479,6 +479,8 @@ instance SerialiseHFC '[BlockA, BlockB]
 instance SerializeTablesWithHint (LedgerState (HardForkBlock '[BlockA, BlockB])) where
   encodeTablesWithHint = defaultEncodeTablesWithHint
   decodeTablesWithHint = defaultDecodeTablesWithHint
+  encodeTxInWithHint = defaultEncodeMemPackWithHint
+  encodeTxOutWithHint = defaultEncodeMemPackWithHint
 
 instance
   IndexedMemPack
diff --git a/ouroboros-consensus/src/ouroboros-consensus-lmdb/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/LMDB.hs b/ouroboros-consensus/src/ouroboros-consensus-lmdb/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/LMDB.hs
index b8fd9915ee..229906008f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus-lmdb/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/LMDB.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus-lmdb/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/LMDB.hs
@@ -850,6 +850,7 @@ mkLMDBArgs ::
   ( MonadIOPrim m
   , HasLedgerTables (LedgerState blk)
   , IOLike m
+  , IsLedger (LedgerState blk)
   ) =>
   V1.FlushFrequency -> FilePath -> LMDBLimits -> a -> (LedgerDbBackendArgs m blk, a)
 mkLMDBArgs flushing lmdbPath limits =
@@ -998,3 +999,6 @@ mkLMDBSinkArgs fp limits hint reg = do
       )
       bsClose
   pure $ SinkLMDB 1000 (bsWrite bs) (\h -> bsCopy bs h (FS.mkFsPath [snapName, "tables"]))
+
+instance (Ord (TxIn l), GetTip l, Monad m) => StreamingBackendV1 m LMDB l where
+  yieldV1 _ vh = yield (Proxy @LMDB) (YieldLMDB 1000 vh)
diff --git a/ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs b/ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs
index 526fc8f2f8..8a590801a6 100644
--- a/ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs
@@ -75,17 +75,19 @@ import Ouroboros.Consensus.Storage.LedgerDB.Args
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V2
 import Ouroboros.Consensus.Storage.LedgerDB.V2.Backend
+import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
 import Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq
 import Ouroboros.Consensus.Util (chunks)
 import Ouroboros.Consensus.Util.CRC
 import Ouroboros.Consensus.Util.Enclose
-import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Consensus.Util.IOLike hiding (yield)
 import Ouroboros.Consensus.Util.IndexedMemPack
 import qualified Streaming as S
 import qualified Streaming.Prelude as S
 import System.FS.API
 import qualified System.FS.BlockIO.API as BIO
 import System.FS.BlockIO.IO
+import System.FS.CRC
 import System.FilePath (splitDirectories, splitFileName)
 import System.Random
 import Prelude hiding (read)
@@ -199,12 +201,13 @@ snapshotManager ::
   CodecConfig blk ->
   Tracer m (TraceSnapshotEvent blk) ->
   SomeHasFS m ->
+  Maybe (CanonicalSnapshotsFS m) ->
   SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
-snapshotManager session ccfg tracer fs =
+snapshotManager session ccfg tracer fs mCanonical =
   SnapshotManager
     { listSnapshots = defaultListSnapshots fs
     , deleteSnapshot = implDeleteSnapshot session fs tracer
-    , takeSnapshot = implTakeSnapshot ccfg tracer fs
+    , takeSnapshot = implTakeSnapshot ccfg tracer fs mCanonical
     }
 
 newLSMLedgerTablesHandle ::
@@ -330,22 +333,35 @@ implTakeSnapshot ::
   CodecConfig blk ->
   Tracer m (TraceSnapshotEvent blk) ->
   SomeHasFS m ->
+  Maybe (CanonicalSnapshotsFS m) ->
   Maybe String ->
   StateRef m (ExtLedgerState blk) ->
   m (Maybe (DiskSnapshot, RealPoint blk))
-implTakeSnapshot ccfg tracer hasFS suffix st = case pointToWithOriginRealPoint (castPoint (getTip $ state st)) of
-  Origin -> return Nothing
-  NotOrigin t -> do
-    let number = unSlotNo (realPointSlot t)
-        snapshot = DiskSnapshot number suffix
-    diskSnapshots <- defaultListSnapshots hasFS
-    if List.any (== DiskSnapshot number suffix) diskSnapshots
-      then
-        return Nothing
-      else do
-        encloseTimedWith (TookSnapshot snapshot t >$< tracer) $
-          writeSnapshot hasFS (encodeDiskExtLedgerState ccfg) snapshot st
-        return $ Just (snapshot, t)
+implTakeSnapshot ccfg tracer shfs mCanonicalFS suffix st =
+  case pointToWithOriginRealPoint (castPoint (getTip $ state st)) of
+    Origin -> return Nothing
+    NotOrigin t -> do
+      let number = unSlotNo (realPointSlot t)
+          snapshot = DiskSnapshot number suffix
+      diskSnapshots <- defaultListSnapshots shfs
+      if List.any (== DiskSnapshot number suffix) diskSnapshots
+        then
+          return Nothing
+        else do
+          stateCRC <-
+            encloseTimedWith (TookSnapshot snapshot t >$< tracer) $
+              writeSnapshot shfs (encodeDiskExtLedgerState ccfg) snapshot st
+          takeCanonicalSnapshot
+            (($ t) >$< tracer)
+            snapshot
+            (duplicate (tables st))
+            close
+            (\hdl -> yield (Proxy @LSM) (YieldLSM 1000 hdl) (state st))
+            (state st)
+            stateCRC
+            mCanonicalFS
+
+          return $ Just (snapshot, t)
 
 writeSnapshot ::
   MonadThrow m =>
@@ -353,7 +369,7 @@ writeSnapshot ::
   (ExtLedgerState blk EmptyMK -> Encoding) ->
   DiskSnapshot ->
   StateRef m (ExtLedgerState blk) ->
-  m ()
+  m CRC
 writeSnapshot fs@(SomeHasFS hasFs) encLedger ds st = do
   createDirectoryIfMissing hasFs True $ snapshotToDirPath ds
   crc1 <- writeExtLedgerState fs encLedger (snapshotToStatePath ds) $ state st
@@ -364,6 +380,7 @@ writeSnapshot fs@(SomeHasFS hasFs) encLedger ds st = do
       , snapshotChecksum = maybe crc1 (crcOfConcat crc1) crc2
       , snapshotTablesCodecVersion = TablesCodecVersion1
       }
+  pure crc1
 
 -- | Delete snapshot from disk and also from the LSM tree database.
 implDeleteSnapshot ::
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
index 9ae75c141a..39db33de68 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
@@ -1122,6 +1122,8 @@ instance
   where
   encodeTablesWithHint = defaultEncodeTablesWithHint
   decodeTablesWithHint = defaultDecodeTablesWithHint
+  encodeTxInWithHint = defaultEncodeMemPackWithHint
+  encodeTxOutWithHint = defaultEncodeMemPackWithHint
 
 instance
   ( Bridge m a
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs
index 4a47abcceb..256473c7b6 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs
@@ -383,4 +383,6 @@ instance
 
 instance SerializeTablesWithHint (LedgerState blk) => SerializeTablesWithHint (ExtLedgerState blk) where
   decodeTablesWithHint st = castLedgerTables <$> decodeTablesWithHint (ledgerState st)
+  encodeTxInWithHint st = encodeTxInWithHint (ledgerState st)
+  encodeTxOutWithHint st = encodeTxOutWithHint (ledgerState st)
   encodeTablesWithHint st tbs = encodeTablesWithHint (ledgerState st) (castLedgerTables tbs)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Tables.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Tables.hs
index e3274c8365..497c8e1151 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Tables.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Tables.hs
@@ -176,6 +176,7 @@ module Ouroboros.Consensus.Ledger.Tables
   , SerializeTablesWithHint (..)
   , defaultDecodeTablesWithHint
   , defaultEncodeTablesWithHint
+  , defaultEncodeMemPackWithHint
   , valuesMKDecoder
   , valuesMKEncoder
 
@@ -322,6 +323,14 @@ class SerializeTablesWithHint l where
     SerializeTablesHint (LedgerTables l ValuesMK) ->
     LedgerTables l ValuesMK ->
     CBOR.Encoding
+  encodeTxInWithHint ::
+    SerializeTablesHint (LedgerTables l ValuesMK) ->
+    TxIn l ->
+    CBOR.Encoding
+  encodeTxOutWithHint ::
+    SerializeTablesHint (LedgerTables l ValuesMK) ->
+    TxOut l ->
+    CBOR.Encoding
   decodeTablesWithHint ::
     SerializeTablesHint (LedgerTables l ValuesMK) ->
     CBOR.Decoder s (LedgerTables l ValuesMK)
@@ -339,19 +348,22 @@ defaultEncodeTablesWithHint ::
   SerializeTablesHint (LedgerTables l ValuesMK) ->
   LedgerTables l ValuesMK ->
   CBOR.Encoding
-defaultEncodeTablesWithHint _ (LedgerTables (ValuesMK tbs)) =
+defaultEncodeTablesWithHint h (LedgerTables (ValuesMK tbs)) =
   mconcat
     [ CBOR.encodeMapLen (fromIntegral $ Map.size tbs)
     , Map.foldMapWithKey
         ( \k v ->
             mconcat
-              [ CBOR.encodeBytes (packByteString k)
-              , CBOR.encodeBytes (packByteString v)
+              [ defaultEncodeMemPackWithHint h k
+              , defaultEncodeMemPackWithHint h v
               ]
         )
         tbs
     ]
 
+defaultEncodeMemPackWithHint :: MemPack a => p -> a -> CBOR.Encoding
+defaultEncodeMemPackWithHint _ k = CBOR.encodeBytes (packByteString k)
+
 defaultDecodeTablesWithHint ::
   (Ord (TxIn l), MemPack (TxIn l), MemPack (TxOut l)) =>
   SerializeTablesHint (LedgerTables l ValuesMK) ->
@@ -414,8 +426,10 @@ instance IndexedMemPack (TrivialLedgerTables l EmptyMK) Void where
   indexedPackM _ = packM
   indexedUnpackM _ = unpackM
 
-instance SerializeTablesWithHint (TrivialLedgerTables l) where
+instance (MemPack (TxIn l), MemPack (TxOut l)) => SerializeTablesWithHint (TrivialLedgerTables l) where
   decodeTablesWithHint _ = do
     _ <- CBOR.decodeMapLen
     pure (LedgerTables $ ValuesMK Map.empty)
+  encodeTxInWithHint = defaultEncodeMemPackWithHint
+  encodeTxOutWithHint = defaultEncodeMemPackWithHint
   encodeTablesWithHint _ _ = CBOR.encodeMapLen 0
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..ef4af59e7d 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
@@ -13,6 +13,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Args
   , completeChainDbArgs
   , defaultArgs
   , enableLedgerEvents
+  , enableCanonicalSnapshots
   , ensureValidateAll
   , updateQueryBatchSize
   , updateSnapshotPolicyArgs
@@ -263,6 +264,10 @@ enableLedgerEvents args =
             }
     }
 
+enableCanonicalSnapshots :: SomeHasFS m -> ChainDbArgs f m blk -> ChainDbArgs f m blk
+enableCanonicalSnapshots shfs args =
+  args{cdbLgrDbArgs = (cdbLgrDbArgs args){LedgerDB.lgrCanonicalSnapshotsFS = Just shfs}}
+
 {-------------------------------------------------------------------------------
   Relative mount points
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs
index cb01fe8a8d..bf2b88b8b8 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs
@@ -70,7 +70,10 @@ openDB
   getVolatileSuffix =
     case lgrBackendArgs args of
       LedgerDbBackendArgsV1 bss ->
-        let snapManager = V1.snapshotManager args
+        let snapManager =
+              V1.snapshotManager
+                args
+                bss
             initDb =
               V1.mkInitDb
                 args
@@ -94,6 +97,7 @@ openDB
                 (configCodec . getExtLedgerCfg . ledgerDbCfg $ lgrConfig args)
                 (LedgerDBSnapshotEvent >$< lgrTracer args)
                 (lgrHasFS args)
+                (flip CanonicalSnapshotsFS (lgrHasFS args) <$> lgrCanonicalSnapshotsFS args)
         let initDb = V2.mkInitDb args getBlock snapManager getVolatileSuffix res
         doOpenDB args initDb snapManager stream replayGoal
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs
index 773ac0b919..6979a40b16 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs
@@ -60,6 +60,8 @@ data LedgerDbArgs f m blk = LedgerDbArgs
   , lgrTracer :: Tracer m (TraceEvent blk)
   , lgrBackendArgs :: LedgerDbBackendArgs m blk
   , lgrRegistry :: HKD f (ResourceRegistry m)
+  , lgrCanonicalSnapshotsFS :: Maybe (SomeHasFS m)
+  -- ^ If Just, enable canonical snapshots.
   , lgrQueryBatchSize :: QueryBatchSize
   , lgrStartSnapshot :: Maybe DiskSnapshot
   -- ^ If provided, the ledgerdb will start using said snapshot and fallback
@@ -85,6 +87,7 @@ defaultArgs backendArgs =
       lgrBackendArgs = LedgerDbBackendArgsV2 backendArgs
     , lgrRegistry = NoDefault
     , lgrStartSnapshot = Nothing
+    , lgrCanonicalSnapshotsFS = Nothing
     }
 
 data LedgerDbBackendArgs m blk
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs
index 60525b58d5..439ba8fb7f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs
@@ -607,6 +607,8 @@ data TraceSnapshotEvent blk
     InvalidSnapshot DiskSnapshot (SnapshotFailure blk)
   | -- | A snapshot was written to disk.
     TookSnapshot DiskSnapshot (RealPoint blk) EnclosingTimed
+  | -- | A canonical snapshot was written to disk.
+    TookCanonicalSnapshot DiskSnapshot (RealPoint blk) EnclosingTimed
   | -- | An old or invalid on-disk snapshot was deleted
     DeletedSnapshot DiskSnapshot
   deriving (Generic, Eq, Show)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs
index 360c23e96c..db77160f8e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs
@@ -22,6 +22,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore
     -- * Initialization
   , newBackingStore
   , restoreBackingStore
+  , StreamingBackendV1 (..)
 
     -- * Tracing
   , SomeBackendTrace (..)
@@ -33,6 +34,7 @@ import Cardano.Slotting.Slot
 import Control.Tracer
 import Data.Proxy
 import Ouroboros.Consensus.Ledger.Basics
+import Ouroboros.Consensus.Storage.LedgerDB.API
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API
 import System.FS.API
@@ -64,7 +66,8 @@ newBackingStore trcr (SomeBackendArgs bArgs) fs st tables =
   newBackingStoreInitialiser trcr bArgs fs (InitFromValues Origin st tables)
 
 data SomeBackendArgs m l where
-  SomeBackendArgs :: Backend m backend l => Args m backend -> SomeBackendArgs m l
+  SomeBackendArgs ::
+    (StreamingBackendV1 m backend l, Backend m backend l) => Args m backend -> SomeBackendArgs m l
 
 data SomeBackendTrace where
   SomeBackendTrace :: Show (Trace m backend) => Trace m backend -> SomeBackendTrace
@@ -88,3 +91,7 @@ class Backend m backend l where
     Args m backend ->
     SnapshotsFS m ->
     BackingStoreInitialiser m l
+
+-- | A refinement of 'StreamingBackend' that produces a 'Yield' from a 'BackingStoreValueHandle'.
+class StreamingBackend m backend l => StreamingBackendV1 m backend l where
+  yieldV1 :: Proxy backend -> LedgerBackingStoreValueHandle m l -> Yield m l
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs
index 7608d572cf..e9759aad67 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs
@@ -35,6 +35,7 @@ import Data.Functor.Contravariant
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.String (fromString)
+import Data.Void
 import GHC.Generics
 import Ouroboros.Consensus.Ledger.Basics
 import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff
@@ -370,3 +371,12 @@ instance
   newBackingStoreInitialiser trcr InMemArgs =
     newInMemoryBackingStore
       (SomeBackendTrace . InMemoryBackingStoreTrace >$< trcr)
+
+instance StreamingBackend m Mem l where
+  data SinkArgs m Mem l = SinkArgs Void
+  data YieldArgs m Mem l = YieldArgs Void
+  yield _ (YieldArgs x) = absurd x
+  sink _ (SinkArgs x) = absurd x
+
+instance StreamingBackendV1 m Mem l where
+  yieldV1 _ _ = error "We do not support streaming canonical snapshots from a V1 InMemory backend"
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs
index 501d4b54bb..b0b9a75ea2 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs
@@ -155,14 +155,18 @@ import Ouroboros.Consensus.Storage.LedgerDB.API
 import Ouroboros.Consensus.Storage.LedgerDB.Args
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.TraceEvent
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as V1
 import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore as V1
 import Ouroboros.Consensus.Storage.LedgerDB.V1.DbChangelog
 import Ouroboros.Consensus.Storage.LedgerDB.V1.Lock
+import Ouroboros.Consensus.Storage.LedgerDB.V2.Backend (CanonicalSnapshotsFS (..))
+import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory hiding (Args, snapshotManager)
 import Ouroboros.Consensus.Util.Args (Complete)
 import Ouroboros.Consensus.Util.Enclose
-import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Consensus.Util.IOLike hiding (yield)
 import System.FS.API
+import System.FS.CRC
 
 snapshotManager ::
   ( IOLike m
@@ -170,27 +174,32 @@ snapshotManager ::
   , LedgerSupportsProtocol blk
   ) =>
   Complete LedgerDbArgs m blk ->
+  V1.LedgerDbBackendArgs m (ExtLedgerState blk) ->
   SnapshotManager m (ReadLocked m) blk (StrictTVar m (DbChangelog' blk), BackingStore' m blk)
-snapshotManager args =
+snapshotManager args p =
   snapshotManager'
+    p
     (configCodec . getExtLedgerCfg . ledgerDbCfg $ lgrConfig args)
     (LedgerDBSnapshotEvent >$< lgrTracer args)
     (SnapshotsFS (lgrHasFS args))
+    (flip CanonicalSnapshotsFS (lgrHasFS args) <$> lgrCanonicalSnapshotsFS args)
 
 snapshotManager' ::
   ( IOLike m
   , LedgerDbSerialiseConstraints blk
   , LedgerSupportsProtocol blk
   ) =>
+  V1.LedgerDbBackendArgs m (ExtLedgerState blk) ->
   CodecConfig blk ->
   Tracer m (TraceSnapshotEvent blk) ->
   SnapshotsFS m ->
+  Maybe (CanonicalSnapshotsFS m) ->
   SnapshotManager m (ReadLocked m) blk (StrictTVar m (DbChangelog' blk), BackingStore' m blk)
-snapshotManager' ccfg tracer sfs@(SnapshotsFS fs) =
+snapshotManager' p ccfg tracer sfs@(SnapshotsFS fs) mNNFS =
   SnapshotManager
     { listSnapshots = defaultListSnapshots fs
     , deleteSnapshot = defaultDeleteSnapshot fs tracer
-    , takeSnapshot = \suff (ldbVar, bs) -> implTakeSnapshot ldbVar ccfg tracer sfs bs suff
+    , takeSnapshot = \suff (ldbVar, bs) -> implTakeSnapshot p ldbVar ccfg tracer sfs mNNFS bs suff
     }
 
 -- | Try to take a snapshot of the /oldest ledger state/ in the ledger DB
@@ -213,19 +222,22 @@ snapshotManager' ccfg tracer sfs@(SnapshotsFS fs) =
 --
 -- TODO: Should we delete the file if an error occurs during writing?
 implTakeSnapshot ::
+  forall m blk.
   ( IOLike m
   , LedgerDbSerialiseConstraints blk
   , LedgerSupportsProtocol blk
   ) =>
+  V1.LedgerDbBackendArgs m (ExtLedgerState blk) ->
   StrictTVar m (DbChangelog' blk) ->
   CodecConfig blk ->
   Tracer m (TraceSnapshotEvent blk) ->
   SnapshotsFS m ->
+  Maybe (CanonicalSnapshotsFS m) ->
   BackingStore' m blk ->
   -- | Override for snapshot numbering
   Maybe String ->
   ReadLocked m (Maybe (DiskSnapshot, RealPoint blk))
-implTakeSnapshot ldbvar ccfg tracer (SnapshotsFS hasFS) backingStore suffix = readLocked $ do
+implTakeSnapshot (V1.V1Args _ (V1.SomeBackendArgs (_ :: V1.Args m backend))) ldbvar ccfg tracer (SnapshotsFS hasFS) mCanonicalFS backingStore suffix = readLocked $ do
   state <- changelogLastFlushedState <$> readTVarIO ldbvar
   case pointToWithOriginRealPoint (castPoint (getTip state)) of
     Origin ->
@@ -238,8 +250,18 @@ implTakeSnapshot ldbvar ccfg tracer (SnapshotsFS hasFS) backingStore suffix = re
         then
           return Nothing
         else do
-          encloseTimedWith (TookSnapshot snapshot t >$< tracer) $
-            writeSnapshot hasFS backingStore (encodeDiskExtLedgerState ccfg) snapshot state
+          stateCRC <-
+            encloseTimedWith (TookSnapshot snapshot t >$< tracer) $
+              writeSnapshot hasFS backingStore (encodeDiskExtLedgerState ccfg) snapshot state
+          takeCanonicalSnapshot
+            (($ t) >$< tracer)
+            snapshot
+            (bsValueHandle backingStore)
+            bsvhClose
+            (\vh -> yieldV1 (Proxy @backend) vh state)
+            state
+            stateCRC
+            mCanonicalFS
           return $ Just (snapshot, t)
 
 -- | Write snapshot to disk
@@ -250,7 +272,7 @@ writeSnapshot ::
   (ExtLedgerState blk EmptyMK -> Encoding) ->
   DiskSnapshot ->
   ExtLedgerState blk EmptyMK ->
-  m ()
+  m CRC
 writeSnapshot fs@(SomeHasFS hasFS) backingStore encLedger snapshot cs = do
   createDirectory hasFS (snapshotToDirPath snapshot)
   crc <- writeExtLedgerState fs encLedger (snapshotToStatePath snapshot) cs
@@ -266,6 +288,7 @@ writeSnapshot fs@(SomeHasFS hasFS) backingStore encLedger snapshot cs = do
     backingStore
     cs
     (snapshotToTablesPath snapshot)
+  pure crc
 
 -- | The path within the LedgerDB's filesystem to the file that contains the
 -- snapshot's serialized ledger state
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs
index 7ff562ee48..11f37113a9 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs
@@ -9,6 +9,7 @@
 module Ouroboros.Consensus.Storage.LedgerDB.V2.Backend
   ( -- * Backend API
     Backend (..)
+  , CanonicalSnapshotsFS (..)
 
     -- * Existentials
   , SomeBackendTrace (..)
@@ -82,8 +83,17 @@ class NoThunks (Resources m backend) => Backend m backend blk where
     CodecConfig blk ->
     Tracer m (TraceSnapshotEvent blk) ->
     SomeHasFS m ->
+    Maybe (CanonicalSnapshotsFS m) ->
     SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
 
+-- | Arguments required if canonical snapshots are enabled.
+data CanonicalSnapshotsFS m = CanonicalSnapshotsFS
+  { nnCanonicalHasFS :: SomeHasFS m
+  -- ^ The FS on which canonical snapshots are stored
+  , nnNativeHasFS :: SomeHasFS m
+  -- ^ The FS on which native snapshots are stored
+  }
+
 {-------------------------------------------------------------------------------
   Existentials
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs
index 5dfd573200..c8d0a136a1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs
@@ -10,17 +10,22 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
-  ( Backend (..)
+  ( -- * API
+    Backend (..)
   , Args (InMemArgs)
   , Mem
   , YieldArgs (YieldInMemory)
   , SinkArgs (SinkInMemory)
   , mkInMemoryArgs
+
+    -- * Canonical snapshots
+  , takeCanonicalSnapshot
   ) where
 
 import Cardano.Binary as CBOR
@@ -47,7 +52,7 @@ import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 import Data.Maybe
 import Data.MemPack
-import Data.String (fromString)
+import qualified Data.Primitive.ByteArray as PBA
 import Data.Void
 import GHC.Generics
 import NoThunks.Class
@@ -62,6 +67,7 @@ import Ouroboros.Consensus.Storage.LedgerDB.Args
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V2.Backend
 import Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq
+import Ouroboros.Consensus.Util (whenJust)
 import Ouroboros.Consensus.Util.CBOR (readIncremental)
 import Ouroboros.Consensus.Util.CRC
 import Ouroboros.Consensus.Util.Enclose
@@ -148,11 +154,10 @@ newInMemoryLedgerTablesHandle tracer someFS@(SomeHasFS hasFS) l = do
                     )
               )
       , takeHandleSnapshot = \hint snapshotName -> do
-          createDirectoryIfMissing hasFS True $ mkFsPath [snapshotName, "tables"]
           h <- readTVarIO tv
           guardClosed h $
             \values ->
-              withFile hasFS (mkFsPath [snapshotName, "tables", "tvar"]) (WriteMode MustBeNew) $ \hf ->
+              withFile hasFS (mkFsPath [snapshotName, "tables"]) (WriteMode MustBeNew) $ \hf ->
                 fmap (Just . snd) $
                   hPutAllCRC hasFS hf $
                     CBOR.toLazyByteString $
@@ -174,12 +179,13 @@ snapshotManager ::
   CodecConfig blk ->
   Tracer m (TraceSnapshotEvent blk) ->
   SomeHasFS m ->
+  Maybe (CanonicalSnapshotsFS m) ->
   SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
-snapshotManager ccfg tracer fs =
+snapshotManager ccfg tracer fs mCanonical =
   SnapshotManager
     { listSnapshots = defaultListSnapshots fs
     , deleteSnapshot = defaultDeleteSnapshot fs tracer
-    , takeSnapshot = implTakeSnapshot ccfg tracer fs
+    , takeSnapshot = implTakeSnapshot ccfg tracer fs mCanonical
     }
 
 -- | The path within the LedgerDB's filesystem to the file that contains the
@@ -213,10 +219,11 @@ implTakeSnapshot ::
   CodecConfig blk ->
   Tracer m (TraceSnapshotEvent blk) ->
   SomeHasFS m ->
+  Maybe (CanonicalSnapshotsFS m) ->
   Maybe String ->
   StateRef m (ExtLedgerState blk) ->
   m (Maybe (DiskSnapshot, RealPoint blk))
-implTakeSnapshot ccfg tracer hasFS suffix st = do
+implTakeSnapshot ccfg tracer hasFS mCanonical suffix st = do
   case pointToWithOriginRealPoint (castPoint (getTip $ state st)) of
     Origin -> return Nothing
     NotOrigin t -> do
@@ -229,6 +236,7 @@ implTakeSnapshot ccfg tracer hasFS suffix st = do
         else do
           encloseTimedWith (TookSnapshot snapshot t >$< tracer) $
             writeSnapshot hasFS (encodeDiskExtLedgerState ccfg) snapshot st
+          takeCanonicalSnapshotInMemory (($ t) >$< tracer) mCanonical snapshot
           return $ Just (snapshot, t)
 
 -- | Read snapshot from disk.
@@ -268,10 +276,7 @@ loadSnapshot tracer _rr ccfg fs ds = do
               fs
               Identity
               (valuesMKDecoder extLedgerSt)
-              ( fsPathFromList $
-                  fsPathToList (snapshotToDirPath ds)
-                    <> [fromString "tables", fromString "tvar"]
-              )
+              (snapshotToDirPath ds </> mkFsPath ["tables"])
       let computedCRC = crcOfConcat checksumAsRead crcTables
       Monad.when (computedCRC /= snapshotChecksum snapshotMeta) $
         throwE $
@@ -448,3 +453,120 @@ sinkInMemoryS writeChunkSize encK encV (SomeHasFS fs) fp _ s =
         let !crc1 = updateCRC bs crc
         (,crc1) <$> S.effects s'
       Just (item, s'') -> go tb crc (n - 1) (item : m) s''
+
+{-------------------------------------------------------------------------------
+ Canonical snapshots
+-------------------------------------------------------------------------------}
+
+-- | A 'Yield' which already was provided the ledger state.
+type Yield' m l =
+  ( ( Stream
+        (Of (TxIn l, TxOut l))
+        (ExceptT DeserialiseFailure m)
+        (Stream (Of ByteString) m (Maybe CRC)) ->
+      ExceptT DeserialiseFailure m (Stream (Of ByteString) m (Maybe CRC, Maybe CRC))
+    )
+  ) ->
+  ExceptT DeserialiseFailure m (Maybe CRC, Maybe CRC)
+
+-- | Take a canonical snapshot, by providing a yielder that will stream the
+-- ledger table values.
+--
+-- The @state@ file is copied into the canonical snapshot.
+takeCanonicalSnapshot ::
+  (IOLike m, SerializeTablesWithHint l) =>
+  Tracer m (RealPoint blk -> TraceSnapshotEvent blk) ->
+  DiskSnapshot ->
+  -- | Allocate any resources needed (such as 'LedgerTablesHandle's)
+  m a ->
+  -- | Free the resources
+  (a -> m ()) ->
+  -- | Create a yield with the allocated resources
+  (a -> Yield' m l) ->
+  -- | The state for encoding the tables
+  l EmptyMK ->
+  -- | The CRC resulting from encoding the state
+  CRC ->
+  Maybe (CanonicalSnapshotsFS m) ->
+  m ()
+takeCanonicalSnapshot
+  tracer
+  snapshot
+  allocator
+  freer
+  doYield
+  st
+  stateCRC
+  mCanonicalFS =
+    whenJust mCanonicalFS $
+      \( CanonicalSnapshotsFS
+           nonNativeShfs@(SomeHasFS nonNativeFs)
+           (SomeHasFS nativeFs)
+         ) ->
+          encloseTimedWith (flip (TookCanonicalSnapshot snapshot) >$< tracer) $ do
+            let snapFsPath = snapshotToDirPath snapshot
+            createDirectoryIfMissing nonNativeFs True snapFsPath
+            copyFile
+              (nativeFs, snapFsPath </> mkFsPath ["state"])
+              (nonNativeFs, snapFsPath </> mkFsPath ["state"])
+            eCRCs <- withRegistry $ \rr -> do
+              (rk, hdl) <- allocate rr (\_ -> allocator) freer
+              eCRCs <-
+                runExceptT
+                  $ doYield
+                    hdl
+                  $ sink
+                    (Proxy @Mem)
+                    (SinkInMemory 1000 (encodeTxInWithHint st) (encodeTxOutWithHint st) nonNativeShfs "tables")
+                    st
+              Monad.void $ release rk
+              pure eCRCs
+            case eCRCs of
+              Right (_, Just tablesCRC) ->
+                writeSnapshotMetadata nonNativeShfs snapshot $
+                  SnapshotMetadata
+                    { snapshotBackend = UTxOHDMemSnapshot
+                    , snapshotChecksum = crcOfConcat stateCRC tablesCRC
+                    , snapshotTablesCodecVersion = TablesCodecVersion1
+                    }
+              _ -> pure ()
+
+-- | A HasFS utility that copies files from one HasFS to another.
+copyFile :: IOLike m => (HasFS m h1, FsPath) -> (HasFS m h2, FsPath) -> m ()
+copyFile (hfs1, fp1) (hfs2, fp2) = do
+  ba <- PBA.newByteArray defaultChunkSize
+  withFile hfs1 fp1 ReadMode $ \hdlIn ->
+    withFile hfs2 fp2 (WriteMode MustBeNew) $ \hdlOut ->
+      go ba hdlIn hdlOut
+ where
+  go ba hin hout = do
+    bytesRead <- hGetBufSome hfs1 hin ba 0 (fromIntegral defaultChunkSize)
+    if bytesRead == 0
+      then pure ()
+      else do
+        Monad.void $ hPutBufSome hfs2 hout ba 0 bytesRead
+        go ba hin hout
+
+-- | Take a canonical snapshot from an InMemory snapshot
+--
+-- This is implemented as a copy of the whole snapshot to the new directory.
+takeCanonicalSnapshotInMemory ::
+  IOLike m =>
+  Tracer m (RealPoint blk -> TraceSnapshotEvent blk) ->
+  Maybe (CanonicalSnapshotsFS m) ->
+  DiskSnapshot ->
+  m ()
+takeCanonicalSnapshotInMemory tracer mCanonical snapshot =
+  whenJust
+    mCanonical
+    ( \(CanonicalSnapshotsFS (SomeHasFS nonNativeHasFS) (SomeHasFS nativeHasFS)) ->
+        encloseTimedWith (flip (TookCanonicalSnapshot snapshot) >$< tracer) $ do
+          let snapFsPath = snapshotToDirPath snapshot
+          createDirectoryIfMissing nonNativeHasFS True snapFsPath
+          let copy = \x ->
+                copyFile
+                  (nativeHasFS, snapFsPath </> x)
+                  (nonNativeHasFS, snapFsPath </> x)
+          mapM_ (copy . mkFsPath . (: []))
+            =<< listDirectory nativeHasFS snapFsPath
+    )
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..dcff781b53 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
@@ -133,6 +133,7 @@ fromMinimalChainDbArgs MinimalChainDbArgs{..} =
           , lgrBackendArgs = LedgerDbBackendArgsV2 $ V2.SomeBackendArgs InMemArgs
           , lgrQueryBatchSize = DefaultQueryBatchSize
           , lgrStartSnapshot = Nothing
+          , lgrCanonicalSnapshotsFS = Nothing
           }
     , cdbsArgs =
         ChainDbSpecificArgs
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/LedgerStateOnlyTables.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/LedgerStateOnlyTables.hs
index 4afe9f20e2..cb9c652068 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/LedgerStateOnlyTables.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/LedgerStateOnlyTables.hs
@@ -78,6 +78,8 @@ instance
 instance (Ord k, MemPack k, MemPack v) => SerializeTablesWithHint (LedgerState (OTBlock k v)) where
   encodeTablesWithHint = defaultEncodeTablesWithHint
   decodeTablesWithHint = defaultDecodeTablesWithHint
+  encodeTxInWithHint = defaultEncodeMemPackWithHint
+  encodeTxOutWithHint = defaultEncodeMemPackWithHint
 
 {-------------------------------------------------------------------------------
   Stowable
diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs
index b5abe5b2c7..da2e208c73 100644
--- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs
+++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs
@@ -541,6 +541,8 @@ instance IndexedMemPack (LedgerState (SimpleBlock c ext) EmptyMK) Mock.TxOut whe
 instance SerializeTablesWithHint (LedgerState (SimpleBlock c ext)) where
   encodeTablesWithHint = defaultEncodeTablesWithHint
   decodeTablesWithHint = defaultDecodeTablesWithHint
+  encodeTxInWithHint = defaultEncodeMemPackWithHint
+  encodeTxOutWithHint = defaultEncodeMemPackWithHint
 
 instance HasLedgerTables (LedgerState (SimpleBlock c ext)) where
   projectLedgerTables = simpleLedgerTables
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..e4d140b7dc 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
@@ -237,6 +237,7 @@ initLedgerDB s c = do
           , lgrQueryBatchSize = DefaultQueryBatchSize
           , lgrRegistry = reg
           , lgrStartSnapshot = Nothing
+          , lgrCanonicalSnapshotsFS = Nothing
           }
   ldb <-
     fst
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine.hs
index 1c45dae1be..9e25b4c721 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine.hs
@@ -548,11 +548,12 @@ openLedgerDB flavArgs env cfg fs rr = do
           tracer
           flavArgs
           rr
+          Nothing
           DefaultQueryBatchSize
           Nothing
   (ldb, _, od) <- case lgrBackendArgs args of
     LedgerDbBackendArgsV1 bss ->
-      let snapManager = V1.snapshotManager args
+      let snapManager = V1.snapshotManager args bss
           initDb =
             V1.mkInitDb
               args
@@ -576,6 +577,7 @@ openLedgerDB flavArgs env cfg fs rr = do
               (configCodec . getExtLedgerCfg . ledgerDbCfg $ lgrConfig args)
               (LedgerDBSnapshotEvent >$< lgrTracer args)
               (lgrHasFS args)
+              (flip CanonicalSnapshotsFS (lgrHasFS args) <$> lgrCanonicalSnapshotsFS args)
       let initDb = V2.mkInitDb args getBlock snapManager (praosGetVolatileSuffix $ ledgerDbCfgSecParam cfg) res
       openDBInternal args initDb snapManager stream replayGoal
   withRegistry $ \reg -> do
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine/TestBlock.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine/TestBlock.hs
index 1ea2ac2f12..2b0eedc4db 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine/TestBlock.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine/TestBlock.hs
@@ -226,6 +226,8 @@ instance IndexedMemPack (LedgerState TestBlock EmptyMK) TValue where
 instance SerializeTablesWithHint (LedgerState TestBlock) where
   encodeTablesWithHint = defaultEncodeTablesWithHint
   decodeTablesWithHint = defaultDecodeTablesWithHint
+  encodeTxInWithHint = defaultEncodeMemPackWithHint
+  encodeTxOutWithHint = defaultEncodeMemPackWithHint
 
 instance HasLedgerTables (LedgerState TestBlock) where
   projectLedgerTables st = utxtoktables $ payloadDependentState st