Reject legacy snapshots

Author: jasagredo

ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs

@@ -450,8 +450,10 @@ loadSnapshot ::
   Session m ->
   DiskSnapshot ->
   ExceptT (SnapshotFailure blk) m (LedgerSeq' m blk, RealPoint blk)
-loadSnapshot tracer rr ccfg fs session ds =
+loadSnapshot tracer rr ccfg fs@(SomeHasFS hfs) session ds =
   do
+    fileEx <- lift $ doesFileExist hfs (snapshotToDirPath ds)
+    Monad.when fileEx $ throwE $ InitFailureRead ReadSnapshotIsLegacy
     snapshotMeta <-
       withExceptT (InitFailureRead . ReadMetadataError (snapshotToMetadataPath ds)) $
         loadSnapshotMetadata fs ds

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs

@@ -185,6 +185,8 @@ data ReadSnapshotErr
     ReadSnapshotDataCorruption
   | -- | An error occurred while reading the snapshot metadata file
     ReadMetadataError FsPath MetadataErr
+  | -- | We were given a legacy snapshot
+    ReadSnapshotIsLegacy
   deriving (Eq, Show)
 
 data TablesCodecVersion = TablesCodecVersion1

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs

@@ -163,6 +163,7 @@ import Ouroboros.Consensus.Util.Args (Complete)
 import Ouroboros.Consensus.Util.Enclose
 import Ouroboros.Consensus.Util.IOLike
 import System.FS.API
+import qualified System.FS.API as FS
 
 snapshotManager ::
   ( IOLike m
@@ -293,7 +294,9 @@ loadSnapshot ::
     (SnapshotFailure blk)
     m
     ((DbChangelog' blk, ResourceKey m, LedgerBackingStore m (ExtLedgerState blk)), RealPoint blk)
-loadSnapshot tracer bArgs@(SomeBackendArgs bss) ccfg fs@(SnapshotsFS fs') reg s = do
+loadSnapshot tracer bArgs@(SomeBackendArgs bss) ccfg fs@(SnapshotsFS fs'@(SomeHasFS hfs)) reg s = do
+  fileEx <- Trans.lift $ FS.doesFileExist hfs (snapshotToDirPath s)
+  Monad.when fileEx $ throwError $ InitFailureRead ReadSnapshotIsLegacy
   (extLedgerSt, checksumAsRead) <-
     withExceptT (InitFailureRead . ReadSnapshotFailed) $
       readExtLedgerState fs' (decodeDiskExtLedgerState ccfg) decode (snapshotToStatePath s)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs

@@ -323,7 +323,10 @@ loadSnapshot ::
   SomeHasFS m ->
   DiskSnapshot ->
   ExceptT (SnapshotFailure blk) m (LedgerSeq' m blk, RealPoint blk)
-loadSnapshot tracer _rr ccfg fs ds = do
+loadSnapshot tracer _rr ccfg fs@(SomeHasFS hfs) ds = do
+  fileEx <- lift $ doesFileExist hfs (snapshotToDirPath ds)
+  Monad.when fileEx $ throwE $ InitFailureRead ReadSnapshotIsLegacy
+
   snapshotMeta <-
     withExceptT (InitFailureRead . ReadMetadataError (snapshotToMetadataPath ds)) $
       loadSnapshotMetadata fs ds