Split openSession into newSession and restoreSession

Only the former requires a salt, and the latter does not require it. We still
keep a version of `openSession` that defers to `newSession` or `restoreSession`
based on the session directory contents, because we expect it to be useful for
users.

In `newSession`, the input salt is written to a new metadata file in the session
directory. In `restoreSession`, we read this metadata file back into memory to
extract the salt.

Author: jorisdral

bench-unions/Bench/Unions.hs

@@ -292,7 +292,7 @@ doSetup gopts = do
     createDirectoryIfMissing True $ rootDir gopts
 
     -- Populate the specified number of tables
-    LSM.withSession (rootDir gopts) $ \session -> do
+    LSM.withOpenSession (rootDir gopts) $ \session -> do
       -- Create a "baseline" table
       --
       -- We create a single table that *already has* all the same key value pairs
@@ -337,7 +337,7 @@ tableRange gopts =
 -- | Count duplicate keys in all tables that will be unioned together
 doCollisionAnalysis :: GlobalOpts -> IO ()
 doCollisionAnalysis gopts = do
-    LSM.withSession (rootDir gopts) $ \session -> do
+    LSM.withOpenSession (rootDir gopts) $ \session -> do
       seenRef <- newIORef Set.empty
       dupRef <- newIORef Set.empty
 
@@ -381,7 +381,7 @@ doRun gopts opts = do
     withFile dataPath WriteMode $ \h -> do
     hPutStrLn h "# iteration \t baseline (ops/sec) \t union (ops/sec) \t union debt"
 
-    LSM.withSession (rootDir gopts) $ \session -> do
+    LSM.withOpenSession (rootDir gopts) $ \session -> do
     -- Load the baseline table
     LSM.withTableFromSnapshot session baselineTableName label
       $ \baselineTable -> do

bench/macro/lsm-tree-bench-wp8.hs

@@ -416,7 +416,7 @@ doSetup' gopts opts = do
 
     let name = LSM.toSnapshotName "bench"
 
-    LSM.withSession (mkTracer gopts) hasFS hasBlockIO benchSalt (FS.mkFsPath []) $ \session -> do
+    LSM.withOpenSession (mkTracer gopts) hasFS hasBlockIO benchSalt (FS.mkFsPath []) $ \session -> do
         tbl <- LSM.newTableWith @IO @K @V @B (mkTableConfigSetup gopts opts benchTableConfig) session
 
         forM_ (groupsOfN 256 [ 0 .. initialSize gopts ]) $ \batch -> do
@@ -578,7 +578,7 @@ doRun gopts opts = do
 
     let name = LSM.toSnapshotName "bench"
 
-    LSM.withSession (mkTracer gopts) hasFS hasBlockIO benchSalt (FS.mkFsPath []) $ \session ->
+    LSM.withOpenSession (mkTracer gopts) hasFS hasBlockIO benchSalt (FS.mkFsPath []) $ \session ->
       withLatencyHandle $ \h -> do
         -- open snapshot
         -- In checking mode we start with an empty table, since our pure

lsm-tree.cabal

@@ -594,6 +594,7 @@ library
     , lsm-tree:kmerge
     , primitive               ^>=0.9
     , random                  ^>=1.0      || ^>=1.1      || ^>=1.2     || ^>=1.3
+    , serialise               ^>=0.2
     , text                    ^>=2.1.1
     , utf8-string             ^>=1.0
     , vector                  ^>=0.13

src/Database/LSMTree.hs

@@ -19,8 +19,8 @@ module Database.LSMTree (
 
   -- * Sessions
   Session,
-  withSession,
-  withSessionIO,
+  withOpenSession,
+  withOpenSessionIO,
   openSession,
   openSessionIO,
   closeSession,
@@ -200,8 +200,8 @@ import           Control.DeepSeq (NFData (..))
 import           Control.Exception.Base (assert)
 import           Control.Monad.Class.MonadAsync (MonadAsync)
 import           Control.Monad.Class.MonadST (MonadST)
-import           Control.Monad.Class.MonadThrow (MonadCatch (..), MonadMask,
-                     MonadThrow (..))
+import           Control.Monad.Class.MonadThrow (MonadCatch (..), MonadEvaluate,
+                     MonadMask, MonadThrow (..))
 import           Control.Monad.Primitive (PrimMonad)
 import           Control.Tracer (Tracer)
 import           Data.Bifunctor (Bifunctor (..))
@@ -290,6 +290,7 @@ type IOLike m =
   , MonadMask m
   , PrimMonad m
   , MonadST m
+  , MonadEvaluate m
   )
 
 --------------------------------------------------------------------------------
@@ -384,7 +385,7 @@ runExample action = do
   let createSessionDir = Dir.createDirectoryIfMissing True sessionDir
   let removeSessionDir = Dir.removeDirectoryRecursive sessionDir
   bracket_ createSessionDir removeSessionDir $ do
-    LSMT.withSessionIO mempty sessionDir $ \session -> do
+    LSMT.withOpenSessionIO mempty sessionDir $ \session -> do
       LSMT.withTable session $ \table ->
         action session table
 :}
@@ -399,8 +400,8 @@ runExample action = do
 {- |
 Run an action with access to a session opened from a session directory.
 
-If the session directory is empty, a new session is created.
-Otherwise, the session directory is opened as an existing session.
+If the session directory is empty, a new session is created using the given salt.
+Otherwise, the session directory is restored as an existing session ignoring the given salt.
 
 If there are no open tables or cursors when the session terminates, then the disk I\/O complexity of this operation is \(O(1)\).
 Otherwise, 'closeTable' is called for each open table and 'closeCursor' is called for each open cursor.
@@ -426,7 +427,7 @@ Throws the following exceptions:
     If the session directory is malformed.
 -}
 {-# SPECIALISE
-  withSession ::
+  withOpenSession ::
     Tracer IO LSMTreeTrace ->
     HasFS IO HandleIO ->
     HasBlockIO IO HandleIO ->
@@ -435,7 +436,7 @@ Throws the following exceptions:
     (Session IO -> IO a) ->
     IO a
   #-}
-withSession ::
+withOpenSession ::
   forall m h a.
   (IOLike m, Typeable h) =>
   Tracer m LSMTreeTrace ->
@@ -447,28 +448,28 @@ withSession ::
   FsPath ->
   (Session m -> m a) ->
   m a
-withSession tracer hasFS hasBlockIO sessionSalt sessionDir action = do
-  Internal.withSession tracer hasFS hasBlockIO sessionSalt sessionDir (action . Session)
+withOpenSession tracer hasFS hasBlockIO sessionSalt sessionDir action = do
+  Internal.withOpenSession tracer hasFS hasBlockIO sessionSalt sessionDir (action . Session)
 
--- | Variant of 'withSession' that is specialised to 'IO' using the real filesystem.
-withSessionIO ::
+-- | Variant of 'withOpenSession' that is specialised to 'IO' using the real filesystem.
+withOpenSessionIO ::
   Tracer IO LSMTreeTrace ->
   FilePath ->
   (Session IO -> IO a) ->
   IO a
-withSessionIO tracer sessionDir action = do
+withOpenSessionIO tracer sessionDir action = do
   let mountPoint = MountPoint sessionDir
   let sessionDirFsPath = mkFsPath []
   let hasFS = ioHasFS mountPoint
   sessionSalt <- randomIO
   withIOHasBlockIO hasFS defaultIOCtxParams $ \hasBlockIO ->
-    withSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath action
+    withOpenSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath action
 
 {- |
 Open a session from a session directory.
 
-If the session directory is empty, a new session is created.
-Otherwise, the session directory is opened as an existing session.
+If the session directory is empty, a new session is created using the given salt.
+Otherwise, the session directory is restored as an existing session ignoring the given salt.
 
 The worst-case disk I\/O complexity of this operation is \(O(1)\).
 

src/Database/LSMTree/Internal/Paths.hs

@@ -4,6 +4,8 @@
 module Database.LSMTree.Internal.Paths (
     SessionRoot (..)
   , lockFile
+  , lockFileName
+  , metadataFile
   , ActiveDir (..)
   , activeDir
   , runPath
@@ -75,7 +77,13 @@ newtype SessionRoot = SessionRoot { getSessionRoot :: FsPath }
   deriving stock Eq
 
 lockFile :: SessionRoot -> FsPath
-lockFile (SessionRoot dir) = dir </> mkFsPath ["lock"]
+lockFile (SessionRoot dir) = dir </> mkFsPath [lockFileName]
+
+lockFileName :: String
+lockFileName = "lock"
+
+metadataFile :: SessionRoot -> FsPath
+metadataFile (SessionRoot dir) = dir </> mkFsPath ["metadata"]
 
 newtype ActiveDir = ActiveDir { getActiveDir :: FsPath }