Manually invalidate blob references in the model

This is required for properly modelling the model's response to disk faults in
`createSnapshot`. The current implementation for `createSnapshot` in the real
system can invalidate blob references even if creating the snapshot failed, so
the model will invalidate blob references as well. This change might become
obsolete once #478 is merged.

Author: jorisdral

test/Database/LSMTree/Model/Session.hs

@@ -64,6 +64,7 @@ module Database.LSMTree.Model.Session (
     -- ** Blobs
   , BlobRef
   , retrieveBlobs
+  , invalidateBlobRefs
     -- * Snapshots
   , SnapshotName
   , createSnapshot
@@ -481,6 +482,27 @@ liftBlobRefs ::
   -> g (f (BlobRef b))
 liftBlobRefs hid = fmap (fmap (BlobRef hid))
 
+-- | Invalidate blob references that were created from the given table. This
+-- function assumes that it is called on an open table.
+--
+-- This is useful in tests where blob references should be invalidated for other
+-- reasons than normal operation of the model.
+--
+-- TODO: I (Joris) think this function will become obsolete once lsm-tree#478 is
+-- merged, because then createSnapshot won't flush the write buffer into the
+-- levels anymore.
+invalidateBlobRefs ::
+     MonadState Model m
+  => Table k v b
+  -> m ()
+invalidateBlobRefs Table{..} = do
+    gets (Map.lookup tableID . tables) >>= \case
+      Nothing -> error "invalidateBlobRefs: table is closed!"
+      Just (updc, tbl) -> do
+        modify (\m -> m {
+            tables = Map.insert tableID (updc + 1, tbl) (tables m)
+          })
+
 {-------------------------------------------------------------------------------
   Snapshots
 -------------------------------------------------------------------------------}