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 656a36b040..1f1004321c 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 @@ -1,6 +1,7 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -20,6 +21,7 @@ module Test.Cardano.CLI.Util , noteTempFile , redactJsonField , expectFailure + , watchdogProp ) where @@ -55,7 +57,7 @@ import Hedgehog qualified as H import Hedgehog.Extras (ExecConfig) import Hedgehog.Extras qualified as H import Hedgehog.Extras.Test (ExecConfig (..)) -import Hedgehog.Internal.Property (Diff, MonadTest, liftTest, mkTest) +import Hedgehog.Internal.Property (Diff, MonadTest, Property (..), liftTest, mkTest) import Hedgehog.Internal.Property qualified as H import Hedgehog.Internal.Show (ValueDiff (ValueSame), mkValue, showPretty, valueDiff) import Hedgehog.Internal.Source (getCaller) @@ -355,3 +357,8 @@ expectFailure prop = GHC.withFrozenCallStack $ do 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 + +watchdogProp :: HasCallStack => H.Property -> H.Property +watchdogProp prop@Property{propertyTest} = prop{propertyTest = H.runWithWatchdog_ cfg propertyTest} + where + cfg = H.WatchdogConfig{H.watchdogTimeout = 10} diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/AddCostModels.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/AddCostModels.hs index da4af92759..e0c049ed2d 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/AddCostModels.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/AddCostModels.hs @@ -12,11 +12,13 @@ import Cardano.CLI.EraBased.Governance.Actions.Run import Test.Gen.Cardano.Api.ProtocolParameters import Test.Gen.Cardano.Api.Typed +import Test.Cardano.CLI.Util (watchdogProp) + import Hedgehog hprop_roundtrip_Alonzo_addCostModelsToEraBasedProtocolParametersUpdate :: Property hprop_roundtrip_Alonzo_addCostModelsToEraBasedProtocolParametersUpdate = - property $ do + watchdogProp . property $ do ppu <- forAll genAlonzoEraBasedProtocolParametersUpdate cmdl <- forAll genCostModels tripping @@ -30,7 +32,7 @@ hprop_roundtrip_Alonzo_addCostModelsToEraBasedProtocolParametersUpdate = hprop_roundtrip_Babbage_addCostModelsToEraBasedProtocolParametersUpdate :: Property hprop_roundtrip_Babbage_addCostModelsToEraBasedProtocolParametersUpdate = - property $ do + watchdogProp . property $ do ppu <- forAll genBabbageEraBasedProtocolParametersUpdate cmdl <- forAll genCostModels tripping @@ -44,7 +46,7 @@ hprop_roundtrip_Babbage_addCostModelsToEraBasedProtocolParametersUpdate = hprop_roundtrip_Conway_addCostModelsToEraBasedProtocolParametersUpdate :: Property hprop_roundtrip_Conway_addCostModelsToEraBasedProtocolParametersUpdate = - property $ do + watchdogProp . property $ do ppu <- forAll genConwayEraBasedProtocolParametersUpdate cmdl <- forAll genCostModels tripping diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/CheckNodeConfiguration.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/CheckNodeConfiguration.hs index a2a820cfab..d43d8ecfc5 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/CheckNodeConfiguration.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/CheckNodeConfiguration.hs @@ -17,7 +17,7 @@ import Data.Yaml qualified as Yaml import GHC.IO.Exception (ExitCode (..)) import System.FilePath (()) -import Test.Cardano.CLI.Util (execCardanoCLI, execDetailCardanoCLI) +import Test.Cardano.CLI.Util (execCardanoCLI, execDetailCardanoCLI, watchdogProp) import Hedgehog (Property) import Hedgehog qualified as H @@ -31,7 +31,7 @@ nodeConfigFile = "test/cardano-cli-test/files/input/check-node-configuration/nod -- @cabal test cardano-cli-test --test-options '-p "/check node configuration success/"'@ hprop_check_node_configuration_success :: Property hprop_check_node_configuration_success = - propertyOnce $ do + watchdogProp . propertyOnce $ do H.noteM_ $ execCardanoCLI [ "debug" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/CreateCardano.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/CreateCardano.hs index 1ad07f4e5f..7502e69ae0 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/CreateCardano.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/CreateCardano.hs @@ -5,7 +5,7 @@ module Test.Cli.CreateCardano where import Control.Monad (void) import System.FilePath (()) -import Test.Cardano.CLI.Util (execCardanoCLI) +import Test.Cardano.CLI.Util (execCardanoCLI, watchdogProp) import Hedgehog (Property) import Hedgehog.Extras (moduleWorkspace, propertyOnce) @@ -15,7 +15,7 @@ import Hedgehog.Extras qualified as H -- @cabal test cardano-cli-test --test-options '-p "/create cardano/'@ hprop_create_cardano :: Property hprop_create_cardano = - propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do let outputDir = tempDir "out" eras = ["byron", "shelley", "alonzo", "conway"] templates = diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs index 9fbc922b06..9b45ffea21 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs @@ -20,6 +20,7 @@ import Test.Cardano.CLI.Util ( assertDirectoryMissing , execCardanoCLI , execDetailCardanoCLI + , watchdogProp ) import Hedgehog (Property, success, (===)) @@ -31,7 +32,7 @@ import Hedgehog.Extras qualified as H -- @cabal test cardano-cli-test --test-options '-p "/create testnet data minimal/"'@ hprop_create_testnet_data_minimal :: Property hprop_create_testnet_data_minimal = - propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do let outputDir = tempDir "out" -- We test that the command doesn't crash, because otherwise @@ -65,7 +66,7 @@ hprop_create_testnet_data_create_nonegative_supply = do ] :: [(Int, Int, ExitCode)] - propertyOnce $ forM_ supplyValues $ \(totalSupply, delegatedSupply, expectedExitCode) -> + watchdogProp . propertyOnce $ forM_ supplyValues $ \(totalSupply, delegatedSupply, expectedExitCode) -> moduleWorkspace "tmp" $ \tempDir -> do let outputDir = tempDir "out" @@ -128,7 +129,7 @@ data TestGenesis = TestGenesis -- @cabal test cardano-cli-test --test-options '-p "/create testnet data transient stake delegators/'@ hprop_create_testnet_data_transient_stake_delegators :: Property hprop_create_testnet_data_transient_stake_delegators = - propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do let outputDir = tempDir "out" void $ diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/DRepMetadata.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/DRepMetadata.hs index 57f8047b45..2c1654db99 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/DRepMetadata.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/DRepMetadata.hs @@ -15,7 +15,7 @@ import Test.Cardano.CLI.Hash , serveFilesWhile , tamperBase16Hash ) -import Test.Cardano.CLI.Util (execCardanoCLIWithEnvVars, expectFailure, propertyOnce) +import Test.Cardano.CLI.Util (execCardanoCLIWithEnvVars, expectFailure, propertyOnce, watchdogProp) import Hedgehog (Property) import Hedgehog qualified as H @@ -25,7 +25,7 @@ import Hedgehog.Internal.Property (MonadTest) -- @cabal test cardano-cli-test --test-options '-p "/drep metadata hash url wrong hash fails/"'@ hprop_drep_metadata_hash_url_wrong_hash_fails :: Property hprop_drep_metadata_hash_url_wrong_hash_fails = - propertyOnce . expectFailure $ do + watchdogProp . propertyOnce . expectFailure $ do -- We modify the hash slightly so that the hash check fails alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash -- We run the test with the modified hash @@ -35,7 +35,7 @@ hprop_drep_metadata_hash_url_wrong_hash_fails = -- @cabal test cardano-cli-test --test-options '-p "/drep metadata hash url correct hash/"'@ hprop_drep_metadata_hash_url_correct_hash :: Property hprop_drep_metadata_hash_url_correct_hash = - propertyOnce $ baseDrepMetadataHashUrl exampleAnchorDataHash + watchdogProp . propertyOnce $ baseDrepMetadataHashUrl exampleAnchorDataHash baseDrepMetadataHashUrl :: (MonadBaseControl IO m, MonadTest m, MonadIO m, MonadCatch m) diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs index 01c18fe022..0652e5efcc 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs @@ -10,7 +10,7 @@ import Cardano.Api.Internal.IO (checkVrfFilePermissions) import Control.Monad (void) -import Test.Cardano.CLI.Util (execCardanoCLI) +import Test.Cardano.CLI.Util (execCardanoCLI, watchdogProp) import Hedgehog (Property, success) import Hedgehog.Extras.Test.Base qualified as H @@ -19,7 +19,7 @@ import Hedgehog.Internal.Property (failWith) -- | This property ensures that the VRF signing key file is created only with owner permissions hprop_createVRFSigningKeyFilePermissions :: Property hprop_createVRFSigningKeyFilePermissions = - H.propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . H.propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths vrfVerKey <- H.noteTempFile tempDir "VRF-verification-key-file" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Vote.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Vote.hs index f54de280cf..a8aa2f5698 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Vote.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Governance/Vote.hs @@ -20,6 +20,7 @@ import Test.Cardano.CLI.Util , expectFailure , noteInputFile , propertyOnce + , watchdogProp ) import Hedgehog (MonadTest, Property) @@ -30,7 +31,7 @@ import Hedgehog.Extras qualified as H -- @cabal test cardano-cli-test --test-options '-p "/governance vote create wrong hash fails/"'@ hprop_governance_vote_create_wrong_hash_fails :: Property hprop_governance_vote_create_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do -- We modify the hash slightly so that the hash check fails alteredHash <- H.evalMaybe $ tamperBase16Hash exampleAnchorDataHash -- We run the test with the altered @@ -42,7 +43,7 @@ hprop_governance_vote_create_wrong_hash_fails = -- @cabal test cardano-cli-test --test-options '-p "/governance vote create right hash works/"'@ hprop_governance_vote_create_right_hash_works :: Property hprop_governance_vote_create_right_hash_works = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> + watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> baseGovernanceVoteCreateHashCheck exampleAnchorDataHash tempDir baseGovernanceVoteCreateHashCheck 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 7268ee1a12..3e886b87f8 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Hash.hs @@ -25,7 +25,7 @@ import Hedgehog.Extras qualified as H -- @cabal test cardano-cli-test --test-options '-p "/generate anchor data hash from file/"'@ hprop_generate_anchor_data_hash_from_file :: Property hprop_generate_anchor_data_hash_from_file = - propertyOnce $ do + watchdogProp . propertyOnce $ do result <- execCardanoCLI [ "hash" @@ -39,7 +39,7 @@ hprop_generate_anchor_data_hash_from_file = -- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from file/"'@ hprop_check_anchor_data_hash_from_file :: Property hprop_check_anchor_data_hash_from_file = - propertyOnce $ do + watchdogProp . propertyOnce $ do void $ execCardanoCLI [ "hash" @@ -54,7 +54,7 @@ hprop_check_anchor_data_hash_from_file = -- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from file fails/"'@ hprop_check_anchor_data_hash_from_file_fails :: Property hprop_check_anchor_data_hash_from_file_fails = - propertyOnce $ do + watchdogProp . propertyOnce $ do (ec, _, _) <- execDetailCardanoCLI [ "hash" @@ -70,7 +70,7 @@ hprop_check_anchor_data_hash_from_file_fails = -- @cabal test cardano-cli-test --test-options '-p "/generate anchor data hash from file uri/"'@ hprop_generate_anchor_data_hash_from_file_uri :: Property hprop_generate_anchor_data_hash_from_file_uri = - propertyOnce $ do + watchdogProp . propertyOnce $ do cwd <- H.evalIO getCurrentDirectory posixCwd <- toPOSIX cwd result <- @@ -101,7 +101,7 @@ hprop_generate_anchor_data_hash_from_file_uri = -- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from http uri/"'@ hprop_check_anchor_data_hash_from_http_uri :: Property hprop_check_anchor_data_hash_from_http_uri = - propertyOnce $ do + watchdogProp . propertyOnce $ do let relativeUrl = ["example", "url", "file.txt"] -- Create temporary HTTP server with files required by the call to `cardano-cli` @@ -123,7 +123,7 @@ hprop_check_anchor_data_hash_from_http_uri = -- @cabal test cardano-cli-test --test-options '-p "/check anchor data hash from ipfs uri/"'@ hprop_check_anchor_data_hash_from_ipfs_uri :: Property hprop_check_anchor_data_hash_from_ipfs_uri = - propertyOnce $ do + watchdogProp . propertyOnce $ do let relativeUrl = ["ipfs", exampleAnchorDataIpfsHash] -- Create temporary HTTP server with files required by the call to `cardano-cli` diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs index 16e8639102..03b9c97505 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/ITN.hs @@ -37,7 +37,7 @@ itnSignKey = "ed25519_sk1yhnetcmla9pskrvp5z5ff2v8gkenhmluy736jd6nrxrlxcgn70zsy94 -- | 1. Convert a bech32 ITN key pair to a haskell stake verification key and signing key -- 2. Derive the haskell verification key from the haskell signing key. hprop_convertITNKeys :: Property -hprop_convertITNKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_convertITNKeys = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- ITN input file paths itnVerKeyFp <- noteTempFile tempDir "itnVerKey.key" itnSignKeyFp <- noteTempFile tempDir "itnSignKey.key" @@ -79,7 +79,7 @@ hprop_convertITNKeys = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- | 1. Convert a bech32 ITN extended signing key to a haskell stake signing key hprop_convertITNExtendedSigningKey :: Property -hprop_convertITNExtendedSigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_convertITNExtendedSigningKey = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do let itnExtendedSignKey = mconcat [ "ed25519e_sk1qpcplz38tg4fusw0fkqljzspe9qmj06ldu9lgcve99v4fphuk9a535kwj" @@ -113,7 +113,7 @@ hprop_convertITNExtendedSigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \t -- | 1. Convert a bech32 ITN BIP32 signing key to a haskell stake signing key hprop_convertITNBIP32SigningKey :: Property -hprop_convertITNBIP32SigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_convertITNBIP32SigningKey = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do let itnExtendedSignKey = mconcat [ "xprv1spkw5suj39723c40mr55gwh7j3vryjv2zdm4e47xs0deka" @@ -150,7 +150,7 @@ hprop_convertITNBIP32SigningKey = propertyOnce . H.moduleWorkspace "tmp" $ \temp -- | We check our 'decodeBech32' outputs against https://slowli.github.io/bech32-buffer/ -- using 'itnVerKey' & 'itnSignKey' as inputs. hprop_golden_bech32Decode :: Property -hprop_golden_bech32Decode = propertyOnce $ do +hprop_golden_bech32Decode = watchdogProp . propertyOnce $ do (vHumReadPart, vDataPart, _) <- H.evalEither $ decodeBech32 itnVerKey Just vDataPartBase16 <- pure (dataPartToBase16 vDataPart) diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Json.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Json.hs index 9d34022e9a..2411e52f73 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Json.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Json.hs @@ -24,6 +24,8 @@ import Test.Gen.Cardano.Api.Typed , genVerificationKeyHash ) +import Test.Cardano.CLI.Util (watchdogProp) + import Hedgehog (Gen, Property, forAll, property, tripping) import Hedgehog.Gen as Gen import Hedgehog.Range as Range @@ -31,7 +33,7 @@ import Hedgehog.Range as Range -- TODO: Move to cardano-api hprop_json_roundtrip_delegations_and_rewards :: Property hprop_json_roundtrip_delegations_and_rewards = - property $ do + watchdogProp . property $ do dAndG <- forAll genDelegationsAndRewards tripping dAndG encode eitherDecode @@ -74,6 +76,6 @@ genKesPeriodInfoOutput = <*> genWord64 hprop_roundtrip_kes_period_info_output_JSON :: Property -hprop_roundtrip_kes_period_info_output_JSON = property $ do +hprop_roundtrip_kes_period_info_output_JSON = watchdogProp . property $ do kesPeriodOutput <- forAll genKesPeriodInfoOutput tripping kesPeriodOutput encode eitherDecode diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/MonadWarning.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/MonadWarning.hs index f5a0f1c25c..aa41021daf 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/MonadWarning.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/MonadWarning.hs @@ -8,10 +8,12 @@ import Cardano.CLI.Type.MonadWarning (MonadWarning, reportIssue, runWarningState import Control.Monad (when) import Control.Monad.Trans.State (State, runState) +import Test.Cardano.CLI.Util (watchdogProp) + import Hedgehog (Property, property, (===)) hprop_monad_warning :: Property -hprop_monad_warning = property $ do +hprop_monad_warning = watchdogProp . property $ do (-8, [warning]) === duplicateNumber (-4) (4, []) === duplicateNumber 2 where diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs index 7328fb8552..b4e96c71ff 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs @@ -20,6 +20,8 @@ import Data.Either (isLeft, isRight) import Data.Word (Word16) import Text.Parsec qualified as Parsec +import Test.Cardano.CLI.Util (watchdogProp) + import Hedgehog (Gen, Property, assert, property, (===)) import Hedgehog.Extras (assertWith, propertyOnce) import Hedgehog.Gen qualified as Gen @@ -30,7 +32,7 @@ import Hedgehog.Range qualified as Range -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/integral reader/"'@ hprop_integral_reader :: Property -hprop_integral_reader = property $ do +hprop_integral_reader = watchdogProp . property $ do parse @Word "0" === Right 0 parse @Word "42" === Right 42 assertWith (parse @Word "-1") isLeft @@ -56,7 +58,7 @@ hprop_integral_reader = property $ do -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/integral pair reader positive/"'@ hprop_integral_pair_reader_positive :: Property -hprop_integral_pair_reader_positive = property $ do +hprop_integral_pair_reader_positive = watchdogProp . property $ do validArbitraryTuple <- forAll $ genNumberTuple (Proxy :: Proxy Word) assert $ isRight $ parse @Word validArbitraryTuple where @@ -83,7 +85,7 @@ genArbitrarySpace = Gen.string (Range.linear 0 5) (return ' ') -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/integral pair reader negative/"'@ hprop_integral_pair_reader_negative :: Property -hprop_integral_pair_reader_negative = propertyOnce $ do +hprop_integral_pair_reader_negative = watchdogProp . propertyOnce $ do assertWith (parse @Word "(0, 0, 0)") isLeft assertWith (parse @Word "(-1, 0)") isLeft assertWith (parse @Word "(18446744073709551616, 0)") isLeft diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs index 7af33448db..50b510c98a 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise1.hs @@ -18,7 +18,7 @@ import Hedgehog.Extras.Test.File qualified as H -- 2. Check for the existence of the key pair -- 3. We use the generated verification key to build a shelley payment address. hprop_buildShelleyPaymentAddress :: Property -hprop_buildShelleyPaymentAddress = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_buildShelleyPaymentAddress = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths verKey <- noteTempFile tempDir "payment-verification-key-file" signKey <- noteTempFile tempDir "payment-signing-key-file" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs index 92b43fe60a..3e73364012 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise2.hs @@ -17,7 +17,7 @@ import Hedgehog.Extras.Test.File qualified as H -- 2. We create a tx body -- 3. We sign the tx body with the generated payment signing key hprop_createTransaction :: Property -hprop_createTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_createTransaction = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs index 04439337f1..123ed703cf 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise3.hs @@ -18,7 +18,7 @@ import Hedgehog.Extras.Test.File qualified as H -- 3. Create operational certificate. -- 4. Create VRF key pair. hprop_createOperationalCertificate :: Property -hprop_createOperationalCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_createOperationalCertificate = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths kesVerKey <- noteTempFile tempDir "KES-verification-key-file" kesSignKey <- noteTempFile tempDir "KES-signing-key-file" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs index 5d9efd77b5..a6ca51d886 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise4.hs @@ -16,7 +16,7 @@ import Hedgehog.Extras.Test.File qualified as H -- | 1. Generate a stake verification key -- 2. Create a stake address registration certificate hprop_createStakeAddressRegistrationCertificate :: Property -hprop_createStakeAddressRegistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_createStakeAddressRegistrationCertificate = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths verKey <- noteTempFile tempDir "stake-verification-key-file" signKey <- noteTempFile tempDir "stake-signing-key-file" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs index 415b6640fb..f551d595ef 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise5.hs @@ -17,7 +17,7 @@ import Hedgehog.Extras.Test.File qualified as H -- 2. We create a tx body -- 3. We sign the tx body with the generated payment signing key hprop_createLegacyZeroTxOutTransaction :: Property -hprop_createLegacyZeroTxOutTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_createLegacyZeroTxOutTransaction = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs index 3d1d2c8a8f..dc6a716e55 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pioneers/Exercise6.hs @@ -17,7 +17,7 @@ import Hedgehog.Extras.Test.File qualified as H -- 2. We create a tx body -- 3. We sign the tx body with the generated payment signing key hprop_createZeroLovelaceTxOutTransaction :: Property -hprop_createZeroLovelaceTxOutTransaction = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_createZeroLovelaceTxOutTransaction = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do -- Key filepaths paymentVerKey <- noteTempFile tempDir "payment-verification-key-file" paymentSignKey <- noteTempFile tempDir "payment-signing-key-file" 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 0fd5884c5b..091560e11a 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Pipes.hs @@ -40,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 . hoist runResourceT . H.moduleWorkspace "tmp" $ \ws -> do +hprop_readFromPipe = watchdogProp . 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/Certificates/StakePool.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Certificates/StakePool.hs index e2bafee4bd..bc284e66bc 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Certificates/StakePool.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Certificates/StakePool.hs @@ -21,6 +21,7 @@ import Test.Cardano.CLI.Util , expectFailure , noteTempFile , propertyOnce + , watchdogProp ) import Hedgehog (MonadTest) @@ -41,7 +42,7 @@ exampleStakePoolMetadataIpfsHash = "QmR1HAT4Hb4HjjqcgoXwupYXMF6t8h7MoSP24HMfV8t3 -- @cabal test cardano-cli-test --test-options '-p "/stake pool certificate hash check wrong metadata fails/"'@ hprop_stake_pool_certificate_hash_check_wrong_metadata_fails :: Property hprop_stake_pool_certificate_hash_check_wrong_metadata_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do -- We run the test with the wrong metadata file baseStakePoolCertificateHashCheck exampleAnchorDataIpfsHash @@ -53,7 +54,7 @@ hprop_stake_pool_certificate_hash_check_wrong_metadata_fails = -- @cabal test cardano-cli-test --test-options '-p "/stake pool certificate hash check wrong hash fails/"'@ hprop_stake_pool_certificate_hash_check_wrong_hash_fails :: Property hprop_stake_pool_certificate_hash_check_wrong_hash_fails = - propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do + watchdogProp . propertyOnce . expectFailure . H.moduleWorkspace "tmp" $ \tempDir -> do -- We modify the hash slightly so that the hash check fails alteredHash <- H.evalMaybe $ tamperBase16Hash exampleStakePoolMetadataHash -- We run the test with the modified hash @@ -67,7 +68,7 @@ hprop_stake_pool_certificate_hash_check_wrong_hash_fails = -- @cabal test cardano-cli-test --test-options '-p "/stake pool certificate hash check right hash works/"'@ hprop_stake_pool_certificate_hash_check_right_hash_works :: Property hprop_stake_pool_certificate_hash_check_right_hash_works = - propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> + watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> baseStakePoolCertificateHashCheck exampleStakePoolMetadataIpfsHash exampleStakePoolMetadataPathTest @@ -186,7 +187,7 @@ baseStakePoolCertificateHashCheck ipfsHash metadataFile hash tempDir = do -- @cabal test cardano-cli-test --test-options '-p "/stake pool metadata hash url wrong metadata fails/"'@ hprop_stake_pool_metadata_hash_url_wrong_metadata_fails :: Property hprop_stake_pool_metadata_hash_url_wrong_metadata_fails = - propertyOnce . expectFailure $ do + watchdogProp . propertyOnce . expectFailure $ do -- We run the test with the wrong metadata file baseStakePoolMetadataHashUrl exampleAnchorDataIpfsHash @@ -197,7 +198,7 @@ hprop_stake_pool_metadata_hash_url_wrong_metadata_fails = -- @cabal test cardano-cli-test --test-options '-p "/stake pool metadata hash url wrong hash fails/"'@ hprop_stake_pool_metadata_hash_url_wrong_hash_fails :: Property hprop_stake_pool_metadata_hash_url_wrong_hash_fails = - propertyOnce . expectFailure $ do + watchdogProp . propertyOnce . expectFailure $ do -- We modify the hash slightly so that the hash check fails alteredHash <- H.evalMaybe $ tamperBase16Hash exampleStakePoolMetadataHash -- We run the test with the modified hash @@ -210,7 +211,7 @@ hprop_stake_pool_metadata_hash_url_wrong_hash_fails = -- @cabal test cardano-cli-test --test-options '-p "/stake pool metadata hash url correct hash/"'@ hprop_stake_pool_metadata_hash_url_correct_hash :: Property hprop_stake_pool_metadata_hash_url_correct_hash = - propertyOnce $ + watchdogProp . propertyOnce $ baseStakePoolMetadataHashUrl exampleStakePoolMetadataIpfsHash exampleStakePoolMetadataPathTest 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 d357b5947d..0f32c4aad7 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 @@ -15,7 +15,7 @@ import Hedgehog.Extras qualified as H hprop_hash_trip :: Property hprop_hash_trip = - propertyOnce $ do + watchdogProp . propertyOnce $ do hash_trip_fun "foo" hash_trip_fun "longerText" hash_trip_fun "nonAscii: 你好" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs index 02159fb95f..078d22a02d 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Run/Query.hs @@ -6,11 +6,13 @@ where import Cardano.CLI.EraBased.Query.Run qualified as Q import Cardano.Slotting.Time (RelativeTime (..)) +import Test.Cardano.CLI.Util (watchdogProp) + import Hedgehog (Property, (===)) import Hedgehog.Extras.Test.Base qualified as H hprop_percentage :: Property -hprop_percentage = H.propertyOnce $ do +hprop_percentage = watchdogProp . H.propertyOnce $ do Q.percentage (RelativeTime 10) (RelativeTime 1000) (RelativeTime 1000) === "100.00" Q.percentage (RelativeTime 10) (RelativeTime 990) (RelativeTime 1000) === "100.00" Q.percentage (RelativeTime 10) (RelativeTime 980) (RelativeTime 1000) === "99.00" diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs index 6a88eae1f0..dfedbc24fd 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Build.hs @@ -17,7 +17,7 @@ inputDir = "test/cardano-cli-test/files/input/shelley/transaction" -- Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/conway transaction build one voter many votes/"'@ hprop_conway_transaction_build_one_voter_many_votes :: Property -hprop_conway_transaction_build_one_voter_many_votes = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_conway_transaction_build_one_voter_many_votes = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do outFile <- H.noteTempFile tempDir "tx.traw" (exitCode, _stdout, stderr) <- @@ -49,7 +49,7 @@ hprop_conway_transaction_build_one_voter_many_votes = propertyOnce $ H.moduleWor -- Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/conway transaction build raw negative txout/"'@ hprop_conway_transaction_build_raw_negative_txout :: Property -hprop_conway_transaction_build_raw_negative_txout = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_conway_transaction_build_raw_negative_txout = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do outFile <- H.noteTempFile tempDir "tx.traw" (exitCode, _stdout, stderr) <- @@ -75,7 +75,7 @@ hprop_conway_transaction_build_raw_negative_txout = propertyOnce $ H.moduleWorks -- the grand total is positive. -- @cabal test cardano-cli-test --test-options '-p "/conway transaction build raw negative bits positive total txout/"'@ hprop_conway_transaction_build_raw_negative_bits_positive_total_txout :: Property -hprop_conway_transaction_build_raw_negative_bits_positive_total_txout = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_conway_transaction_build_raw_negative_bits_positive_total_txout = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do outFile <- H.noteTempFile tempDir "tx.traw" -- This checks that the command succeeds diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs index 4fddb72f60..e942c02eed 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs @@ -24,7 +24,7 @@ inputDir = "test/cardano-cli-test/files/input/shelley/transaction" -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/conway transaction build one voter many votes/"'@ hprop_compatible_conway_transaction_build_one_voter_many_votes :: Property -hprop_compatible_conway_transaction_build_one_voter_many_votes = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do +hprop_compatible_conway_transaction_build_one_voter_many_votes = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do refOutFile <- H.noteTempFile tempDir "reference_tx.traw" outFile <- H.noteTempFile tempDir "tx.traw" let eraName = map toLower . docToString $ pretty ConwayEra diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/VerificationKey.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/VerificationKey.hs index 9244d8b4c6..d657ce545f 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/VerificationKey.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/VerificationKey.hs @@ -17,19 +17,19 @@ import Hedgehog.Extras.Test.Base qualified as H -- @cabal test cardano-cli-test --test-options '-p "/verification key drep/"'@ hprop_verification_key_drep :: Property hprop_verification_key_drep = - propertyOnce . H.moduleWorkspace "tmp" $ runOne ["drep", "key-gen"] + watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ runOne ["drep", "key-gen"] -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/verification key committee hot/"'@ hprop_verification_key_committee_hot :: Property hprop_verification_key_committee_hot = - propertyOnce . H.moduleWorkspace "tmp" $ runOne ["committee", "key-gen-hot"] + watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ runOne ["committee", "key-gen-hot"] -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/verification key committee cold/"'@ hprop_verification_key_committee_cold :: Property hprop_verification_key_committee_cold = - propertyOnce . H.moduleWorkspace "tmp" $ runOne ["committee", "key-gen-cold"] + watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ runOne ["committee", "key-gen-cold"] runOne :: ()