From 9f0068b1f637c246fa061dfaf6f820bd2f8b6417 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 24 Dec 2024 11:30:52 +0100 Subject: [PATCH] Make tests run in Property (ResourceT IO) --- cardano-cli/cardano-cli.cabal | 4 ++++ .../cardano-cli-golden/Test/Golden/Byron/Tx.hs | 8 ++++---- .../Test/Cardano/CLI/Util.hs | 18 +++++++++++------- .../test/cardano-cli-test/Test/Cli/Hash.hs | 3 ++- .../test/cardano-cli-test/Test/Cli/Pipes.hs | 8 +++++--- .../Test/Cli/Shelley/Run/Hash.hs | 7 +++++-- 6 files changed, 31 insertions(+), 17 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index a1be050e77..ec2ffc0d79 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -291,9 +291,11 @@ library cardano-cli-test-lib hedgehog-extras ^>=0.6.1.0, 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 ^>=0.6.1.0, + mmorph, monad-control, parsec, regex-tdfa, + resourcet, tasty, tasty-hedgehog, text, diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs index 489af73f52..19ae5135df 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Byron/Tx.hs +++ b/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 diff --git a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs index a116987292..625e200e54 100644 --- a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs +++ b/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 diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs index fd94022699..370f5e07fd 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs +++ b/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 diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs index 718451ac07..0fd5884c5b 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs +++ b/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 diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs index 529ea9519e..7d733ba9a2 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Hash.hs +++ b/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"