Slightly refactored persistence test

hydra-node/test/Hydra/PersistenceSpec.hs

@@ -9,9 +9,9 @@ import Data.Aeson (Value (..))
 import Data.Aeson qualified as Aeson
 import Data.Text qualified as Text
 import Hydra.Persistence (Persistence (..), PersistenceException (..), PersistenceIncremental (..), createPersistence, createPersistenceIncremental)
-import Test.QuickCheck (checkCoverage, counterexample, cover, elements, oneof, suchThat, (===))
+import Test.QuickCheck (checkCoverage, cover, elements, oneof, suchThat, (===))
 import Test.QuickCheck.Gen (listOf)
-import Test.QuickCheck.Monadic (assert, monadicIO, monitor, pick, run)
+import Test.QuickCheck.Monadic (monadicIO, monitor, pick, run)
 
 spec :: Spec
 spec = do
@@ -60,20 +60,17 @@ spec = do
       monadicIO $ do
         items <- pick $ listOf genPersistenceItem
         moreItems <- pick $ listOf genPersistenceItem `suchThat` ((> 2) . length)
-        result :: Either PersistenceException () <- run $ withTempDir "hydra-persistence" $ \tmpDir -> do
-          persistence@PersistenceIncremental{loadAll, append} <- createPersistenceIncremental $ tmpDir <> "/data"
-          forM_ items append
-          loadAll `shouldReturn` items
-          try $ loadAndAppendConcurrently persistence moreItems
-
-        monitor $ counterexample $ show result
-        assert $ isLeft result
-
-loadAndAppendConcurrently :: PersistenceIncremental Value IO -> [Value] -> IO ()
-loadAndAppendConcurrently PersistenceIncremental{loadAll, append} moreItems =
-  race_
-    (forever $ threadDelay 0.01 >> loadAll)
-    (forM_ moreItems $ \item -> append item >> threadDelay 0.01)
+        pure $
+          withTempDir "hydra-persistence" $ \tmpDir -> do
+            PersistenceIncremental{loadAll, append} <- createPersistenceIncremental $ tmpDir <> "/data"
+            forM_ items append
+            loadAll `shouldReturn` items
+            race_
+              (forever $ threadDelay 0.01 >> loadAll)
+              (forM_ moreItems $ \item -> append item >> threadDelay 0.01)
+              `shouldThrow` \case
+                IncorrectAccessException{} -> True
+                _ -> False
 
 genPersistenceItem :: Gen Aeson.Value
 genPersistenceItem =