Change RawBlobRef to contain a BlobFile

Originally it contained the file handle and the refcounter of either the
Run or write buffer that the blob ref came from (pointed to).

In a previous patch we changed the Run and WriteBufferBlobs to
themselves contain an independently ref-counted BlobFile, and so at the
same time the blob ref refcount refers to the blob file refcount not
the refcount of the parent object.

In this patch we now change RawBlobRef to directly hold a BlobFile. This
makes the representation logically more uniform between the run and
write buffer cases: since we now just point to the BlobFile being held
by each blob source.

This refactoring will make things much clearer once we switch the
representation of ref-counted objects. Since we'll maintain a reference
to a BlobFile rather than a lower-level combo of a file handle and
reference count.

Author: dcoutts

src/Database/LSMTree/Internal/BlobRef.hs

@@ -24,14 +24,12 @@ import           Control.Monad (when)
 import           Control.Monad.Class.MonadThrow (Exception, MonadMask,
                      MonadThrow (..), bracket, throwIO)
 import           Control.Monad.Primitive
-import           Control.RefCount (RefCounter)
 import qualified Control.RefCount as RC
 import           Data.Coerce (coerce)
-import qualified Data.Primitive.ByteArray as P (MutableByteArray,
-                     newPinnedByteArray, unsafeFreezeByteArray)
+import qualified Data.Primitive.ByteArray as P (MutableByteArray)
 import qualified Data.Vector as V
-import           Database.LSMTree.Internal.BlobFile (BlobSpan (..))
-import qualified Database.LSMTree.Internal.RawBytes as RB
+import           Database.LSMTree.Internal.BlobFile (BlobFile (..), BlobSpan (..))
+import qualified Database.LSMTree.Internal.BlobFile as BlobFile
 import           Database.LSMTree.Internal.Serialise (SerialisedBlob (..))
 import qualified System.FS.API as FS
 import           System.FS.API (HasFS)
@@ -48,17 +46,16 @@ import qualified System.FS.BlockIO.API as FS
 -- Thus these cannot be handed out via the API. Use 'WeakBlobRef' for that.
 --
 data RawBlobRef m h = RawBlobRef {
-      blobRefFile  :: !(FS.Handle h)
-    , blobRefCount :: {-# UNPACK #-} !(RefCounter m)
-    , blobRefSpan  :: {-# UNPACK #-} !BlobSpan
+      rawBlobRefFile :: {-# NOUNPACK #-} !(BlobFile m h)
+    , rawBlobRefSpan :: {-# UNPACK #-}   !BlobSpan
     }
   deriving stock (Show)
 
 instance NFData h => NFData (RawBlobRef m h) where
-  rnf (RawBlobRef a b c) = rnf a `seq` rnf b `seq` rnf c
+  rnf (RawBlobRef a b) = rnf a `seq` rnf b
 
 blobRefSpanSize :: RawBlobRef m h -> Int
-blobRefSpanSize = fromIntegral . blobSpanSize . blobRefSpan
+blobRefSpanSize = fromIntegral . blobSpanSize . rawBlobRefSpan
 
 -- | A \"weak\" reference to a blob within a blob file. These are the ones we
 -- can return in the public API and can outlive their parent table.
@@ -117,7 +114,7 @@ deRefWeakBlobRef ::
   => WeakBlobRef m h
   -> m (RawBlobRef m h)
 deRefWeakBlobRef (WeakBlobRef ref) = do
-    ok <- RC.upgradeWeakReference (blobRefCount ref)
+    ok <- RC.upgradeWeakReference (blobFileRefCounter (rawBlobRefFile ref))
     when (not ok) $ throwIO (WeakBlobRefInvalid 0)
     pure ref
 
@@ -133,7 +130,7 @@ deRefWeakBlobRefs wrefs = do
     let refs :: V.Vector (RawBlobRef m h)
         refs = coerce wrefs -- safely coerce away the newtype wrappers
     V.iforM_ wrefs $ \i (WeakBlobRef ref) -> do
-      ok <- RC.upgradeWeakReference (blobRefCount ref)
+      ok <- RC.upgradeWeakReference (blobFileRefCounter (rawBlobRefFile ref))
       when (not ok) $ do
         -- drop refs on the previous ones taken successfully so far
         V.mapM_ removeReference (V.take i refs)
@@ -142,7 +139,7 @@ deRefWeakBlobRefs wrefs = do
 
 {-# SPECIALISE removeReference :: RawBlobRef IO h -> IO () #-}
 removeReference :: (MonadMask m, PrimMonad m) => RawBlobRef m h -> m ()
-removeReference = RC.removeReference . blobRefCount
+removeReference = BlobFile.removeReference . rawBlobRefFile
 
 {-# SPECIALISE removeReferences :: V.Vector (RawBlobRef IO h) -> IO () #-}
 removeReferences :: (MonadMask m, PrimMonad m) => V.Vector (RawBlobRef m h) -> m ()
@@ -157,31 +154,20 @@ readBlob ::
   => HasFS m h
   -> RawBlobRef m h
   -> m SerialisedBlob
-readBlob fs RawBlobRef {
-              blobRefFile,
-              blobRefSpan = BlobSpan {blobSpanOffset, blobSpanSize}
-            } = do
-    let off = FS.AbsOffset blobSpanOffset
-        len :: Int
-        len = fromIntegral blobSpanSize
-    mba <- P.newPinnedByteArray len
-    _ <- FS.hGetBufExactlyAt fs blobRefFile mba 0
-                             (fromIntegral len :: FS.ByteCount) off
-    ba <- P.unsafeFreezeByteArray mba
-    let !rb = RB.fromByteArray 0 len ba
-    return (SerialisedBlob rb)
+readBlob fs RawBlobRef {rawBlobRefFile, rawBlobRefSpan} =
+    BlobFile.readBlobFile fs rawBlobRefFile rawBlobRefSpan
 
 readBlobIOOp ::
      P.MutableByteArray s -> Int
   -> RawBlobRef m h
   -> FS.IOOp s h
 readBlobIOOp buf bufoff
              RawBlobRef {
-               blobRefFile,
-               blobRefSpan = BlobSpan {blobSpanOffset, blobSpanSize}
+               rawBlobRefFile = BlobFile {blobFileHandle},
+               rawBlobRefSpan = BlobSpan {blobSpanOffset, blobSpanSize}
              } =
     FS.IOOpRead
-      blobRefFile
+      blobFileHandle
       (fromIntegral blobSpanOffset :: FS.FileOffset)
       buf (FS.BufferOffset bufoff)
       (fromIntegral blobSpanSize :: FS.ByteCount)

src/Database/LSMTree/Internal/Run.hs

@@ -145,11 +145,10 @@ removeReferenceN r = RC.removeReferenceN (runRefCounter r)
 
 -- | Helper function to make a 'BlobRef' that points into a 'Run'.
 mkBlobRefForRun :: Run m h -> BlobSpan -> RawBlobRef m h
-mkBlobRefForRun Run{runBlobFile} blobRefSpan =
+mkBlobRefForRun Run{runBlobFile} blobspan =
     RawBlobRef {
-      blobRefFile  = blobFileHandle runBlobFile,
-      blobRefCount = blobFileRefCounter runBlobFile,
-      blobRefSpan
+      rawBlobRefFile = runBlobFile,
+      rawBlobRefSpan = blobspan
     }
 
 {-# SPECIALISE close ::

src/Database/LSMTree/Internal/WriteBufferBlobs.hs

@@ -182,11 +182,10 @@ readBlob fs WriteBufferBlobs {blobFile} blobspan =
 mkBlobRef :: WriteBufferBlobs m h
           -> BlobSpan
           -> RawBlobRef m h
-mkBlobRef WriteBufferBlobs {blobFile} blobRefSpan =
+mkBlobRef WriteBufferBlobs {blobFile} blobspan =
     RawBlobRef {
-      blobRefFile  = blobFileHandle blobFile,
-      blobRefCount = blobFileRefCounter blobFile,
-      blobRefSpan
+      rawBlobRefFile = blobFile,
+      rawBlobRefSpan = blobspan
     }