From 43c06714a811f2a5ba9413f97ba2ea48aa48e429 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 27 May 2024 15:05:48 +0200 Subject: [PATCH] Use hedgehog-extras TestWatchdog --- bench/locli/locli.cabal | 2 +- .../cardano-node-chairman.cabal | 2 +- cardano-testnet/cardano-testnet.cabal | 5 +- .../src/Testnet/Components/Query.hs | 3 +- .../src/Testnet/Components/TestWatchdog.hs | 137 ------------------ cardano-testnet/src/Testnet/Property/Util.hs | 17 --- cardano-testnet/src/Testnet/Runtime.hs | 4 +- .../Test/Cli/Babbage/LeadershipSchedule.hs | 4 +- .../Testnet/Test/Cli/Babbage/StakeSnapshot.hs | 4 +- .../Testnet/Test/Cli/Babbage/Transaction.hs | 4 +- .../Cardano/Testnet/Test/Cli/Conway/Plutus.hs | 3 +- .../Testnet/Test/Cli/Conway/StakeSnapshot.hs | 4 +- .../Cardano/Testnet/Test/Cli/KesPeriodInfo.hs | 4 +- .../Cardano/Testnet/Test/Cli/Query.hs | 3 +- .../Testnet/Test/Cli/QuerySlotNumber.hs | 4 +- .../Cardano/Testnet/Test/FoldEpochState.hs | 3 +- .../Testnet/Test/Gov/CommitteeAddNew.hs | 3 +- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 7 +- .../Cardano/Testnet/Test/Gov/DRepDeposit.hs | 3 +- .../Testnet/Test/Gov/DRepRetirement.hs | 3 +- .../Cardano/Testnet/Test/Gov/InfoAction.hs | 3 +- .../Cardano/Testnet/Test/Gov/NoConfidence.hs | 3 +- .../Testnet/Test/Gov/PredefinedAbstainDRep.hs | 3 +- .../Test/Gov/ProposeNewConstitution.hs | 3 +- .../Test/Gov/ProposeNewConstitutionSPO.hs | 3 +- .../Testnet/Test/Gov/TreasuryGrowth.hs | 3 +- .../Testnet/Test/Gov/TreasuryWithdrawal.hs | 3 +- .../Cardano/Testnet/Test/Node/Shutdown.hs | 8 +- .../Cardano/Testnet/Test/SanityCheck.hs | 3 +- .../Test/SubmitApi/Babbage/Transaction.hs | 4 +- 30 files changed, 42 insertions(+), 213 deletions(-) delete mode 100644 cardano-testnet/src/Testnet/Components/TestWatchdog.hs diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index eb5aac02216..20b3f4ad2cc 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -175,7 +175,7 @@ test-suite test-locli build-depends: cardano-prelude , containers , hedgehog - , hedgehog-extras < 0.6.2 + , hedgehog-extras ^>= 0.6.4 , locli , text diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 8591d65eb32..89b9f4c488c 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -72,7 +72,7 @@ test-suite chairman-tests , cardano-crypto-class ^>= 2.1.2 , filepath , hedgehog - , hedgehog-extras < 0.6.2 + , hedgehog-extras ^>= 0.6.4 , network , process , random diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 2d9ab117aa9..c4c2a506345 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -61,7 +61,7 @@ library , exceptions , filepath , hedgehog - , hedgehog-extras < 0.6.2 + , hedgehog-extras ^>= 0.6.4 , lens-aeson , microlens , mtl @@ -92,7 +92,6 @@ library Parsers.Run Testnet.Components.Configuration Testnet.Components.Query - Testnet.Components.TestWatchdog Testnet.Defaults Testnet.EpochStateProcessing Testnet.Filepath @@ -226,7 +225,7 @@ test-suite cardano-testnet-test , exceptions , filepath , hedgehog - , hedgehog-extras + , hedgehog-extras , http-conduit , lens-aeson , microlens diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index a15cad08234..1a054a70544 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -70,7 +70,6 @@ import GHC.Stack import Lens.Micro (Lens', to, (^.)) import Testnet.Property.Assert -import Testnet.Property.Util (runInBackground) import Testnet.Types import qualified Hedgehog as H @@ -254,7 +253,7 @@ getEpochStateView -> m EpochStateView getEpochStateView nodeConfigFile socketPath = withFrozenCallStack $ do epochStateView <- H.evalIO $ newIORef Nothing - runInBackground . runExceptT . foldEpochState nodeConfigFile socketPath QuickValidation (EpochNo maxBound) Nothing + H.asyncRegister_ . runExceptT . foldEpochState nodeConfigFile socketPath QuickValidation (EpochNo maxBound) Nothing $ \epochState slotNumber blockNumber -> do liftIO . writeIORef epochStateView $ Just (epochState, slotNumber, blockNumber) pure ConditionNotMet diff --git a/cardano-testnet/src/Testnet/Components/TestWatchdog.hs b/cardano-testnet/src/Testnet/Components/TestWatchdog.hs deleted file mode 100644 index ead77119cd0..00000000000 --- a/cardano-testnet/src/Testnet/Components/TestWatchdog.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} - --- | This module provides a test watchdog - an utility monitoring test cases and killing them if they don't --- finish in time. To wrap an 'H.Integration' test case in a watchdog just use --- @ --- runWithWatchdog watchdogConfig $ \watchdog -> do --- -- body of your test case --- @ -module Testnet.Components.TestWatchdog - ( runWithWatchdog_ - , runWithWatchdog - , runWithDefaultWatchdog_ - , runWithDefaultWatchdog - , Watchdog - , kickWatchdog - , poisonWatchdog - ) where - -import Control.Concurrent (myThreadId, threadDelay, throwTo) -import Control.Concurrent.STM (atomically) -import Control.Concurrent.STM.TChan (TChan, newTChanIO, tryReadTChan, writeTChan) -import Control.Exception.Safe (Exception) -import Control.Monad.IO.Class -import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime, - nominalDiffTimeToSeconds) -import GHC.Conc (ThreadId) -import GHC.Stack - -import qualified Hedgehog.Extras as H - --- | Configuration for the watchdog. -newtype WatchdogConfig = WatchdogConfig - { watchdogTimeout :: Int -- ^ Timeout in seconds after which watchdog will kill the test case - } - --- | Default watchdog config with 10 minutes timeout. -defaultWatchdogConfig :: WatchdogConfig -defaultWatchdogConfig = WatchdogConfig - { watchdogTimeout = 600 - } - --- | A watchdog -data Watchdog = Watchdog - { watchdogConfig :: !WatchdogConfig - , watchedThreadId :: !ThreadId -- ^ monitored thread id - , startTime :: !UTCTime -- ^ watchdog creation time - , kickChan :: TChan WatchdogCommand -- ^ a queue of watchdog commands - } - --- | Create a new watchdog -makeWatchdog :: MonadIO m - => WatchdogConfig - -> ThreadId -- ^ thread id which will get killed after timeouts expire - -> m Watchdog -makeWatchdog config watchedThreadId' = liftIO $ do - watchdog <- Watchdog config watchedThreadId' <$> getCurrentTime <*> newTChanIO - kickWatchdog watchdog - pure watchdog - --- | Run watchdog in a loop -runWatchdog :: MonadIO m - => Watchdog - -> m () -runWatchdog w@Watchdog{watchedThreadId, startTime, kickChan} = liftIO $ do - atomically (tryReadTChan kickChan) >>= \case - Just PoisonPill -> - -- deactivate watchdog - pure () - Just (Kick timeout) -> do - -- got a kick, wait for another period - threadDelay $ timeout * 1_000_000 - runWatchdog w - Nothing -> do - -- we are out of scheduled timeouts, kill the monitored thread - currentTime <- getCurrentTime - throwTo watchedThreadId . WatchdogException $ diffUTCTime currentTime startTime - --- | Watchdog command -data WatchdogCommand - = Kick !Int -- ^ Add another delay in seconds - | PoisonPill -- ^ Stop the watchdog - --- | Enqueue a kick for the watchdog. It will extend the timeout by another one defined in the watchdog --- configuration. -kickWatchdog :: MonadIO m => Watchdog -> m () -kickWatchdog Watchdog{watchdogConfig=WatchdogConfig{watchdogTimeout}, kickChan} = liftIO $ - atomically $ writeTChan kickChan (Kick watchdogTimeout) - --- | Enqueue a poison pill for the watchdog. It will stop the watchdog after all timeouts. -poisonWatchdog :: MonadIO m => Watchdog -> m () -poisonWatchdog Watchdog{kickChan} = liftIO $ - atomically $ writeTChan kickChan PoisonPill - - --- | Execute a test case with a watchdog. -runWithWatchdog :: HasCallStack - => WatchdogConfig -- ^ configuration - -> (HasCallStack => Watchdog -> H.Integration a) -- ^ a test case to be wrapped in watchdog - -> H.Integration a -runWithWatchdog config testCase = do - watchedThreadId <- liftIO myThreadId - watchdog <- makeWatchdog config watchedThreadId - H.withAsync (runWatchdog watchdog) $ - \_ -> testCase watchdog - --- | Execuate a test case with a watchdog. -runWithWatchdog_ :: HasCallStack - => WatchdogConfig -- ^ configuration - -> (HasCallStack => H.Integration a) -- ^ a test case to be wrapped in watchdog - -> H.Integration a -runWithWatchdog_ config testCase = runWithWatchdog config (const testCase) - --- | Execute a test case with watchdog with default config. -runWithDefaultWatchdog :: HasCallStack - => (HasCallStack => Watchdog -> H.Integration a) -- ^ a test case to be wrapped in watchdog - -> H.Integration a -runWithDefaultWatchdog = runWithWatchdog defaultWatchdogConfig - --- | Execute a test case with watchdog with default config. -runWithDefaultWatchdog_ :: HasCallStack - => (HasCallStack => H.Integration a) -- ^ a test case to be wrapped in watchdog - -> H.Integration a -runWithDefaultWatchdog_ testCase = runWithDefaultWatchdog (const testCase) - --- | An exception thrown to the test case thread. -newtype WatchdogException = WatchdogException { timeElapsed :: NominalDiffTime } - -instance Show WatchdogException where - show WatchdogException{timeElapsed} = - "WatchdogException: Test watchdog killed test case thread after " <> show @Int (round $ nominalDiffTimeToSeconds timeElapsed) <> " seconds." - -instance Exception WatchdogException diff --git a/cardano-testnet/src/Testnet/Property/Util.hs b/cardano-testnet/src/Testnet/Property/Util.hs index 4a64d79ffbd..0a707b7080c 100644 --- a/cardano-testnet/src/Testnet/Property/Util.hs +++ b/cardano-testnet/src/Testnet/Property/Util.hs @@ -8,16 +8,12 @@ module Testnet.Property.Util , integrationRetryWorkspace , integrationWorkspace , isLinux - , runInBackground , decodeEraUTxO ) where import Cardano.Api -import Control.Exception.Safe (MonadCatch) -import Control.Monad -import Control.Monad.Trans.Resource import qualified Data.Aeson as Aeson import GHC.Stack import qualified System.Environment as IO @@ -60,19 +56,6 @@ integrationWorkspace workspaceName f = withFrozenCallStack $ isLinux :: Bool isLinux = os == "linux" - --- | Runs an action in background, and registers cleanup to `MonadResource m` --- The argument forces IO monad to prevent leaking of `MonadResource` to the child thread -runInBackground :: MonadTest m - => MonadResource m - => MonadCatch m - => IO a - -> m () -runInBackground act = void . H.evalM $ allocate (H.async act) cleanUp - where - cleanUp :: H.Async a -> IO () - cleanUp a = H.cancel a >> void (H.link a) - decodeEraUTxO :: (IsShelleyBasedEra era, MonadTest m) => ShelleyBasedEra era -> Aeson.Value -> m (UTxO era) decodeEraUTxO _ = H.jsonErrorFail . Aeson.fromJSON diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index 903f1bd2567..dfd68127ac4 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -33,7 +33,6 @@ import qualified System.Process as IO import Testnet.Filepath import qualified Testnet.Ping as Ping import Testnet.Process.Run -import Testnet.Property.Util (runInBackground) import Testnet.Types hiding (testnetMagic) import Hedgehog (MonadTest) @@ -41,6 +40,7 @@ import qualified Hedgehog as H import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..)) import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.Concurrent as H data NodeStartFailure = ProcessRelatedFailure ProcessError @@ -197,7 +197,7 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac False -> do H.evalIO $ appendFile logFile "" socketPath <- H.noteM $ H.sprocketSystemName <$> H.headM (poolSprockets testnetRuntime) - _ <- runInBackground . runExceptT $ + _ <- H.asyncRegister_ . runExceptT $ foldEpochState (configurationFile testnetRuntime) (Api.File socketPath) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs index d56d3b78bb0..9c7aeacb834 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs @@ -36,7 +36,6 @@ import System.FilePath (()) import qualified System.Info as SYS import Testnet.Components.Configuration -import Testnet.Components.TestWatchdog import Testnet.Process.Cli.Keys import Testnet.Process.Cli.SPO import Testnet.Process.Run (execCli, execCli', mkExecConfig) @@ -50,11 +49,12 @@ import qualified Hedgehog as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/leadership-schedule/"'@ hprop_leadershipSchedule :: Property -hprop_leadershipSchedule = integrationRetryWorkspace 2 "babbage-leadership-schedule" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_leadershipSchedule = integrationRetryWorkspace 2 "babbage-leadership-schedule" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs index 67fe4933181..aa42acbd0a9 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/StakeSnapshot.hs @@ -19,7 +19,6 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM import qualified System.Info as SYS -import Testnet.Components.TestWatchdog import Testnet.Process.Run (execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Types @@ -28,9 +27,10 @@ import Hedgehog (Property, (===)) import qualified Hedgehog as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H hprop_stakeSnapshot :: Property -hprop_stakeSnapshot = integrationRetryWorkspace 2 "babbage-stake-snapshot" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_stakeSnapshot = integrationRetryWorkspace 2 "babbage-stake-snapshot" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs index 658d8c9d51a..24a14742897 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs @@ -28,7 +28,6 @@ import Lens.Micro import System.FilePath (()) import qualified System.Info as SYS -import Testnet.Components.TestWatchdog import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (decodeEraUTxO, integrationRetryWorkspace) import Testnet.Types @@ -37,9 +36,10 @@ import Hedgehog (Property) import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H hprop_transaction :: Property -hprop_transaction = integrationRetryWorkspace 0 "babbage-transaction" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_transaction = integrationRetryWorkspace 0 "babbage-transaction" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index 92e6516f7f5..3b9aab62f59 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -23,7 +23,6 @@ import qualified System.Info as SYS import Testnet.Components.Configuration import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Cli.SPO import Testnet.Process.Run (execCli', mkExecConfig) @@ -43,7 +42,7 @@ import qualified Hedgehog.Extras as H -- Voting NO -- Proposing NO hprop_plutus_v3 :: Property -hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs index f4071bd56a2..e482ecd39a2 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/StakeSnapshot.hs @@ -18,7 +18,6 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM import qualified System.Info as SYS -import Testnet.Components.TestWatchdog import Testnet.Process.Run (execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Types @@ -27,9 +26,10 @@ import Hedgehog (Property, (===)) import qualified Hedgehog as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H hprop_stakeSnapshot :: Property -hprop_stakeSnapshot = integrationRetryWorkspace 2 "conway-stake-snapshot" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_stakeSnapshot = integrationRetryWorkspace 2 "conway-stake-snapshot" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs index 83ad058a5e8..ed6eecf7474 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/KesPeriodInfo.hs @@ -31,7 +31,6 @@ import System.FilePath (()) import qualified System.Info as SYS import Testnet.Components.Configuration -import Testnet.Components.TestWatchdog import Testnet.Process.Cli.Keys import Testnet.Process.Cli.SPO import Testnet.Process.Run (execCli, execCli', mkExecConfig) @@ -46,9 +45,10 @@ import Hedgehog.Extras.Stock (sprocketSystemName) import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H hprop_kes_period_info :: Property -hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } -- TODO: Move yaml filepath specification into individual node options diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 2960ec50a7f..32ebe1d9108 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -27,7 +27,6 @@ import System.FilePath (()) import Testnet.Components.Configuration (eraToString) import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Types @@ -43,7 +42,7 @@ import qualified Hedgehog.Extras.Test.Golden as H -- If you want to recreate golden files, run the comment with -- RECREATE_GOLDEN_FILES=1 as its prefix hprop_cli_queries :: Property -hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs index 4b58bd2d07b..db8c3650182 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/QuerySlotNumber.hs @@ -25,7 +25,6 @@ import qualified Data.Time.Clock as DT import qualified Data.Time.Format as DT import qualified System.Info as SYS -import Testnet.Components.TestWatchdog import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Types @@ -33,11 +32,12 @@ import Testnet.Types import Hedgehog (Property) import qualified Hedgehog.Extras.Stock as H import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H import qualified Hedgehog.Internal.Property as H -- | Tests @query slot-number@ cardano-cli command that it returns correct slot numbers for provided utc time hprop_querySlotNumber :: Property -hprop_querySlotNumber = integrationRetryWorkspace 2 "query-slot-number" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_querySlotNumber = integrationRetryWorkspace 2 "query-slot-number" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf <- mkConf tempAbsBasePath' diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs index 8cb48c28d03..e45b57cb7b1 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/FoldEpochState.hs @@ -15,7 +15,6 @@ import Control.Monad.Trans.State.Strict import qualified System.Directory as IO import System.FilePath (()) -import Testnet.Components.TestWatchdog import Testnet.Property.Util (integrationWorkspace) import Testnet.Types @@ -25,7 +24,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H import qualified Hedgehog.Extras.Test as H prop_foldEpochState :: H.Property -prop_foldEpochState = integrationWorkspace "foldEpochState" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +prop_foldEpochState = integrationWorkspace "foldEpochState" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf <- TN.mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath $ tempAbsPath conf diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs index 1ee19188a05..ec9ef77c4ce 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/CommitteeAddNew.hs @@ -35,7 +35,6 @@ import System.FilePath (()) import Testnet.Components.Configuration import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.EpochStateProcessing (waitForGovActionVotes) import qualified Testnet.Process.Cli.DRep as DRep @@ -50,7 +49,7 @@ import Hedgehog import qualified Hedgehog.Extras as H hprop_constitutional_committee_add_new :: Property -hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-committee-add-new" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-committee-add-new" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs index 5d9737a2d2b..178dd10c0ee 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepActivity.hs @@ -31,7 +31,6 @@ import GHC.Stack (HasCallStack, withFrozenCallStack) import System.FilePath (()) import Testnet.Components.Query -import Testnet.Components.TestWatchdog (kickWatchdog, runWithDefaultWatchdog) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys @@ -43,11 +42,11 @@ import Testnet.Types import Hedgehog (MonadTest, Property, annotateShow) import qualified Hedgehog.Extras as H + -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRep Activity/"'@ hprop_check_drep_activity :: Property -hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBasePath' -> - runWithDefaultWatchdog $ \watchdog -> do +hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog $ \watchdog -> do -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath @@ -127,7 +126,7 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP minEpochsToWaitIfNotChanging (Just firstTargetDRepActivity) maxEpochsToWaitAfterProposal - kickWatchdog watchdog + H.kickWatchdog watchdog -- We now send a bunch of proposals to make sure that the 2 new DReps expire. -- because DReps won't expire if there is not enough activity (opportunites to participate). diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs index 90c4dcd962d..bf852e12e42 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepDeposit.hs @@ -16,7 +16,6 @@ import qualified Data.Map as Map import System.FilePath (()) import Testnet.Components.Query -import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Transaction import Testnet.Process.Run (mkExecConfig) @@ -30,7 +29,7 @@ import qualified Hedgehog.Extras as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRep Deposits/"'@ hprop_ledger_events_drep_deposits :: Property -hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs index 3eb312311f4..7135d51c99e 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/DRepRetirement.hs @@ -20,7 +20,6 @@ import qualified Data.Text as Text import System.FilePath (()) import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Cli.Keys import Testnet.Process.Run (execCli', mkExecConfig) @@ -38,7 +37,7 @@ sbe = ShelleyBasedEraConway -- Execute this test with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRepRetirement/"'@ hprop_drep_retirement :: Property -hprop_drep_retirement = integrationRetryWorkspace 2 "drep-retirement" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_drep_retirement = integrationRetryWorkspace 2 "drep-retirement" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs index 0fe08b762f0..95bcb91c641 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/InfoAction.hs @@ -33,7 +33,6 @@ import GHC.Stack import System.FilePath (()) import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Cli.Keys import Testnet.Process.Run (execCli', mkExecConfig) @@ -46,7 +45,7 @@ import qualified Hedgehog.Extras as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/InfoAction/'@ hprop_ledger_events_info_action :: Property -hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_ledger_events_info_action = integrationRetryWorkspace 0 "info-hash" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs index 0fe251dedcd..c9b16b7b573 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs @@ -32,7 +32,6 @@ import System.FilePath (()) import Testnet.Components.Configuration import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import qualified Testnet.Process.Cli.DRep as DRep import Testnet.Process.Cli.Keys @@ -52,7 +51,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO -- Generate a testnet with a committee defined in the Conway genesis. Submit a motion of no confidence -- and have the required threshold of SPOs and DReps vote yes on it. hprop_gov_no_confidence :: Property -hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs index 8ceeefa211d..08c0ec2e71b 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PredefinedAbstainDRep.hs @@ -33,7 +33,6 @@ import System.FilePath (()) import Testnet.Components.Configuration (anyEraToString) import Testnet.Components.Query -import Testnet.Components.TestWatchdog (runWithDefaultWatchdog_) import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) import Testnet.Process.Cli.DRep (createCertificatePublicationTxBody, createVotingTxBody, generateVoteFiles) @@ -65,7 +64,7 @@ import qualified Hedgehog.Extras as H -- Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Predefined Abstain DRep/"'@ hprop_check_predefined_abstain_drep :: Property -hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs index dbaf00ab8cc..9521a16a230 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitution.hs @@ -32,7 +32,6 @@ import System.FilePath (()) import Testnet.Components.Configuration import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.EpochStateProcessing (waitForGovActionVotes) import Testnet.Process.Cli.DRep @@ -48,7 +47,7 @@ import qualified Hedgehog.Extras as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/ProposeAndRatifyNewConstitution/"'@ hprop_ledger_events_propose_new_constitution :: Property -hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new-constitution" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new-constitution" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs index 5eaafe938d7..2a13855f00a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/ProposeNewConstitutionSPO.hs @@ -26,7 +26,6 @@ import Lens.Micro import System.FilePath (()) import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Cli.DRep import Testnet.Process.Cli.Keys @@ -44,7 +43,7 @@ import qualified Hedgehog.Extras as H -- Execute me with: -- @cabal test cardano-testnet-test --test-options '-p "/ProposeNewConstitutionSPO/"'@ hprop_ledger_events_propose_new_constitution_spo :: Property -hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose-new-constitution-spo" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose-new-constitution-spo" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs index 6da4b2be09d..53539de3cf7 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryGrowth.hs @@ -21,7 +21,6 @@ import Lens.Micro ((^.)) import qualified System.Directory as IO import System.FilePath (()) -import Testnet.Components.TestWatchdog import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Types @@ -32,7 +31,7 @@ import qualified Hedgehog.Extras.Test as H -- | Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Treasury Growth/"'@ prop_check_if_treasury_is_growing :: H.Property -prop_check_if_treasury_is_growing = integrationRetryWorkspace 0 "growing-treasury" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +prop_check_if_treasury_is_growing = integrationRetryWorkspace 0 "growing-treasury" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start testnet conf@Conf{tempAbsPath=TmpAbsolutePath tempAbsPath'} <- TN.mkConf tempAbsBasePath' diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs index 84db28d0e8b..67577d433a2 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryWithdrawal.hs @@ -37,7 +37,6 @@ import Lens.Micro import System.FilePath (()) import Testnet.Components.Query -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Cli.Keys (cliStakeAddressKeyGen) import Testnet.Process.Run (execCli', mkExecConfig) @@ -49,7 +48,7 @@ import Hedgehog import qualified Hedgehog.Extras as H hprop_ledger_events_treasury_withdrawal:: Property -hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury-withdrawal" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury-withdrawal" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs index 658fc3157a0..de3e39c352c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs @@ -35,7 +35,6 @@ import qualified System.Process as IO import System.Process (interruptProcessGroupOf) import Testnet.Components.Configuration -import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Run (execCli_, initiateProcess, procNode) import Testnet.Property.Util (integrationRetryWorkspace) @@ -51,6 +50,7 @@ import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.Concurrent as H import qualified Hedgehog.Extras.Test.File as H import qualified Hedgehog.Extras.Test.Process as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H {- HLINT ignore "Redundant <&>" -} @@ -59,7 +59,7 @@ import qualified Hedgehog.Extras.Test.Process as H -- -- TODO: Use cardanoTestnet in hprop_shutdown hprop_shutdown :: Property -hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf <- mkConf tempAbsBasePath' let tempBaseAbsPath' = makeTmpBaseAbsPath $ tempAbsPath conf tempAbsPath' = unTmpAbsPath $ tempAbsPath conf @@ -184,7 +184,7 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> r hprop_shutdownOnSlotSynced :: Property -hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synced" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synced" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net -- TODO: Move yaml filepath specification into individual node options conf <- mkConf tempAbsBasePath' @@ -233,7 +233,7 @@ hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synce -- Execute this test with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/ShutdownOnSigint/"'@ hprop_shutdownOnSigint :: Property -hprop_shutdownOnSigint = integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_shutdownOnSigint = integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net -- TODO: Move yaml filepath specification into individual node options conf <- mkConf tempAbsBasePath' diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs index 35693ad3a93..568f126ad54 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SanityCheck.hs @@ -19,7 +19,6 @@ import Prelude import GHC.IO.Exception (IOException) import GHC.Stack -import Testnet.Components.TestWatchdog import Testnet.Property.Util (integrationWorkspace) import Testnet.Types @@ -40,7 +39,7 @@ newtype AdditionalCatcher -- This sets the stage for more direct testing of clusters allowing us to avoid querying the node, dealing with serialization to and from disk, -- setting timeouts for expected results etc. hprop_ledger_events_sanity_check :: Property -hprop_ledger_events_sanity_check = integrationWorkspace "ledger-events-sanity-check" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_ledger_events_sanity_check = integrationWorkspace "ledger-events-sanity-check" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net conf <- mkConf tempAbsBasePath' diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs index 6fa826094fd..b96ba0c020a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs @@ -35,7 +35,6 @@ import System.FilePath (()) import qualified System.Info as SYS import Text.Regex (mkRegex, subRegex) -import Testnet.Components.TestWatchdog import Testnet.Process.Run (execCli', mkExecConfig, procSubmitApi) import Testnet.Property.Util (decodeEraUTxO, integrationRetryWorkspace) import Testnet.SubmitApi @@ -46,9 +45,10 @@ import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Base as H import qualified Hedgehog.Extras.Test.File as H import qualified Hedgehog.Extras.Test.Golden as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H hprop_transaction :: Property -hprop_transaction = integrationRetryWorkspace 0 "submit-api-babbage-transaction" $ \tempAbsBasePath' -> runWithDefaultWatchdog_ $ do +hprop_transaction = integrationRetryWorkspace 0 "submit-api-babbage-transaction" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do H.note_ SYS.os conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath