QLS: test exception safety for the OpenSnapshot action

Author: jorisdral

test/Test/Database/LSMTree/StateMachine.hs

@@ -117,6 +117,7 @@ import qualified System.FS.Sim.Error as FSSim
 import           System.FS.Sim.Error (Errors)
 import qualified System.FS.Sim.MockFS as MockFS
 import           System.FS.Sim.MockFS (MockFS)
+import qualified System.FS.Sim.Stream as Stream
 import           System.FS.Sim.Stream (Stream)
 import           System.IO.Temp (createTempDirectory,
                      getCanonicalTemporaryDirectory)
@@ -1434,8 +1435,13 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
      ++ [ (1, fmap Some $ OpenSnapshot @k @v @b PrettyProxy <$>
                 genErrors <*> pure label <*> genUsedSnapshotName)
         | not (null usedSnapshotNames)
-          -- TODO: generate errors
-        , let genErrors = pure Nothing
+        , let genErrors = do
+                merrs <- QC.arbitrary
+                case merrs of
+                  Nothing -> pure Nothing
+                  Just errs -> pure . Just $ errs {
+                      FSSim.removeDirectoryRecursiveE = Stream.empty
+                    }
         ]
 
      ++ [ (1, fmap Some $ DeleteSnapshot <$> genUsedSnapshotName)