Merge pull request #5857 from IntersectMBO/mgalazyn/test/use-hedgehog…

…-test-watchdog Use TestWatchdog from hedgehog-extras.
IntersectMBO · Jun 3, 2024 · 0545aa7 · 0545aa7
2 parents 6c3a95a + e0df963
commit 0545aa7
Show file tree

Hide file tree

Showing 30 changed files with 42 additions and 213 deletions.
diff --git 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
@@ -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
@@ -62,7 +62,7 @@ library
                       , exceptions
                       , filepath
                       , hedgehog
-                      , hedgehog-extras < 0.6.2
+                      , hedgehog-extras ^>= 0.6.4
                       , lens-aeson
                       , microlens
                       , mtl
@@ -93,7 +93,6 @@ library
                         Parsers.Run
                         Testnet.Components.Configuration
                         Testnet.Components.Query
-                        Testnet.Components.TestWatchdog
                         Testnet.Defaults
                         Testnet.EpochStateProcessing
                         Testnet.Filepath
@@ -227,7 +226,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
@@ -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
diff --git a/cardano-testnet/src/Testnet/Property/Util.hs b/cardano-testnet/src/Testnet/Property/Util.hs
@@ -9,16 +9,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
@@ -61,18 +57,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 >> 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
@@ -46,7 +46,6 @@ import qualified System.Process as IO
 import           Testnet.Filepath
 import qualified Testnet.Ping as Ping
 import           Testnet.Process.Run
-import           Testnet.Property.Util
 import           Testnet.Types (NodeRuntime (NodeRuntime), TestnetRuntime (configurationFile),
                    poolSprockets)
 
@@ -55,6 +54,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
@@ -218,7 +218,7 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac
       H.evalIO $ appendFile logFile ""
       socketPath <- H.noteM $ H.sprocketSystemName <$> H.headM (poolSprockets testnetRuntime)
 
-      _ <- runInBackground . runExceptT $
+      _ <- H.asyncRegister_ . runExceptT $
         foldEpochState
           (configurationFile testnetRuntime)
           (Api.File socketPath)
@@ -228,7 +228,6 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac
           (handler logFile diffFile)
 
       H.note_ $ "Started logging epoch states to: " <> logFile <> "\nEpoch state diffs are logged to: " <> diffFile
-
   where
     handler :: FilePath -- ^ log file
             -> FilePath -- ^ diff file

diff --git a/...-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/LeadershipSchedule.hs b/...-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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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