Use hedgehog-extras TestWatchdog

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
 

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

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

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

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
 

cardano-testnet/src/Testnet/Runtime.hs

@@ -33,14 +33,14 @@ 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)
 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)

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

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

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

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

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

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

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