Temporary hack until we have proper snapshots

Currently, pre-snapshots, the Run does _not_ delete its blob files when
the run is closed, but the WriteBufferBlobs _does_ delete its blob file.

Insert a temporary hack to accomodate this. This commit can be reverted
as part of implementing snapshots properly.

Author: dcoutts

src/Database/LSMTree/Internal/BlobFile.hs

@@ -7,11 +7,13 @@ module Database.LSMTree.Internal.BlobFile (
     BlobFile (..)
   , BlobSpan (..)
   , removeReference
+  , RemoveFileOnClose (..)
   , newBlobFile
   , readBlobFile
   ) where
 
 import           Control.DeepSeq (NFData (..))
+import           Control.Monad (unless)
 import           Control.Monad.Class.MonadThrow (MonadThrow, MonadMask)
 import           Control.Monad.Primitive (PrimMonad)
 import           Control.RefCount (RefCounter)
@@ -56,6 +58,11 @@ removeReference ::
 removeReference BlobFile{blobFileRefCounter} =
     RC.removeReference blobFileRefCounter
 
+-- | TODO: this hack can be removed once snapshots are done properly and so
+-- runs can delete their files on close.
+data RemoveFileOnClose = RemoveFileOnClose | DoNotRemoveFileOnClose
+  deriving stock Eq
+
 -- | Adopt an existing open file handle to make a 'BlobFile'. The file must at
 -- least be open for reading (but may or may not be open for writing).
 --
@@ -64,12 +71,14 @@ removeReference BlobFile{blobFileRefCounter} =
 newBlobFile ::
      PrimMonad m
   => HasFS m h
+  -> RemoveFileOnClose
   -> FS.Handle h
   -> m (BlobFile m h)
-newBlobFile fs blobFileHandle = do
+newBlobFile fs r blobFileHandle = do
     let finaliser = do
           FS.hClose fs blobFileHandle
-          FS.removeFile fs (FS.handlePath blobFileHandle)
+          unless (r == DoNotRemoveFileOnClose) $
+            FS.removeFile fs (FS.handlePath blobFileHandle)
     blobFileRefCounter <- RC.mkRefCounter1 (Just finaliser)
     return BlobFile {
       blobFileHandle,

src/Database/LSMTree/Internal/Run.hs

@@ -168,6 +168,8 @@ mkWeakBlobRef Run{runBlobFile} blobspan =
 --
 -- TODO: Once snapshots are implemented, files should get removed, but for now
 -- we want to be able to re-open closed runs from disk.
+-- TODO: see newBlobFile DoNotRemoveFileOnClose. This can be dropped at the
+-- same once when snapshots are implemented.
 close :: (MonadSTM m, MonadMask m, PrimMonad m) => Run m h -> m ()
 close Run {..} = do
     -- TODO: removing files should drop them from the page cache, but until we
@@ -224,7 +226,7 @@ fromMutable runRunDataCaching refCount builder = do
     (runHasFS, runHasBlockIO, runRunFsPaths, runFilter, runIndex, runNumEntries) <-
       Builder.unsafeFinalise (runRunDataCaching == NoCacheRunData) builder
     runKOpsFile <- FS.hOpen runHasFS (runKOpsPath runRunFsPaths) FS.ReadMode
-    runBlobFile <- newBlobFile runHasFS
+    runBlobFile <- newBlobFile runHasFS DoNotRemoveFileOnClose
                =<< FS.hOpen runHasFS (runBlobPath runRunFsPaths) FS.ReadMode
     setRunDataCaching runHasBlockIO runKOpsFile runRunDataCaching
     rec runRefCounter <- RC.unsafeMkRefCounterN refCount (Just $ close r)
@@ -310,7 +312,7 @@ openFromDisk fs hbio runRunDataCaching runRunFsPaths = do
         =<< readCRC (forRunIndex expectedChecksums) (forRunIndex paths)
 
     runKOpsFile <- FS.hOpen fs (runKOpsPath runRunFsPaths) FS.ReadMode
-    runBlobFile <- newBlobFile fs
+    runBlobFile <- newBlobFile fs DoNotRemoveFileOnClose
                =<< FS.hOpen fs (runBlobPath runRunFsPaths) FS.ReadMode
     setRunDataCaching hbio runKOpsFile runRunDataCaching
     rec runRefCounter <- RC.unsafeMkRefCounterN (RefCount 1) (Just $ close r)

src/Database/LSMTree/Internal/WriteBufferBlobs.hs

@@ -122,7 +122,7 @@ new fs blobFileName = do
     -- we can also be asked to retrieve blobs at any time.
     blobFileHandle <- FS.hOpen fs blobFileName (FS.ReadWriteMode FS.MustBeNew)
     blobFilePointer <- newFilePointer
-    blobFile <- newBlobFile fs blobFileHandle
+    blobFile <- newBlobFile fs RemoveFileOnClose blobFileHandle
     return WriteBufferBlobs {
       blobFile,
       blobFilePointer