WIP: run statemachine tests with simulated file system

And test that no file handles are left open at the end!

test/Test/Database/LSMTree/Normal/StateMachine.hs

@@ -50,6 +50,8 @@ module Test.Database.LSMTree.Normal.StateMachine (
   , labelledExamples
   ) where
 
+import           Control.Concurrent.Class.MonadSTM.Strict
+import           Control.Exception (assert)
 import           Control.Monad ((<=<))
 import           Control.Monad.Class.MonadThrow (Handler (..), MonadCatch (..),
                      MonadThrow (..))
@@ -81,7 +83,10 @@ import           System.Directory (removeDirectoryRecursive)
 import           System.FS.API (HasFS, MountPoint (..), mkFsPath)
 import           System.FS.BlockIO.API (HasBlockIO, defaultIOCtxParams)
 import           System.FS.BlockIO.IO (ioHasBlockIO)
+import           System.FS.BlockIO.Sim (simHasBlockIO)
 import           System.FS.IO (HandleIO, ioHasFS)
+import qualified System.FS.Sim.MockFS as MockFS
+import           System.FS.Sim.MockFS (MockFS)
 import           System.IO.Error
 import           System.IO.Temp (createTempDirectory,
                      getCanonicalTemporaryDirectory)
@@ -106,9 +111,7 @@ tests :: TestTree
 tests = testGroup "Normal.StateMachine" [
       propLockstepIO_ModelIOImpl
     , propLockstepIO_RealImpl_RealFS
-{- TODO: temporarily disabled until we start on I/O fault testing.
     , propLockstepIO_RealImpl_MockFS
--}
     ]
 
 labelledExamples :: IO ()
@@ -200,30 +203,40 @@ propLockstepIO_RealImpl_RealFS = testProperty "propLockstepIO_RealImpl_RealFS" $
         handler' (ErrBlobRefInvalid _) = Just Model.ErrBlobRefInvalidated
         handler' _ = Nothing
 
-{- TODO: temporarily disabled until we start on I/O fault testing.
 propLockstepIO_RealImpl_MockFS :: TestTree
 propLockstepIO_RealImpl_MockFS = testProperty "propLockstepIO_RealImpl_MockFS" $
-   QC.expectFailure $ -- TODO: remove once we have a real implementation
-    Lockstep.Run.runActionsBracket
+    runActionsBracket'
       (Proxy @(ModelState R.TableHandle))
       acquire
       release
-      (\r session -> runReaderT r (session, handler))
+      (\r (_, session) -> runReaderT r (session, handler))
+      tagFinalState'
   where
-    acquire :: IO (WrapSession R.TableHandle IO)
+    acquire :: IO (StrictTMVar IO MockFS, WrapSession R.TableHandle IO)
     acquire = do
-        someHasFS <- SomeHasFS <$> simHasFS' MockFS.empty
-        WrapSession <$> R.openSession someHasFS (mkFsPath [])
-
-    release :: WrapSession R.TableHandle IO -> IO ()
-    release (WrapSession session) = R.closeSession session
-
+        fsVar <- newTMVarIO MockFS.empty
+        (hfs, hbio) <- simHasBlockIO fsVar
+        session <- R.openSession nullTracer hfs hbio (mkFsPath [])
+        pure (fsVar, WrapSession session)
+
+    release :: (StrictTMVar IO MockFS, WrapSession R.TableHandle IO) -> IO ()
+    release (fsVar, WrapSession session) = do
+      R.closeSession session
+      mockfs <- atomically $ readTMVar fsVar
+      assert (MockFS.numOpenHandles mockfs == 0) $ pure ()
+
+    -- TODO: reduce duplication with propLockstepIO_RealImpl_RealFS
     handler :: Handler IO (Maybe Model.Err)
     handler = Handler $ pure . handler'
       where
-        handler' :: IOError -> Maybe Model.Err
-        handler' _err = Nothing
--}
+        handler' :: LSMTreeError -> Maybe Model.Err
+        handler' ErrTableClosed = Just Model.ErrTableHandleClosed
+        handler' ErrCursorClosed = Just Model.ErrCursorClosed
+        handler' (ErrSnapshotNotExists _snap) = Just Model.ErrSnapshotDoesNotExist
+        handler' (ErrSnapshotExists _snap) = Just Model.ErrSnapshotExists
+        handler' (ErrSnapshotWrongType _snap) = Just Model.ErrSnapshotWrongType
+        handler' (ErrBlobRefInvalid _) = Just Model.ErrBlobRefInvalidated
+        handler' _ = Nothing
 
 createSystemTempDirectory ::  [Char] -> IO (FilePath, HasFS IO HandleIO, HasBlockIO IO HandleIO)
 createSystemTempDirectory prefix = do