feat(extras): add salt

Author: wenkokke

src-extras/Database/LSMTree/Extras/MergingRunData.hs

@@ -46,15 +46,16 @@ withMergingRun ::
   => HasFS IO h
   -> HasBlockIO IO h
   -> ResolveSerialisedValue
+  -> SessionSalt
   -> RunBuilder.RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> SerialisedMergingRunData t
   -> (Ref (MergingRun t IO h) -> IO a)
   -> IO a
-withMergingRun hfs hbio resolve runParams path counter mrd = do
+withMergingRun hfs hbio resolve sessionSalt runParams path counter mrd = do
     bracket
-      (unsafeCreateMergingRun hfs hbio resolve runParams path counter mrd)
+      (unsafeCreateMergingRun hfs hbio resolve sessionSalt runParams path counter mrd)
       releaseRef
 
 -- | Flush serialised merging run data to disk.
@@ -68,24 +69,25 @@ unsafeCreateMergingRun ::
   => HasFS IO h
   -> HasBlockIO IO h
   -> ResolveSerialisedValue
+  -> SessionSalt
   -> RunBuilder.RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> SerialisedMergingRunData t
   -> IO (Ref (MergingRun t IO h))
-unsafeCreateMergingRun hfs hbio resolve runParams path counter = \case
+unsafeCreateMergingRun hfs hbio resolve sessionSalt runParams path counter = \case
     CompletedMergeData _ rd -> do
-      withRun hfs hbio runParams path counter rd $ \run -> do
+      withRun hfs hbio sessionSalt runParams path counter rd $ \run -> do
         -- slightly hacky, generally it's larger
         let totalDebt = MR.numEntriesToMergeDebt (Run.size run)
         MR.newCompleted totalDebt run
 
     OngoingMergeData mergeType rds -> do
-      withRuns hfs hbio runParams path counter (toRunData <$> rds)
+      withRuns hfs hbio sessionSalt runParams path counter (toRunData <$> rds)
         $ \runs -> do
           n <- incrUniqCounter counter
           let fsPaths = RunFsPaths path (RunNumber (uniqueToInt n))
-          MR.new hfs hbio resolve runParams mergeType
+          MR.new hfs hbio resolve sessionSalt runParams mergeType
                  fsPaths (V.fromList runs)
 
 {-------------------------------------------------------------------------------

src-extras/Database/LSMTree/Extras/MergingTreeData.hs

@@ -27,6 +27,7 @@ import           Database.LSMTree.Extras.RunData
 import qualified Database.LSMTree.Internal.MergingRun as MR
 import           Database.LSMTree.Internal.MergingTree (MergingTree)
 import qualified Database.LSMTree.Internal.MergingTree as MT
+import           Database.LSMTree.Internal.Paths (SessionSalt)
 import           Database.LSMTree.Internal.RunBuilder (RunParams)
 import           Database.LSMTree.Internal.Serialise
 import           Database.LSMTree.Internal.UniqCounter
@@ -44,15 +45,16 @@ withMergingTree ::
      HasFS IO h
   -> HasBlockIO IO h
   -> ResolveSerialisedValue
+  -> SessionSalt
   -> RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> SerialisedMergingTreeData
   -> (Ref (MergingTree IO h) -> IO a)
   -> IO a
-withMergingTree hfs hbio resolve runParams path counter mrd = do
+withMergingTree hfs hbio resolve sessionSalt runParams path counter mrd = do
     bracket
-      (unsafeCreateMergingTree hfs hbio resolve runParams path counter mrd)
+      (unsafeCreateMergingTree hfs hbio resolve sessionSalt runParams path counter mrd)
       releaseRef
 
 -- | Flush serialised merging tree data to disk.
@@ -65,19 +67,20 @@ unsafeCreateMergingTree ::
      HasFS IO h
   -> HasBlockIO IO h
   -> ResolveSerialisedValue
+  -> SessionSalt
   -> RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> SerialisedMergingTreeData
   -> IO (Ref (MergingTree IO h))
-unsafeCreateMergingTree hfs hbio resolve runParams path counter = go
+unsafeCreateMergingTree hfs hbio resolve sessionSalt runParams path counter = go
   where
     go = \case
       CompletedTreeMergeData rd ->
-        withRun hfs hbio runParams path counter rd $ \run ->
+        withRun hfs hbio sessionSalt runParams path counter rd $ \run ->
           MT.newCompletedMerge run
       OngoingTreeMergeData mrd ->
-        withMergingRun hfs hbio resolve runParams path counter mrd $ \mr ->
+        withMergingRun hfs hbio resolve sessionSalt runParams path counter mrd $ \mr ->
           MT.newOngoingMerge mr
       PendingLevelMergeData prds mtd ->
         withPreExistingRuns prds $ \prs ->
@@ -100,11 +103,11 @@ unsafeCreateMergingTree hfs hbio resolve runParams path counter = go
 
     withPreExistingRuns [] act = act []
     withPreExistingRuns (PreExistingRunData rd : rest) act =
-        withRun hfs hbio runParams path counter rd $ \r ->
+        withRun hfs hbio sessionSalt runParams path counter rd $ \r ->
           withPreExistingRuns rest $ \prs ->
             act (MT.PreExistingRun r : prs)
     withPreExistingRuns (PreExistingMergingRunData mrd : rest) act =
-        withMergingRun hfs hbio resolve runParams path counter mrd $ \mr ->
+        withMergingRun hfs hbio resolve sessionSalt runParams path counter mrd $ \mr ->
           withPreExistingRuns rest $ \prs ->
             act (MT.PreExistingMergingRun mr : prs)
 

src-extras/Database/LSMTree/Extras/NoThunks.hs

@@ -237,6 +237,9 @@ deriving anyclass instance NoThunks RunNumber
 deriving stock instance Generic SessionRoot
 deriving anyclass instance NoThunks SessionRoot
 
+deriving stock instance Generic SessionSalt
+deriving anyclass instance NoThunks SessionSalt
+
 deriving stock instance Generic RunFsPaths
 deriving anyclass instance NoThunks RunFsPaths
 

src-extras/Database/LSMTree/Extras/RunData.hs

@@ -75,47 +75,50 @@ import           Test.QuickCheck
 withRun ::
      HasFS IO h
   -> HasBlockIO IO h
+  -> SessionSalt
   -> RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> SerialisedRunData
   -> (Ref (Run IO h) -> IO a)
   -> IO a
-withRun hfs hbio runParams path counter rd = do
+withRun hfs hbio sessionSalt runParams path counter rd = do
     bracket
-      (unsafeCreateRun hfs hbio runParams path counter rd)
+      (unsafeCreateRun hfs hbio sessionSalt runParams path counter rd)
       releaseRef
 
 -- | Create a temporary 'Run' using 'unsafeCreateRunAt'.
 withRunAt ::
      HasFS IO h
   -> HasBlockIO IO h
+  -> SessionSalt
   -> RunParams
   -> RunFsPaths
   -> SerialisedRunData
   -> (Ref (Run IO h) -> IO a)
   -> IO a
-withRunAt hfs hbio runParams path rd = do
+withRunAt hfs hbio sessionSalt runParams path rd = do
     bracket
-      (unsafeCreateRunAt hfs hbio runParams path rd)
+      (unsafeCreateRunAt hfs hbio sessionSalt runParams path rd)
       releaseRef
 
 {-# INLINABLE withRuns #-}
 -- | Create temporary 'Run's using 'unsafeCreateRun'.
 withRuns ::
      HasFS IO h
   -> HasBlockIO IO h
+  -> SessionSalt
   -> RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> [SerialisedRunData]
   -> ([Ref (Run IO h)] -> IO a)
   -> IO a
-withRuns hfs hbio runParams path counter = go
+withRuns hfs hbio sessionSalt runParams path counter = go
   where
     go []       act = act []
     go (rd:rds) act =
-      withRun hfs hbio runParams path counter rd $ \r ->
+      withRun hfs hbio sessionSalt runParams path counter rd $ \r ->
         go rds $ \rs ->
           act (r:rs)
 
@@ -124,15 +127,16 @@ withRuns hfs hbio runParams path counter = go
 unsafeCreateRun ::
      HasFS IO h
   -> HasBlockIO IO h
+  -> SessionSalt
   -> RunParams
   -> FS.FsPath
   -> UniqCounter IO
   -> SerialisedRunData
   -> IO (Ref (Run IO h))
-unsafeCreateRun fs hbio runParams path counter rd = do
+unsafeCreateRun fs hbio sessionSalt runParams path counter rd = do
     n <- incrUniqCounter counter
     let fsPaths = RunFsPaths path (uniqueToRunNumber n)
-    unsafeCreateRunAt fs hbio runParams fsPaths rd
+    unsafeCreateRunAt fs hbio sessionSalt runParams fsPaths rd
 
 -- | Flush serialised run data to disk as if it were a write buffer.
 --
@@ -143,18 +147,19 @@ unsafeCreateRun fs hbio runParams path counter rd = do
 unsafeCreateRunAt ::
      HasFS IO h
   -> HasBlockIO IO h
+  -> SessionSalt
   -> RunParams
   -> RunFsPaths
   -> SerialisedRunData
   -> IO (Ref (Run IO h))
-unsafeCreateRunAt fs hbio runParams fsPaths (RunData m) = do
+unsafeCreateRunAt fs hbio sessionSalt runParams fsPaths (RunData m) = do
     -- the WBB file path doesn't have to be at a specific place relative to
     -- the run we want to create, but fsPaths should already point to a unique
     -- location, so we just append something to not conflict with that.
     let blobpath = FS.addExtension (runBlobPath fsPaths) ".wb"
     bracket (WBB.new fs blobpath) releaseRef $ \wbblobs -> do
       wb <- WB.fromMap <$> traverse (traverse (WBB.addBlob fs wbblobs)) m
-      Run.fromWriteBuffer fs hbio runParams fsPaths wb wbblobs
+      Run.fromWriteBuffer fs hbio sessionSalt runParams fsPaths wb wbblobs
 
 -- | Create a 'RunFsPaths' using an empty 'FsPath'. The empty path corresponds
 -- to the "root" or "mount point" of a 'HasFS' instance.