Merge pull request #997 from IntersectMBO/mgalazyn/fix/make-tests-run-in-resourcet-io

Make tests run in `PropertyT (ResourceT IO)`

Author: carbolymer

cardano-cli/cardano-cli.cabal

@@ -288,12 +288,14 @@ library cardano-cli-test-lib
     exceptions,
     filepath,
     hedgehog,
-    hedgehog-extras >=0.6.1 && <0.6.5.1,
+    hedgehog-extras >=0.6.1,
     http-types,
     lifted-base,
+    mmorph,
     monad-control,
     network,
     process,
+    resourcet,
     text,
     transformers-base,
     utf8-string,
@@ -322,9 +324,11 @@ test-suite cardano-cli-test
     filepath,
     hedgehog,
     hedgehog-extras,
+    mmorph,
     monad-control,
     parsec,
     regex-tdfa,
+    resourcet,
     tasty,
     tasty-hedgehog,
     text,

cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs

@@ -9,11 +9,11 @@ import           Cardano.CLI.Byron.Tx
 
 import           Control.Monad (void)
 import           Data.ByteString (ByteString)
+import           GHC.Stack
 
 import           Test.Cardano.CLI.Util
 
-import           Hedgehog (Property, (===))
-import qualified Hedgehog as H
+import           Hedgehog (MonadTest, Property, (===))
 import qualified Hedgehog.Extras.Test.Base as H
 import           Hedgehog.Internal.Property (failWith)
 
@@ -67,14 +67,14 @@ hprop_byronTx = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do
 
   compareByronTxs createdTx expectedTx
 
-getTxByteString :: FilePath -> H.PropertyT IO (ATxAux ByteString)
+getTxByteString :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (ATxAux ByteString)
 getTxByteString txFp = do
   eATxAuxBS <- liftIO . runExceptT $ readByronTx $ File txFp
   case eATxAuxBS of
     Left err -> failWith Nothing . docToString $ renderByronTxError err
     Right aTxAuxBS -> return aTxAuxBS
 
-compareByronTxs :: FilePath -> FilePath -> H.PropertyT IO ()
+compareByronTxs :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m ()
 compareByronTxs createdTx expectedTx = do
   createdATxAuxBS <- getTxByteString createdTx
   expectedATxAuxBS <- getTxByteString expectedTx

cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs

@@ -36,7 +36,9 @@ import           Control.Exception.Lifted (bracket_)
 import           Control.Monad (when)
 import           Control.Monad.Base
 import           Control.Monad.Catch hiding (bracket_)
+import           Control.Monad.Morph (hoist)
 import           Control.Monad.Trans.Control (MonadBaseControl)
+import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Aeson.Key as Aeson
@@ -62,7 +64,7 @@ import qualified Hedgehog as H
 import           Hedgehog.Extras (ExecConfig)
 import qualified Hedgehog.Extras as H
 import           Hedgehog.Extras.Test (ExecConfig (..))
-import           Hedgehog.Internal.Property (Diff, MonadTest, PropertyT, liftTest, mkTest)
+import           Hedgehog.Internal.Property (Diff, MonadTest, liftTest, mkTest)
 import qualified Hedgehog.Internal.Property as H
 import           Hedgehog.Internal.Show (ValueDiff (ValueSame), mkValue, showPretty, valueDiff)
 import           Hedgehog.Internal.Source (getCaller)
@@ -161,9 +163,10 @@ execDetailFlex execConfig pkgBin envBin arguments = GHC.withFrozenCallStack $ do
   H.evalIO $ IO.readCreateProcessWithExitCode cp ""
 
 tryExecCardanoCLI
-  :: [String]
+  :: (MonadCatch m, MonadIO m, HasCallStack)
+  => [String]
   -- ^ Arguments to the CLI command
-  -> H.PropertyT IO (Either H.Failure String)
+  -> H.PropertyT m (Either H.Failure String)
   -- ^ Captured stdout, or error in case of failures
 tryExecCardanoCLI args =
   GHC.withFrozenCallStack (H.execFlex "cardano-cli" "CARDANO_CLI") args
@@ -278,8 +281,8 @@ withSnd f a = (a, f a)
 
 -- These were lifted from hedgehog and slightly modified
 
-propertyOnce :: H.PropertyT IO () -> H.Property
-propertyOnce = H.withTests 1 . H.withShrinks 0 . H.property
+propertyOnce :: H.PropertyT (ResourceT IO) () -> H.Property
+propertyOnce = H.withTests 1 . H.withShrinks 0 . H.property . hoist runResourceT
 
 -- | Check for equivalence between two types and perform a file cleanup on failure.
 equivalence
@@ -388,9 +391,10 @@ bracketSem (FileSem path semaphore) act =
     act path
 
 -- | Invert the behavior of a MonadTest: success becomes failure and vice versa.
-expectFailure :: HasCallStack => H.TestT IO m -> PropertyT IO ()
+expectFailure
+  :: (MonadTrans t, MonadTest (t m), MonadCatch (t m), MonadIO m, HasCallStack) => H.TestT m a -> t m ()
 expectFailure prop = GHC.withFrozenCallStack $ do
-  (res, _) <- H.evalIO $ H.runTestT prop
+  (res, _) <- H.evalM . lift $ H.runTestT prop
   case res of
     Left _ -> pure () -- Property failed so we succeed
     _ -> H.failWith Nothing "Expected the test to fail but it passed" -- Property passed but we expected a failure

cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs

@@ -3,6 +3,7 @@
 module Test.Cli.Hash where
 
 import           Control.Monad (void)
+import           Control.Monad.IO.Class
 import           Data.List (intercalate)
 import           GHC.IO.Exception (ExitCode (..))
 import           System.Directory (getCurrentDirectory)
@@ -77,7 +78,7 @@ hprop_generate_anchor_data_hash_from_file_uri =
         ]
     result === exampleAnchorDataHash
  where
-  toPOSIX :: FilePath -> PropertyT IO [Char]
+  toPOSIX :: MonadIO m => FilePath -> PropertyT m [Char]
   toPOSIX path =
     case map dropTrailingPathSeparator (splitDirectories path) of
       letter : restOfPath -> do

cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs

@@ -15,6 +15,7 @@ module Test.Cli.Pipes
 -- Need this to avoid an unused-package error on Windows when compiling with
 -- cabal-3.10 and ghc-9.6.
 import           System.FilePath ()
+import           Control.Monad.Morph ()
 #endif
 
 import qualified Hedgehog as H
@@ -24,11 +25,12 @@ import           System.FilePath ((</>))
 #ifdef UNIX
 import           Cardano.CLI.Read
 import           Cardano.CLI.OS.Posix
+import           Test.Cardano.CLI.Util
 
-
+import           Control.Monad.Morph (hoist)
+import           Control.Monad.Trans.Resource (runResourceT)
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as LBS
-import           Test.Cardano.CLI.Util
 
 import           Hedgehog ((===), forAll)
 import qualified Hedgehog.Gen as G
@@ -38,7 +40,7 @@ import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 
 hprop_readFromPipe :: Property
-hprop_readFromPipe = H.withTests 10 . H.property . H.moduleWorkspace "tmp" $ \ws -> do
+hprop_readFromPipe = H.withTests 10 . H.property . hoist runResourceT . H.moduleWorkspace "tmp" $ \ws -> do
 
   s <- forAll $ G.string (R.linear 1 8192) G.ascii
 

cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs

@@ -3,10 +3,13 @@
 module Test.Cli.Shelley.Run.Hash where
 
 import           Control.Monad (void)
+import           Control.Monad.Catch (MonadCatch)
+import           Control.Monad.Trans.Resource (MonadResource)
+import           GHC.Stack
 
 import           Test.Cardano.CLI.Util
 
-import           Hedgehog (Property)
+import           Hedgehog (MonadTest, Property)
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras as H
 
@@ -21,7 +24,7 @@ hprop_hash_trip =
 -- Test that @cardano-cli hash --text > file1@ and
 -- @cardano-cli --text --out-file file2@ yields
 -- similar @file1@ and @file2@ files.
-hash_trip_fun :: String -> H.PropertyT IO ()
+hash_trip_fun :: (MonadTest m, MonadCatch m, MonadResource m, HasCallStack) => String -> m ()
 hash_trip_fun input =
   H.moduleWorkspace "tmp" $ \tempDir -> do
     hashFile <- noteTempFile tempDir "hash.txt"