Rename internal BlobRef type to RawBlobRef

dcoutts · dcoutts · commit d49ccbc63df9 · 2024-11-08T15:51:53.000Z
To better reflect that it does not itself maintain a reference count,
and to distinguish it from a new type we will introduce soon: a strong
blob ref.

Then we will have a clear type distinction: raw, weak and strong.
diff --git a/src-extras/Database/LSMTree/Extras/NoThunks.hs b/src-extras/Database/LSMTree/Extras/NoThunks.hs
@@ -417,9 +417,9 @@ deriving anyclass instance NoThunks RawOverflowPage
   BlobRef
 -------------------------------------------------------------------------------}
 
-deriving stock instance Generic (BlobRef m h)
+deriving stock instance Generic (RawBlobRef m h)
 deriving anyclass instance (Typeable h, Typeable (PrimState m))
-                        => NoThunks (BlobRef m h)
+                        => NoThunks (RawBlobRef m h)
 
 deriving stock instance Generic BlobSpan
 deriving anyclass instance NoThunks BlobSpan
diff --git a/src/Database/LSMTree/Internal/BlobRef.hs b/src/Database/LSMTree/Internal/BlobRef.hs
@@ -4,7 +4,7 @@
 {- HLINT ignore "Use unless" -}
 
 module Database.LSMTree.Internal.BlobRef (
-    BlobRef (..)
+    RawBlobRef (..)
   , BlobSpan (..)
   , blobRefSpanSize
   , WeakBlobRef (..)
@@ -37,31 +37,40 @@ import qualified System.FS.API as FS
 import           System.FS.API (HasFS)
 import qualified System.FS.BlockIO.API as FS
 
--- | A handle-like reference to an on-disk blob. The blob can be retrieved based
--- on the reference.
+
+-- | A raw blob reference is a reference to a blob within a blob file.
 --
--- See 'Database.LSMTree.Common.BlobRef' for more info.
-data BlobRef m h = BlobRef {
+-- The \"raw\" means that it does no reference counting, so does not maintain
+-- ownership of the 'BlobFile'. Thus these are only safe to use in the context
+-- of code that already (directly or indirectly) owns the blob file that the
+-- blob ref uses (such as within run merging).
+--
+-- 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
     }
   deriving stock (Show)
 
-instance NFData h => NFData (BlobRef m h) where
-  rnf (BlobRef a b c) = rnf a `seq` rnf b `seq` rnf c
+instance NFData h => NFData (RawBlobRef m h) where
+  rnf (RawBlobRef a b c) = rnf a `seq` rnf b `seq` rnf c
 
-blobRefSpanSize :: BlobRef m h -> Int
+blobRefSpanSize :: RawBlobRef m h -> Int
 blobRefSpanSize = fromIntegral . blobSpanSize . blobRefSpan
 
--- | A 'WeakBlobRef' is a weak reference to a blob file. These are the ones we
--- can return in the public API and can outlive their parent table. They do not
--- keep the file open using a reference count. So when we want to use our weak
--- reference we have to dereference them to obtain a normal strong reference
--- while we do the I\/O to read the blob. This ensures the file is not closed
--- under our feet.
+-- | 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.
+--
+-- They are weak references in that they do not keep the file open using a
+-- reference count. So when we want to use our weak reference we have to
+-- dereference them to obtain a normal strong reference while we do the I\/O
+-- to read the blob. This ensures the file is not closed under our feet.
+--
+-- See 'Database.LSMTree.Common.BlobRef' for more info.
 --
-newtype WeakBlobRef m h = WeakBlobRef (BlobRef m h)
+newtype WeakBlobRef m h = WeakBlobRef (RawBlobRef m h)
   deriving newtype (Show, NFData)
 
 -- | The 'WeakBlobRef' now points to a blob that is no longer available.
@@ -71,7 +80,7 @@ newtype WeakBlobRefInvalid = WeakBlobRefInvalid Int
 
 {-# SPECIALISE withWeakBlobRef ::
      WeakBlobRef IO h
-  -> (BlobRef IO h -> IO a)
+  -> (RawBlobRef IO h -> IO a)
   -> IO a #-}
 -- | 'WeakBlobRef's are weak references. They do not keep the blob file open.
 -- Dereference a 'WeakBlobRef' to a strong 'BlobRef' to allow I\/O using
@@ -83,45 +92,45 @@ newtype WeakBlobRefInvalid = WeakBlobRefInvalid Int
 withWeakBlobRef ::
      (MonadMask m, PrimMonad m)
   => WeakBlobRef m h
-  -> (BlobRef m h -> m a)
+  -> (RawBlobRef m h -> m a)
   -> m a
 withWeakBlobRef wref = bracket (deRefWeakBlobRef wref) removeReference
 
 {-# SPECIALISE withWeakBlobRefs ::
      V.Vector (WeakBlobRef IO h)
-  -> (V.Vector (BlobRef IO h) -> IO a)
+  -> (V.Vector (RawBlobRef IO h) -> IO a)
   -> IO a #-}
 -- | The same as 'withWeakBlobRef' but for many references in one go.
 --
 withWeakBlobRefs ::
      (MonadMask m, PrimMonad m)
   => V.Vector (WeakBlobRef m h)
-  -> (V.Vector (BlobRef m h) -> m a)
+  -> (V.Vector (RawBlobRef m h) -> m a)
   -> m a
 withWeakBlobRefs wrefs = bracket (deRefWeakBlobRefs wrefs) removeReferences
 
 {-# SPECIALISE deRefWeakBlobRef ::
      WeakBlobRef IO h
-  -> IO (BlobRef IO h) #-}
+  -> IO (RawBlobRef IO h) #-}
 deRefWeakBlobRef ::
      (MonadThrow m, PrimMonad m)
   => WeakBlobRef m h
-  -> m (BlobRef m h)
+  -> m (RawBlobRef m h)
 deRefWeakBlobRef (WeakBlobRef ref) = do
     ok <- RC.upgradeWeakReference (blobRefCount ref)
     when (not ok) $ throwIO (WeakBlobRefInvalid 0)
     pure ref
 
 {-# SPECIALISE deRefWeakBlobRefs ::
      V.Vector (WeakBlobRef IO h)
-  -> IO (V.Vector (BlobRef IO h)) #-}
+  -> IO (V.Vector (RawBlobRef IO h)) #-}
 deRefWeakBlobRefs ::
     forall m h.
      (MonadMask m, PrimMonad m)
   => V.Vector (WeakBlobRef m h)
-  -> m (V.Vector (BlobRef m h))
+  -> m (V.Vector (RawBlobRef m h))
 deRefWeakBlobRefs wrefs = do
-    let refs :: V.Vector (BlobRef m h)
+    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)
@@ -131,24 +140,24 @@ deRefWeakBlobRefs wrefs = do
         throwIO (WeakBlobRefInvalid i)
     pure refs
 
-{-# SPECIALISE removeReference :: BlobRef IO h -> IO () #-}
-removeReference :: (MonadMask m, PrimMonad m) => BlobRef m h -> m ()
+{-# SPECIALISE removeReference :: RawBlobRef IO h -> IO () #-}
+removeReference :: (MonadMask m, PrimMonad m) => RawBlobRef m h -> m ()
 removeReference = RC.removeReference . blobRefCount
 
-{-# SPECIALISE removeReferences :: V.Vector (BlobRef IO h) -> IO () #-}
-removeReferences :: (MonadMask m, PrimMonad m) => V.Vector (BlobRef m h) -> m ()
+{-# SPECIALISE removeReferences :: V.Vector (RawBlobRef IO h) -> IO () #-}
+removeReferences :: (MonadMask m, PrimMonad m) => V.Vector (RawBlobRef m h) -> m ()
 removeReferences = V.mapM_ removeReference
 
 {-# SPECIALISE readBlob ::
      HasFS IO h
-  -> BlobRef IO h
+  -> RawBlobRef IO h
   -> IO SerialisedBlob #-}
 readBlob ::
      (MonadThrow m, PrimMonad m)
   => HasFS m h
-  -> BlobRef m h
+  -> RawBlobRef m h
   -> m SerialisedBlob
-readBlob fs BlobRef {
+readBlob fs RawBlobRef {
               blobRefFile,
               blobRefSpan = BlobSpan {blobSpanOffset, blobSpanSize}
             } = do
@@ -164,10 +173,10 @@ readBlob fs BlobRef {
 
 readBlobIOOp ::
      P.MutableByteArray s -> Int
-  -> BlobRef m h
+  -> RawBlobRef m h
   -> FS.IOOp s h
 readBlobIOOp buf bufoff
-             BlobRef {
+             RawBlobRef {
                blobRefFile,
                blobRefSpan = BlobSpan {blobSpanOffset, blobSpanSize}
              } =
diff --git a/src/Database/LSMTree/Internal/Cursor.hs b/src/Database/LSMTree/Internal/Cursor.hs
@@ -9,7 +9,7 @@ import           Control.Monad.Class.MonadST (MonadST (..))
 import           Control.Monad.Class.MonadThrow
 import           Control.Monad.Fix (MonadFix)
 import qualified Data.Vector as V
-import           Database.LSMTree.Internal.BlobRef (BlobRef,
+import           Database.LSMTree.Internal.BlobRef (RawBlobRef,
                      WeakBlobRef (..))
 import           Database.LSMTree.Internal.Entry (Entry)
 import qualified Database.LSMTree.Internal.Entry as Entry
@@ -106,7 +106,7 @@ readEntriesWhile resolve keyIsWanted fromEntry readers n =
     -- Once we have a resolved entry, we still have to make sure it's not
     -- a 'Delete', since we only want to write values to the result vector.
     handleResolved :: SerialisedKey
-                   -> Entry SerialisedValue (BlobRef m h)
+                   -> Entry SerialisedValue (RawBlobRef m h)
                    -> Readers.HasMore
                    -> m (Maybe res, Readers.HasMore)
     handleResolved key entry hasMore =
@@ -122,7 +122,7 @@ readEntriesWhile resolve keyIsWanted fromEntry readers n =
               Readers.Drained -> return (Nothing, Readers.Drained)
 
     toResult :: SerialisedKey
-             -> Entry SerialisedValue (BlobRef m h)
+             -> Entry SerialisedValue (RawBlobRef m h)
              -> Maybe res
     toResult key = \case
         Entry.Insert v -> Just $ fromEntry key v Nothing
diff --git a/src/Database/LSMTree/Internal/Merge.hs b/src/Database/LSMTree/Internal/Merge.hs
@@ -33,7 +33,7 @@ import           Data.Primitive.MutVar
 import           Data.Traversable (for)
 import qualified Data.Vector as V
 import           Data.Word
-import           Database.LSMTree.Internal.BlobRef (BlobRef)
+import           Database.LSMTree.Internal.BlobRef (RawBlobRef)
 import           Database.LSMTree.Internal.Entry
 import           Database.LSMTree.Internal.Run (Run, RunDataCaching)
 import qualified Database.LSMTree.Internal.Run as Run
@@ -396,14 +396,14 @@ writeReaderEntry level builder key entry@(Reader.EntryOverflow prefix page _ ove
      Level
   -> RunBuilder IO h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef IO h)
+  -> Entry SerialisedValue (RawBlobRef IO h)
   -> IO () #-}
 writeSerialisedEntry ::
      (MonadSTM m, MonadST m, MonadThrow m)
   => Level
   -> RunBuilder m h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef m h)
+  -> Entry SerialisedValue (RawBlobRef m h)
   -> m ()
 writeSerialisedEntry level builder key entry =
     when (shouldWriteEntry level entry) $
diff --git a/src/Database/LSMTree/Internal/Run.hs b/src/Database/LSMTree/Internal/Run.hs
@@ -144,9 +144,9 @@ removeReferenceN :: (PrimMonad m, MonadMask m) => Run m h -> Word64 -> m ()
 removeReferenceN r = RC.removeReferenceN (runRefCounter r)
 
 -- | Helper function to make a 'BlobRef' that points into a 'Run'.
-mkBlobRefForRun :: Run m h -> BlobSpan -> BlobRef m h
+mkBlobRefForRun :: Run m h -> BlobSpan -> RawBlobRef m h
 mkBlobRefForRun Run{runBlobFile} blobRefSpan =
-    BlobRef {
+    RawBlobRef {
       blobRefFile  = blobFileHandle runBlobFile,
       blobRefCount = blobFileRefCounter runBlobFile,
       blobRefSpan
diff --git a/src/Database/LSMTree/Internal/RunBuilder.hs b/src/Database/LSMTree/Internal/RunBuilder.hs
@@ -22,7 +22,7 @@ import qualified Data.ByteString.Lazy as BSL
 import           Data.Foldable (for_, traverse_)
 import           Data.Primitive.PrimVar
 import           Data.Word (Word64)
-import           Database.LSMTree.Internal.BlobRef (BlobRef, BlobSpan (..))
+import           Database.LSMTree.Internal.BlobRef (RawBlobRef, BlobSpan (..))
 import qualified Database.LSMTree.Internal.BlobRef as BlobRef
 import           Database.LSMTree.Internal.BloomFilter (bloomFilterToLBS)
 import           Database.LSMTree.Internal.CRC32C (CRC32C)
@@ -106,11 +106,11 @@ new fs hbio runBuilderFsPaths numEntries alloc = do
 {-# SPECIALISE addKeyOp ::
      RunBuilder IO h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef IO h)
+  -> Entry SerialisedValue (RawBlobRef IO h)
   -> IO () #-}
 -- | Add a key\/op pair.
 --
--- In the 'InsertWithBlob' case, the 'BlobRef' identifies where the blob can be
+-- In the 'InsertWithBlob' case, the 'RawBlobRef' identifies where the blob can be
 -- found (which is either from a write buffer or another run). The blobs will
 -- be copied from their existing blob file into the new run's blob file.
 --
@@ -125,7 +125,7 @@ addKeyOp ::
      (MonadST m, MonadSTM m, MonadThrow m)
   => RunBuilder m h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef m h)
+  -> Entry SerialisedValue (RawBlobRef m h)
   -> m ()
 addKeyOp builder@RunBuilder{runBuilderAcc} key op = do
     -- TODO: the fmap entry here reallocates even when there are no blobs.
@@ -275,12 +275,12 @@ writeBlob RunBuilder{..} blob = do
 
 {-# SPECIALISE copyBlob ::
      RunBuilder IO h
-  -> BlobRef IO h
+  -> RawBlobRef IO h
   -> IO BlobSpan #-}
 copyBlob ::
      (MonadSTM m, MonadThrow m, PrimMonad m)
   => RunBuilder m h
-  -> BlobRef m h
+  -> RawBlobRef m h
   -> m BlobSpan
 copyBlob builder@RunBuilder {..} blobref = do
     blob <- BlobRef.readBlob runBuilderHasFS blobref
diff --git a/src/Database/LSMTree/Internal/RunReader.hs b/src/Database/LSMTree/Internal/RunReader.hs
@@ -29,7 +29,7 @@ import           Data.Primitive.PrimVar
 import           Data.Word (Word16, Word32)
 import           Database.LSMTree.Internal.BitMath (ceilDivPageSize,
                      mulPageSize, roundUpToPageSize)
-import           Database.LSMTree.Internal.BlobRef (BlobRef (..))
+import           Database.LSMTree.Internal.BlobRef (RawBlobRef (..))
 import qualified Database.LSMTree.Internal.Entry as E
 import qualified Database.LSMTree.Internal.IndexCompact as Index
 import           Database.LSMTree.Internal.Page (PageNo (..), PageSpan (..),
@@ -167,12 +167,12 @@ data Result m h
 
 data Entry m h =
     Entry
-      !(E.Entry SerialisedValue (BlobRef m h))
+      !(E.Entry SerialisedValue (RawBlobRef m h))
   | -- | A large entry. The caller might be interested in various different
     -- (redundant) representation, so we return all of them.
     EntryOverflow
       -- | The value is just a prefix, with the remainder in the overflow pages.
-      !(E.Entry SerialisedValue (BlobRef m h))
+      !(E.Entry SerialisedValue (RawBlobRef m h))
       -- | A page containing the single entry (or rather its prefix).
       !RawPage
       -- | Non-zero length of the overflow in bytes.
@@ -186,7 +186,7 @@ data Entry m h =
       ![RawOverflowPage]
 
 mkEntryOverflow ::
-     E.Entry SerialisedValue (BlobRef m h)
+     E.Entry SerialisedValue (RawBlobRef m h)
   -> RawPage
   -> Word32
   -> [RawOverflowPage]
@@ -198,7 +198,7 @@ mkEntryOverflow entryPrefix page len overflowPages =
       EntryOverflow entryPrefix page len overflowPages
 
 {-# INLINE toFullEntry #-}
-toFullEntry :: Entry m h -> E.Entry SerialisedValue (BlobRef m h)
+toFullEntry :: Entry m h -> E.Entry SerialisedValue (RawBlobRef m h)
 toFullEntry = \case
     Entry e ->
       e
@@ -252,7 +252,7 @@ next reader@RunReader {..} = do
           IndexEntryOverflow key entry lenSuffix -> do
             -- TODO: we know that we need the next page, could already load?
             modifyPrimVar readerCurrentEntryNo (+1)
-            let entry' :: E.Entry SerialisedValue (BlobRef m h)
+            let entry' :: E.Entry SerialisedValue (RawBlobRef m h)
                 entry' = fmap (Run.mkBlobRefForRun readerRun) entry
             overflowPages <- readOverflowPages readerHasFS readerKOpsHandle lenSuffix
             let rawEntry = mkEntryOverflow entry' page lenSuffix overflowPages
diff --git a/src/Database/LSMTree/Internal/RunReaders.hs b/src/Database/LSMTree/Internal/RunReaders.hs
@@ -26,7 +26,7 @@ import           Data.Maybe (catMaybes)
 import           Data.Primitive.MutVar
 import           Data.Traversable (for)
 import qualified Data.Vector as V
-import           Database.LSMTree.Internal.BlobRef (BlobRef)
+import           Database.LSMTree.Internal.BlobRef (RawBlobRef)
 import           Database.LSMTree.Internal.Entry (Entry (..))
 import           Database.LSMTree.Internal.Run (Run)
 import           Database.LSMTree.Internal.RunReader (OffsetKey (..),
@@ -105,7 +105,7 @@ data Reader m h =
     -- TODO: more efficient representation? benchmark!
   | ReadBuffer !(MutVar (PrimState m) [KOp m h])
 
-type KOp m h = (SerialisedKey, Entry SerialisedValue (BlobRef m h))
+type KOp m h = (SerialisedKey, Entry SerialisedValue (RawBlobRef m h))
 
 {-# SPECIALISE new ::
      OffsetKey
diff --git a/src/Database/LSMTree/Internal/WriteBufferBlobs.hs b/src/Database/LSMTree/Internal/WriteBufferBlobs.hs
@@ -43,7 +43,7 @@ import qualified Data.Vector.Primitive as VP
 import           Data.Word (Word64)
 import           Database.LSMTree.Internal.BlobFile hiding (removeReference)
 import qualified Database.LSMTree.Internal.BlobFile as BlobFile
-import           Database.LSMTree.Internal.BlobRef (BlobRef (..))
+import           Database.LSMTree.Internal.BlobRef (RawBlobRef (..))
 import           Database.LSMTree.Internal.Serialise
 import qualified System.FS.API as FS
 import           System.FS.API (HasFS)
@@ -181,9 +181,9 @@ readBlob fs WriteBufferBlobs {blobFile} blobspan =
 -- | Helper function to make a 'BlobRef' that points into a 'WriteBufferBlobs'.
 mkBlobRef :: WriteBufferBlobs m h
           -> BlobSpan
-          -> BlobRef m h
+          -> RawBlobRef m h
 mkBlobRef WriteBufferBlobs {blobFile} blobRefSpan =
-    BlobRef {
+    RawBlobRef {
       blobRefFile  = blobFileHandle blobFile,
       blobRefCount = blobFileRefCounter blobFile,
       blobRefSpan
