Skip to content

Commit

Permalink
Merge pull request #5857 from IntersectMBO/mgalazyn/test/use-hedgehog…
Browse files Browse the repository at this point in the history
…-test-watchdog

Use TestWatchdog from hedgehog-extras.
  • Loading branch information
palas authored Jun 3, 2024
2 parents 6c3a95a + e0df963 commit 0545aa7
Show file tree
Hide file tree
Showing 30 changed files with 42 additions and 213 deletions.
2 changes: 1 addition & 1 deletion bench/locli/locli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion cardano-node-chairman/cardano-node-chairman.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions cardano-testnet/cardano-testnet.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,7 @@ library
, exceptions
, filepath
, hedgehog
, hedgehog-extras < 0.6.2
, hedgehog-extras ^>= 0.6.4
, lens-aeson
, microlens
, mtl
Expand Down Expand Up @@ -93,7 +93,6 @@ library
Parsers.Run
Testnet.Components.Configuration
Testnet.Components.Query
Testnet.Components.TestWatchdog
Testnet.Defaults
Testnet.EpochStateProcessing
Testnet.Filepath
Expand Down Expand Up @@ -227,7 +226,7 @@ test-suite cardano-testnet-test
, exceptions
, filepath
, hedgehog
, hedgehog-extras
, hedgehog-extras
, http-conduit
, lens-aeson
, microlens
Expand Down
3 changes: 1 addition & 2 deletions cardano-testnet/src/Testnet/Components/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
137 changes: 0 additions & 137 deletions cardano-testnet/src/Testnet/Components/TestWatchdog.hs

This file was deleted.

16 changes: 0 additions & 16 deletions cardano-testnet/src/Testnet/Property/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

5 changes: 2 additions & 3 deletions cardano-testnet/src/Testnet/Runtime.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down
Loading

0 comments on commit 0545aa7

Please sign in to comment.