Roundtrip test for writing/reading snapshot metadata to/from files

Author: jorisdral

lsm-tree.cabal

@@ -379,6 +379,7 @@ test-suite lsm-tree-test
     Test.Database.LSMTree.Internal.Serialise
     Test.Database.LSMTree.Internal.Serialise.Class
     Test.Database.LSMTree.Internal.Snapshot.Codec
+    Test.Database.LSMTree.Internal.Snapshot.FS
     Test.Database.LSMTree.Internal.Vector
     Test.Database.LSMTree.Internal.Vector.Growing
     Test.Database.LSMTree.Model.Table

test/Main.hs

@@ -30,6 +30,7 @@ import qualified Test.Database.LSMTree.Internal.RunReaders
 import qualified Test.Database.LSMTree.Internal.Serialise
 import qualified Test.Database.LSMTree.Internal.Serialise.Class
 import qualified Test.Database.LSMTree.Internal.Snapshot.Codec
+import qualified Test.Database.LSMTree.Internal.Snapshot.FS
 import qualified Test.Database.LSMTree.Internal.Vector
 import qualified Test.Database.LSMTree.Internal.Vector.Growing
 import qualified Test.Database.LSMTree.Model.Table
@@ -68,6 +69,7 @@ main = do
     , Test.Database.LSMTree.Internal.Serialise.tests
     , Test.Database.LSMTree.Internal.Serialise.Class.tests
     , Test.Database.LSMTree.Internal.Snapshot.Codec.tests
+    , Test.Database.LSMTree.Internal.Snapshot.FS.tests
     , Test.Database.LSMTree.Internal.Vector.tests
     , Test.Database.LSMTree.Internal.Vector.Growing.tests
     , Test.Database.LSMTree.Model.Table.tests

test/Test/Database/LSMTree/Internal/Snapshot/FS.hs

@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- | Tests for snapshots and their interaction with the file system
+--
+-- TODO: add fault injection tests using fs-sim
+module Test.Database.LSMTree.Internal.Snapshot.FS (tests) where
+
+import           Database.LSMTree.Internal.Snapshot
+import           Database.LSMTree.Internal.Snapshot.Codec
+import qualified System.FS.API as FS
+import           Test.Database.LSMTree.Internal.Snapshot.Codec ()
+import           Test.Tasty
+import           Test.Tasty.QuickCheck
+import           Test.Util.FS
+
+tests :: TestTree
+tests = testGroup "Test.Database.LSMTree.Internal.Snapshot.FS" [
+      testProperty "prop_fsRoundtripSnapshotMetaData"
+        prop_fsRoundtripSnapshotMetaData
+    ]
+
+-- | @readFileSnapshotMetaData . writeFileSnapshotMetaData = id@
+prop_fsRoundtripSnapshotMetaData :: SnapshotMetaData -> Property
+prop_fsRoundtripSnapshotMetaData metaData =
+    ioProperty $
+    withTempIOHasFS "temp" $ \hfs -> do
+      writeFileSnapshotMetaData hfs contentPath checksumPath metaData
+      eMetaData' <- readFileSnapshotMetaData hfs contentPath checksumPath
+      pure $ case eMetaData' of
+        Left e          -> counterexample (show e) False
+        Right metaData' -> metaData === metaData'
+  where
+    contentPath  = FS.mkFsPath ["content"]
+    checksumPath = FS.mkFsPath ["checksum"]