From b0d8411a1e87c35817859fd3d05b129ee8f3ddf1 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 14 Oct 2024 19:21:35 +0200 Subject: [PATCH 1/2] Remove NodeRuntime type --- .../test/Spec/Chairman/Cardano.hs | 6 ++-- .../test/Spec/Chairman/Chairman.hs | 4 +-- cardano-testnet/src/Cardano/Testnet.hs | 11 ++++-- cardano-testnet/src/Testnet/Runtime.hs | 16 +++++++-- cardano-testnet/src/Testnet/Start/Cardano.hs | 7 ++-- cardano-testnet/src/Testnet/Types.hs | 36 ++++++------------- .../Cardano/Testnet/Test/Cli/Conway/Plutus.hs | 6 ++-- .../Testnet/Test/Cli/Conway/StakeSnapshot.hs | 3 +- .../Cardano/Testnet/Test/Cli/KesPeriodInfo.hs | 4 +-- .../Testnet/Test/Cli/LeadershipSchedule.hs | 2 +- .../Cardano/Testnet/Test/Cli/Query.hs | 6 ++-- .../Testnet/Test/Cli/QuerySlotNumber.hs | 2 +- .../Cardano/Testnet/Test/Cli/StakeSnapshot.hs | 3 +- .../Cardano/Testnet/Test/Cli/Transaction.hs | 2 +- .../Cardano/Testnet/Test/FoldEpochState.hs | 1 - .../Testnet/Test/Gov/CommitteeAddNew.hs | 6 ++-- .../Cardano/Testnet/Test/Gov/DRepActivity.hs | 6 ++-- .../Cardano/Testnet/Test/Gov/DRepDeposit.hs | 6 ++-- .../Testnet/Test/Gov/DRepRetirement.hs | 6 ++-- .../Testnet/Test/Gov/GovActionTimeout.hs | 7 ++-- .../Cardano/Testnet/Test/Gov/InfoAction.hs | 6 ++-- .../Cardano/Testnet/Test/Gov/NoConfidence.hs | 2 +- .../Testnet/Test/Gov/PParamChangeFailsSPO.hs | 6 ++-- .../Testnet/Test/Gov/PredefinedAbstainDRep.hs | 9 +++-- .../Test/Gov/ProposeNewConstitution.hs | 6 ++-- .../Test/Gov/ProposeNewConstitutionSPO.hs | 6 ++-- .../Testnet/Test/Gov/TreasuryDonation.hs | 10 +++--- .../Testnet/Test/Gov/TreasuryGrowth.hs | 5 ++- .../Testnet/Test/Gov/TreasuryWithdrawal.hs | 8 ++--- .../Cardano/Testnet/Test/Node/Shutdown.hs | 15 ++++---- .../Cardano/Testnet/Test/SanityCheck.hs | 7 ++-- .../Testnet/Test/SubmitApi/Transaction.hs | 2 +- 32 files changed, 108 insertions(+), 114 deletions(-) diff --git a/cardano-node-chairman/test/Spec/Chairman/Cardano.hs b/cardano-node-chairman/test/Spec/Chairman/Cardano.hs index 3851452f335..249a3ff3bc2 100644 --- a/cardano-node-chairman/test/Spec/Chairman/Cardano.hs +++ b/cardano-node-chairman/test/Spec/Chairman/Cardano.hs @@ -4,7 +4,7 @@ module Spec.Chairman.Cardano where -import Cardano.Testnet (allNodes, cardanoTestnetDefault, mkConf) +import Cardano.Testnet (cardanoTestnetDefault, mkConf, testnetNodes) import Data.Default.Class @@ -19,6 +19,6 @@ hprop_chairman :: H.Property hprop_chairman = integrationRetryWorkspace 2 "cardano-chairman" $ \tempAbsPath' -> H.runWithDefaultWatchdog_ $ do conf <- mkConf tempAbsPath' - allNodes' <- allNodes <$> cardanoTestnetDefault def def conf + allNodes <- testnetNodes <$> cardanoTestnetDefault def def conf - chairmanOver 120 50 conf allNodes' + chairmanOver 120 50 conf allNodes diff --git a/cardano-node-chairman/test/Spec/Chairman/Chairman.hs b/cardano-node-chairman/test/Spec/Chairman/Chairman.hs index fe882354c29..b8fc7e0c38d 100644 --- a/cardano-node-chairman/test/Spec/Chairman/Chairman.hs +++ b/cardano-node-chairman/test/Spec/Chairman/Chairman.hs @@ -20,7 +20,7 @@ import System.FilePath.Posix (()) import qualified System.IO as IO import qualified System.Process as IO -import Testnet.Types (NodeRuntime, nodeSocketPath) +import Testnet.Types (TestnetNode, nodeSocketPath) import qualified Hedgehog as H import Hedgehog.Extras.Test.Base (Integration) @@ -30,7 +30,7 @@ import qualified Hedgehog.Extras.Test.Process as H {- HLINT ignore "Redundant <&>" -} -chairmanOver :: HasCallStack => Int -> Int -> H.Conf -> [NodeRuntime] -> Integration () +chairmanOver :: HasCallStack => Int -> Int -> H.Conf -> [TestnetNode] -> Integration () chairmanOver timeoutSeconds requiredProgress H.Conf {H.tempAbsPath} allNodes = do maybeChairman <- H.evalIO $ IO.lookupEnv "DISABLE_CHAIRMAN" let tempAbsPath' = H.unTmpAbsPath tempAbsPath diff --git a/cardano-testnet/src/Cardano/Testnet.hs b/cardano-testnet/src/Cardano/Testnet.hs index d7ce556c795..3ab6bd058fc 100644 --- a/cardano-testnet/src/Cardano/Testnet.hs +++ b/cardano-testnet/src/Cardano/Testnet.hs @@ -37,9 +37,14 @@ module Cardano.Testnet ( waitForEpochs, -- * Runtime - NodeRuntime(..), - allNodes, - + TestnetRuntime(..), + testnetSprockets, + spoNodes, + relayNodes, + + TestnetNode(..), + isTestnetNodeSpo, + nodeSocketPath, ) where import Testnet.Components.Query diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index c7a80417ae9..e4471a773e8 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -48,7 +48,7 @@ import qualified System.Process as IO import Testnet.Filepath import qualified Testnet.Ping as Ping import Testnet.Process.Run -import Testnet.Types (NodeRuntime (NodeRuntime), TestnetRuntime (configurationFile), +import Testnet.Types (TestnetNode (..), TestnetRuntime (configurationFile), showIpv4Address, testnetSprockets) import Hedgehog (MonadTest) @@ -115,7 +115,7 @@ startNode -- ^ Testnet magic -> [String] -- ^ The command --socket-path will be added automatically. - -> ExceptT NodeStartFailure m NodeRuntime + -> ExceptT NodeStartFailure m TestnetNode startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do let tempBaseAbsPath = makeTmpBaseAbsPath tp socketDir = makeSocketDir tp @@ -195,7 +195,17 @@ startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do Ping.pingNode (fromIntegral testnetMagic) sprocket >>= (firstExceptT (NodeExecutableError . ("Ping error:" <+>) . prettyError) . hoistEither) - pure $ NodeRuntime node ipv4 port sprocket stdIn nodeStdoutFile nodeStderrFile hProcess + pure $ TestnetNode + { nodeName = node + , poolKeys = Nothing -- they're set in the function caller, if present + , nodeIpv4 = ipv4 + , nodePort = port + , nodeSprocket = sprocket + , nodeStdinHandle = stdIn + , nodeStdout = nodeStdoutFile + , nodeStderr = nodeStderrFile + , nodeProcessHandle = hProcess + } where -- close provided list of handles when 'ExceptT' throws an error closeHandlesOnError :: MonadIO m => [IO.Handle] -> ExceptT e m a -> ExceptT e m a diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs index 3ffb43404dd..e8ce817cb88 100644 --- a/cardano-testnet/src/Testnet/Start/Cardano.hs +++ b/cardano-testnet/src/Testnet/Start/Cardano.hs @@ -41,6 +41,7 @@ import qualified Data.Aeson as Aeson import Data.Bifunctor (first) import qualified Data.ByteString.Lazy as LBS import Data.Either +import Data.Functor import Data.Maybe import Data.MonoTraversable (Element, MonoFunctor, omap) import qualified Data.Text as Text @@ -350,19 +351,19 @@ cardanoTestnet ] <> spoNodeCliArgs <> testnetNodeExtraCliArgs nodeOptions - pure $ flip TestnetNode mKeys <$> eRuntime + pure $ eRuntime <&> \rt -> rt{poolKeys=mKeys} let (failedNodes, testnetNodes') = partitionEithers eTestnetNodes unless (null failedNodes) $ do H.noteShow_ . vsep $ prettyError <$> failedNodes H.failure - H.annotateShow $ nodeSprocket . testnetNodeRuntime <$> testnetNodes' + H.annotateShow $ nodeSprocket <$> testnetNodes' -- FIXME: use foldEpochState waiting for chain extensions now <- H.noteShowIO DTC.getCurrentTime deadline <- H.noteShow $ DTC.addUTCTime 45 now - forM_ (map (nodeStdout . testnetNodeRuntime) testnetNodes') $ \nodeStdoutFile -> do + forM_ (map nodeStdout testnetNodes') $ \nodeStdoutFile -> do assertChainExtended deadline nodeLoggingFormat nodeStdoutFile H.noteShowIO_ DTC.getCurrentTime diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index 0813cd42f30..bd9e84402e6 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -15,15 +15,12 @@ module Testnet.Types , NodeLoggingFormat(..) , PaymentKeyInfo(..) , TestnetRuntime(..) - , allNodes , spoNodes , relayNodes , testnetSprockets - , NodeRuntime(..) - , nodeSocketPath , TestnetNode(..) + , nodeSocketPath , isTestnetNodeSpo - , testnetNodeStdout , SpoNodeKeys(..) , Delegator(..) , KeyPair(..) @@ -120,31 +117,17 @@ data TestnetRuntime = TestnetRuntime } testnetSprockets :: TestnetRuntime -> [Sprocket] -testnetSprockets = fmap (nodeSprocket . testnetNodeRuntime) . testnetNodes +testnetSprockets = fmap nodeSprocket . testnetNodes -allNodes :: TestnetRuntime -> [NodeRuntime] -allNodes = fmap testnetNodeRuntime . testnetNodes +spoNodes :: TestnetRuntime -> [TestnetNode] +spoNodes = filter isTestnetNodeSpo . testnetNodes -spoNodes :: TestnetRuntime -> [NodeRuntime] -spoNodes = fmap testnetNodeRuntime . filter isTestnetNodeSpo . testnetNodes - -relayNodes :: TestnetRuntime -> [NodeRuntime] -relayNodes = fmap testnetNodeRuntime . filter (not . isTestnetNodeSpo) . testnetNodes +relayNodes :: TestnetRuntime -> [TestnetNode] +relayNodes = filter (not . isTestnetNodeSpo) . testnetNodes data TestnetNode = TestnetNode - { testnetNodeRuntime :: !NodeRuntime - , poolKeys :: Maybe SpoNodeKeys -- ^ Keys are only present for SPO nodes - } - -testnetNodeStdout :: TestnetNode -> FilePath -testnetNodeStdout = nodeStdout . testnetNodeRuntime - -isTestnetNodeSpo :: TestnetNode -> Bool -isTestnetNodeSpo = isJust . poolKeys - --- | Node process runtime parameters -data NodeRuntime = NodeRuntime { nodeName :: !String + , poolKeys :: Maybe SpoNodeKeys -- ^ Keys are only present for SPO nodes , nodeIpv4 :: !HostAddress , nodePort :: !PortNumber , nodeSprocket :: !Sprocket @@ -154,7 +137,10 @@ data NodeRuntime = NodeRuntime , nodeProcessHandle :: !IO.ProcessHandle } -nodeSocketPath :: NodeRuntime -> SocketPath +isTestnetNodeSpo :: TestnetNode -> Bool +isTestnetNodeSpo = isJust . poolKeys + +nodeSocketPath :: TestnetNode -> SocketPath nodeSocketPath = File . H.sprocketSystemName . nodeSprocket data ColdPoolKey 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 230103e79e0..94d7a66b737 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 @@ -65,14 +65,14 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa , wallets=wallet0:wallet1:_ } <- cardanoTestnetDefault options def conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic H.noteShow_ wallet0 let utxoAddr = Text.unpack $ paymentKeyInfoAddr wallet0 utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 utxoSKeyFile2 = signingKeyFp $ paymentKeyInfoPair wallet1 - socketPath = nodeSocketPath testnetNodeRuntime + socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 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 cf577fbe50c..ef3797de8ab 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 @@ -21,7 +21,6 @@ import qualified System.Info as SYS import Testnet.Process.Run (execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) -import Testnet.Types import Hedgehog (Property, (===)) import qualified Hedgehog as H @@ -43,7 +42,7 @@ hprop_stakeSnapshot = integrationRetryWorkspace 2 "conway-stake-snapshot" $ \tem } <- cardanoTestnetDefault def def conf poolNode1 <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ testnetNodeRuntime poolNode1 + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic void $ waitUntilEpoch configurationFile 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 cdc79f23dd6..c9eb3c159a5 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 @@ -215,7 +215,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs H.createDirectoryIfMissing_ testSpoDir let valency = 1 topology = RealNodeTopology $ - flip map testnetNodes $ \TestnetNode{testnetNodeRuntime=NodeRuntime{nodeIpv4,nodePort}} -> + flip map testnetNodes $ \TestnetNode{nodeIpv4,nodePort} -> RemoteAddress (showIpv4Address nodeIpv4) nodePort valency H.lbsWriteFile topologyFile $ Aeson.encode topology @@ -260,7 +260,7 @@ hprop_kes_period_info = integrationRetryWorkspace 2 "kes-period-info" $ \tempAbs , "--shelley-vrf-key", testSpoVrfSKey , "--shelley-operational-certificate", testSpoOperationalCertFp ] - NodeRuntime{ nodeStdout } <- H.evalEither eRuntime + TestnetNode{nodeStdout} <- H.evalEither eRuntime threadDelay 5_000_000 diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs index 2c5d45515da..44fc8086e01 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/LeadershipSchedule.hs @@ -222,7 +222,7 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "leadership-schedule" $ \ H.createDirectoryIfMissing_ testSpoDir let valency = 1 topology = RealNodeTopology $ - flip map testnetNodes $ \TestnetNode{testnetNodeRuntime=NodeRuntime{nodeIpv4,nodePort}} -> + flip map testnetNodes $ \TestnetNode{nodeIpv4,nodePort} -> RemoteAddress (showIpv4Address nodeIpv4) nodePort valency H.lbsWriteFile topologyFile $ Aeson.encode topology let testSpoKesVKey = work "kes.vkey" 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 cc3972a9429..40e298d0b91 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 @@ -114,10 +114,10 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. let shelleyGeneisFile = work Defaults.defaultGenesisFilepath ShelleyEra - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 64fcb4152d7..aa8acaead4a 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 @@ -56,7 +56,7 @@ hprop_querySlotNumber = integrationRetryWorkspace 2 "query-slot-number" $ \tempA epochSize = fromIntegral (unEpochSize sgEpochLength) :: Int poolNode1 <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ testnetNodeRuntime poolNode1 + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 execConfig <- mkExecConfig tempBaseAbsPath' poolSprocket1 testnetMagic id do diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/StakeSnapshot.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/StakeSnapshot.hs index 803f43dbedc..2eb9a2cb034 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/StakeSnapshot.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/StakeSnapshot.hs @@ -22,7 +22,6 @@ import qualified System.Info as SYS import Testnet.Process.Run (execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) -import Testnet.Types import Hedgehog (Property, (===)) import qualified Hedgehog as H @@ -45,7 +44,7 @@ hprop_stakeSnapshot = integrationRetryWorkspace 2 "stake-snapshot" $ \tempAbsBas let nSpoNodes = length $ spoNodes runtime poolNode1 <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ testnetNodeRuntime poolNode1 + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic void $ waitUntilEpoch configurationFile diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction.hs index 1476c30956b..101ccb65a3c 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Transaction.hs @@ -65,7 +65,7 @@ hprop_transaction = integrationRetryWorkspace 2 "simple transaction build" $ \te } <- cardanoTestnetDefault options def conf poolNode1 <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ testnetNodeRuntime poolNode1 + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic 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 e32df1af83d..77df0b16bf6 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 @@ -17,7 +17,6 @@ import qualified System.Directory as IO import System.FilePath (()) import Testnet.Property.Util (integrationWorkspace) -import Testnet.Types import Hedgehog ((===)) import qualified Hedgehog as H 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 fa164e9944c..d7031658585 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 @@ -91,10 +91,10 @@ hprop_constitutional_committee_add_new = integrationWorkspace "constitutional-co } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime, poolKeys=Just poolKeys} <- H.headM . filter isTestnetNodeSpo $ testnetNodes runtime - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node@TestnetNode{poolKeys=Just poolKeys} <- H.headM . filter isTestnetNodeSpo $ testnetNodes runtime + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 70d50a9477f..c1611010b87 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 @@ -69,10 +69,10 @@ hprop_check_drep_activity = integrationWorkspace "test-activity" $ \tempAbsBaseP } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 e1f8929baf6..4ccd9aa4379 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 @@ -58,10 +58,10 @@ hprop_ledger_events_drep_deposits = integrationWorkspace "drep-deposits" $ \temp } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 c41c12e8545..d649a649d05 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 @@ -59,10 +59,10 @@ hprop_drep_retirement = integrationRetryWorkspace 2 "drep-retirement" $ \tempAbs } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs index 4191cf2e4f5..a9ca837e71a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/GovActionTimeout.hs @@ -25,7 +25,6 @@ import Testnet.Process.Cli.DRep (makeActivityChangeProposal) import Testnet.Process.Run (mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.Start.Types -import Testnet.Types import Hedgehog (Property) import qualified Hedgehog as H @@ -59,10 +58,10 @@ hprop_check_gov_action_timeout = integrationWorkspace "gov-action-timeout" $ \te } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 20d4271b78d..5877ee1c53a 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 @@ -70,10 +70,10 @@ hprop_ledger_events_info_action = integrationRetryWorkspace 2 "info-hash" $ \tem } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 09ef8934e5e..5e21b03ad43 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 @@ -123,7 +123,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat alonzoGenesis conwayGenesisWithCommittee poolNode1 <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ testnetNodeRuntime poolNode1 + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic let socketName' = IO.sprocketName poolSprocket1 diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs index f9cbc040c2e..43375ee7af4 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/PParamChangeFailsSPO.hs @@ -64,10 +64,10 @@ hprop_check_pparam_fails_spo = integrationWorkspace "test-pparam-spo" $ \tempAbs } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 bd5faf2a166..f0174043d1c 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 @@ -43,8 +43,7 @@ import qualified Testnet.Property.Util as H import Testnet.Start.Types import Testnet.Types (KeyPair (..), PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), - SomeKeyPair (SomeKeyPair), StakingKey, TestnetNode (..), TestnetRuntime (..), - nodeSocketPath) + SomeKeyPair (SomeKeyPair), StakingKey) import Hedgehog import qualified Hedgehog.Extras as H @@ -90,10 +89,10 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 704439cd573..21d8486622b 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 @@ -84,10 +84,10 @@ hprop_ledger_events_propose_new_constitution = integrationWorkspace "propose-new } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 cb04109640e..dcb239eafa9 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 @@ -72,10 +72,10 @@ hprop_ledger_events_propose_new_constitution_spo = integrationWorkspace "propose } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs index e3c133315c8..16fbd89a13f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs @@ -27,7 +27,7 @@ import System.FilePath (()) import Testnet.Components.Query import Testnet.Process.Run (execCli', execCliAny, mkExecConfig) -import Testnet.Property.Util (integrationWorkspace) +import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types import Testnet.Types @@ -39,7 +39,7 @@ import qualified Hedgehog.Extras as H -- Execute me with: -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Treasury Donation/"'@ hprop_ledger_events_treasury_donation :: Property -hprop_ledger_events_treasury_donation = integrationWorkspace "treasury-donation" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do +hprop_ledger_events_treasury_donation = integrationRetryWorkspace 2 "treasury-donation" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } <- mkConf tempAbsBasePath' let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath @@ -57,10 +57,10 @@ hprop_ledger_events_treasury_donation = integrationWorkspace "treasury-donation" } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket node execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 37f412be76e..fb1ab8aaa90 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 @@ -26,7 +26,6 @@ import System.FilePath (()) import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types -import Testnet.Types import qualified Hedgehog as H import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as H @@ -50,8 +49,8 @@ prop_check_if_treasury_is_growing = integrationRetryWorkspace 2 "growing-treasur TestnetRuntime{testnetMagic, configurationFile, testnetNodes} <- cardanoTestnetDefault options shelleyOptions conf (execConfig, socketPathAbs) <- do - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + TestnetNode{nodeSprocket} <- H.headM testnetNodes + poolSprocket1 <- H.noteShow nodeSprocket let socketPath' = H.sprocketArgumentName poolSprocket1 socketPathAbs <- Api.File <$> H.noteIO (IO.canonicalizePath $ tempAbsPath' socketPath') execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic 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 86152620deb..0b100412893 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 @@ -49,7 +49,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' -> H.runWithDefaultWatchdog_ $ do +hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 2 "treasury-withdrawal" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do conf@Conf { tempAbsPath } <- H.noteShowM $ mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath @@ -74,10 +74,10 @@ hprop_ledger_events_treasury_withdrawal = integrationRetryWorkspace 1 "treasury } <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - TestnetNode{testnetNodeRuntime} <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket testnetNodeRuntime + node@TestnetNode{nodeSprocket} <- H.headM testnetNodes + poolSprocket1 <- H.noteShow nodeSprocket execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic - let socketPath = nodeSocketPath testnetNodeRuntime + let socketPath = nodeSocketPath node epochStateView <- getEpochStateView configurationFile socketPath 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 08cd900222e..bf96df3a827 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 @@ -41,7 +41,6 @@ import Testnet.Process.Run (execCli_, initiateProcess, procNode) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Byron import Testnet.Start.Types -import Testnet.Types import Hedgehog (Property, (===)) import qualified Hedgehog as H @@ -204,10 +203,10 @@ hprop_shutdownOnSlotSynced = integrationRetryWorkspace 2 "shutdown-on-slot-synce , genesisSlotLength = slotLen } testnetRuntime <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - let allNodes' = testnetNodes testnetRuntime - H.note_ $ "All nodes: " <> show (map (nodeName . testnetNodeRuntime) allNodes') + let allNodes = testnetNodes testnetRuntime + H.note_ $ "All nodes: " <> show (map nodeName allNodes) - node <- H.headM $ testnetNodeRuntime <$> allNodes' + node <- H.headM allNodes H.note_ $ "Node name: " <> nodeName node -- Wait for the node to exit @@ -245,7 +244,7 @@ hprop_shutdownOnSigint = integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tem shelleyOptions = def { genesisEpochLength = 300 } testnetRuntime <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - node@NodeRuntime{nodeProcessHandle} <- H.headM $ testnetNodeRuntime <$> testnetNodes testnetRuntime + TestnetNode{nodeProcessHandle, nodeStdout, nodeStderr} <- H.headM $ testnetNodes testnetRuntime -- send SIGINT H.evalIO $ interruptProcessGroupOf nodeProcessHandle @@ -255,13 +254,13 @@ hprop_shutdownOnSigint = integrationRetryWorkspace 2 "shutdown-on-sigint" $ \tem -- Check results when (isRight mExitCodeRunning) $ do - H.cat (nodeStdout node) - H.cat (nodeStderr node) + H.cat nodeStdout + H.cat nodeStderr case mExitCodeRunning of Right (ExitFailure _) -> H.success other -> H.failMessage callStack $ "Unexpected exit status for the testnet process: " <> show other - logs <- H.readFile (nodeStdout node) + logs <- H.readFile nodeStdout case mapMaybe parseMsg $ reverse $ lines logs of [] -> H.failMessage callStack "Could not find close DB message." (Left err):_ -> H.failMessage callStack err 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 6b1ae441fb3..2f280d0d812 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 @@ -20,9 +20,8 @@ import Data.Default.Class import GHC.IO.Exception (IOException) import GHC.Stack -import Testnet.Property.Util (integrationWorkspace) +import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types -import Testnet.Types import Hedgehog import qualified Hedgehog.Extras as H @@ -41,7 +40,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' -> H.runWithDefaultWatchdog_ $ do +hprop_ledger_events_sanity_check = integrationRetryWorkspace 2 "ledger-events-sanity-check" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do -- Start a local test net conf <- mkConf tempAbsBasePath' @@ -53,7 +52,7 @@ hprop_ledger_events_sanity_check = integrationWorkspace "ledger-events-sanity-ch TestnetRuntime{configurationFile, testnetNodes} <- cardanoTestnetDefault fastTestnetOptions shelleyOptions conf - nr@NodeRuntime{nodeSprocket} <- H.headM $ testnetNodeRuntime <$> testnetNodes + nr@TestnetNode{nodeSprocket} <- H.headM testnetNodes let socketPath = nodeSocketPath nr H.note_ $ "Sprocket: " <> show nodeSprocket diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Transaction.hs index 2588920328e..cb67051f18a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Transaction.hs @@ -74,7 +74,7 @@ hprop_transaction = integrationRetryWorkspace 2 "submit-api-transaction" $ \temp poolNode1 <- H.headM testnetNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ testnetNodeRuntime poolNode1 + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic From bb75b2c16ce74f6acfe56b1370cf60109798c945 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 11 Oct 2024 13:12:53 +0200 Subject: [PATCH 2/2] Remove redundant functions used for starting a process --- cardano-testnet/src/Testnet/Process/Run.hs | 150 ++---------------- cardano-testnet/src/Testnet/Property/Util.hs | 52 +----- cardano-testnet/src/Testnet/Runtime.hs | 6 +- .../Cardano/Testnet/Test/Node/Shutdown.hs | 21 ++- 4 files changed, 28 insertions(+), 201 deletions(-) diff --git a/cardano-testnet/src/Testnet/Process/Run.hs b/cardano-testnet/src/Testnet/Process/Run.hs index 8c0be2f8612..a9c96edc91a 100644 --- a/cardano-testnet/src/Testnet/Process/Run.hs +++ b/cardano-testnet/src/Testnet/Process/Run.hs @@ -17,7 +17,6 @@ module Testnet.Process.Run , mkExecConfig , mkExecConfigOffline , ProcessError(..) - , ExecutableError(..) ) where import Prelude @@ -30,18 +29,12 @@ import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra import Control.Monad.Trans.Resource import qualified Data.Aeson as Aeson -import qualified Data.ByteString.Lazy as LBS -import Data.Function -import qualified Data.List as List import Data.Monoid (Last (..)) import Data.String (fromString) -import qualified Data.Text as Text import GHC.Stack (HasCallStack) import qualified GHC.Stack as GHC -import qualified System.Directory as IO import qualified System.Environment as IO import System.Exit (ExitCode) -import System.FilePath import System.IO import qualified System.IO.Unsafe as IO import qualified System.Process as IO @@ -49,9 +42,7 @@ import System.Process import Hedgehog (MonadTest) import qualified Hedgehog.Extras as H -import Hedgehog.Extras.Internal.Plan (Component (..), Plan (..)) import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO -import qualified Hedgehog.Extras.Stock.OS as OS import Hedgehog.Extras.Test.Process (ExecConfig) import qualified Hedgehog.Internal.Property as H @@ -73,14 +64,14 @@ execCli :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => [String] -> m String -execCli = GHC.withFrozenCallStack $ H.execFlex "cardano-cli" "CARDANO_CLI" +execCli = GHC.withFrozenCallStack $ H.evalM . H.execFlex "cardano-cli" "CARDANO_CLI" -- | Run cardano-cli, discarding return value execCli_ :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => [String] -> m () -execCli_ = GHC.withFrozenCallStack $ void . execCli +execCli_ = GHC.withFrozenCallStack $ void . H.evalM . execCli -- | Run cardano-cli, returning the stdout execCli' @@ -88,7 +79,7 @@ execCli' => ExecConfig -> [String] -> m String -execCli' execConfig = GHC.withFrozenCallStack $ H.execFlex' execConfig "cardano-cli" "CARDANO_CLI" +execCli' execConfig = GHC.withFrozenCallStack $ H.evalM . H.execFlex' execConfig "cardano-cli" "CARDANO_CLI" -- | Run cardano-cli, returning the exit code, the stdout, and the stderr. -- Contrary to other functions from this module, this function doesn't fail the test @@ -98,7 +89,7 @@ execCliAny => ExecConfig -> [String] -> m (ExitCode, String, String) -- ^ The exit code of the call, stdout, stderr. -execCliAny execConfig = GHC.withFrozenCallStack $ H.execFlexAny' execConfig "cardano-cli" "CARDANO_CLI" +execCliAny execConfig = GHC.withFrozenCallStack $ H.evalM . H.execFlexAny' execConfig "cardano-cli" "CARDANO_CLI" -- | Run create-script-context, returning the stdout. execCreateScriptContext @@ -106,7 +97,7 @@ execCreateScriptContext => [String] -> m String execCreateScriptContext = - GHC.withFrozenCallStack $ H.execFlex "create-script-context" "CREATE_SCRIPT_CONTEXT" + GHC.withFrozenCallStack $ H.evalM . H.execFlex "create-script-context" "CREATE_SCRIPT_CONTEXT" -- | Run create-script-context, returning the stdout. execCreateScriptContext' @@ -115,7 +106,7 @@ execCreateScriptContext' -> [String] -> m String execCreateScriptContext' execConfig = - GHC.withFrozenCallStack $ H.execFlex' execConfig "create-script-context" "CREATE_SCRIPT_CONTEXT" + GHC.withFrozenCallStack $ H.evalM . H.execFlex' execConfig "create-script-context" "CREATE_SCRIPT_CONTEXT" -- | Call a command of the CLI that returns JSON to stdout. Then parse it, -- and deserialize it to a Haskell value. Fail the test if a step fails. @@ -139,18 +130,17 @@ procCli -- ^ Arguments to the CLI command -> m CreateProcess -- ^ Captured stdout -procCli = GHC.withFrozenCallStack $ H.procFlex "cardano-cli" "CARDANO_CLI" +procCli = GHC.withFrozenCallStack $ H.evalM . H.procFlex "cardano-cli" "CARDANO_CLI" -- | Create a 'CreateProcess' describing how to start the cardano-node process -- and an argument list. procNode - :: HasCallStack - => MonadIO m + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) => [String] -- ^ Arguments to the CLI command - -> ExceptT ExecutableError m CreateProcess + -> m CreateProcess -- ^ Captured stdout -procNode = GHC.withFrozenCallStack $ procFlexNew "cardano-node" "CARDANO_NODE" +procNode = GHC.withFrozenCallStack $ H.evalM . H.procFlex "cardano-node" "CARDANO_NODE" -- | Create a 'CreateProcess' describing how to start the cardano-submit-api process -- and an argument list. @@ -160,7 +150,7 @@ procSubmitApi -- ^ Arguments to the CLI command -> m CreateProcess -- ^ Captured stdout -procSubmitApi = GHC.withFrozenCallStack $ H.procFlex "cardano-submit-api" "CARDANO_SUBMIT_API" +procSubmitApi = GHC.withFrozenCallStack $ H.evalM . H.procFlex "cardano-submit-api" "CARDANO_SUBMIT_API" -- | Create a 'CreateProcess' describing how to start the cardano-node-chairman process -- and an argument list. @@ -170,7 +160,7 @@ procChairman -- ^ Arguments to the CLI command -> m CreateProcess -- ^ Captured stdout -procChairman = GHC.withFrozenCallStack $ H.procFlex "cardano-node-chairman" "CARDANO_NODE_CHAIRMAN" . ("run":) +procChairman = GHC.withFrozenCallStack $ H.evalM . H.procFlex "cardano-node-chairman" "CARDANO_NODE_CHAIRMAN" . ("run":) mkExecConfig :: () => MonadTest m @@ -236,119 +226,3 @@ resourceAndIOExceptionHandlers = [ Handler $ pure . ProcessIOException , Handler $ pure . ResourceException ] -procFlexNew - :: MonadIO m - => String - -- ^ Cabal package name corresponding to the executable - -> String - -- ^ Environment variable pointing to the binary to run - -> [String] - -- ^ Arguments to the CLI command - -> ExceptT ExecutableError m CreateProcess - -- ^ Captured stdout -procFlexNew = procFlexNew' H.defaultExecConfig - -procFlexNew' - :: MonadIO m - => H.ExecConfig - -> String - -- ^ Cabal package name corresponding to the executable - -> String - -- ^ Environment variable pointing to the binary to run - -> [String] - -- ^ Arguments to the CLI command - -> ExceptT ExecutableError m CreateProcess - -- ^ Captured stdout -procFlexNew' execConfig pkg binaryEnv arguments = GHC.withFrozenCallStack $ do - bin <- binFlexNew pkg binaryEnv - pure (IO.proc bin arguments) - { IO.env = getLast $ H.execConfigEnv execConfig - , IO.cwd = getLast $ H.execConfigCwd execConfig - -- this allows sending signals to the created processes, without killing the test-suite process - , IO.create_group = True - } - --- | Compute the path to the binary given a package name or an environment variable override. -binFlexNew - :: MonadIO m - => String - -- ^ Package name - -> String - -- ^ Environment variable pointing to the binary to run - -> ExceptT ExecutableError m FilePath - -- ^ Path to executable -binFlexNew pkg binaryEnv = do - maybeEnvBin <- liftIO $ IO.lookupEnv binaryEnv - case maybeEnvBin of - Just envBin -> return envBin - Nothing -> binDist pkg - --- | Find the nearest plan.json going upwards from the current directory. -findDefaultPlanJsonFile :: IO FilePath -findDefaultPlanJsonFile = IO.getCurrentDirectory >>= go - where go :: FilePath -> IO FilePath - go d = do - let file = d "dist-newstyle/cache/plan.json" - exists <- IO.doesFileExist file - if exists - then return file - else do - let parent = takeDirectory d - if parent == d - then return "dist-newstyle/cache/plan.json" - else go parent - - --- | Discover the location of the plan.json file. -planJsonFile :: IO FilePath -planJsonFile = do - maybeBuildDir <- liftIO $ IO.lookupEnv "CABAL_BUILDDIR" - case maybeBuildDir of - Just buildDir -> return $ ".." buildDir "cache/plan.json" - Nothing -> findDefaultPlanJsonFile -{-# NOINLINE planJsonFile #-} - -data ExecutableError - = CannotDecodePlanJSON FilePath String - | RetrievePlanJsonFailure IOException - | ReadFileFailure IOException - | ExecutableMissingInComponent FilePath String - -- ^ Component with key @component-name@ is found, but it is missing - -- the @bin-file@ key. - | ExecutableNotFoundInPlan String - -- ^ Component with key @component-name@ cannot be found - deriving Show - - --- | Consult the "plan.json" generated by cabal to get the path to the executable corresponding. --- to a haskell package. It is assumed that the project has already been configured and the --- executable has been built. -binDist - :: MonadIO m - => String - -- ^ Package name - -> ExceptT ExecutableError m FilePath - -- ^ Path to executable -binDist pkg = do - pJsonFp <- handleIOExceptT RetrievePlanJsonFailure planJsonFile - contents <- handleIOExceptT ReadFileFailure $ LBS.readFile pJsonFp - - case Aeson.eitherDecode contents of - Right plan -> case List.filter matching (plan & installPlan) of - (component:_) -> case component & binFile of - Just bin -> return $ addExeSuffix (Text.unpack bin) - Nothing -> left $ ExecutableMissingInComponent pJsonFp $ "missing \"bin-file\" key in plan component: " <> show component - [] -> left $ ExecutableNotFoundInPlan $ "Cannot find \"component-name\" key with value \"exe:" <> pkg <> "\"" - Left message -> left $ CannotDecodePlanJSON pJsonFp $ "Cannot decode plan: " <> message - where matching :: Component -> Bool - matching component = case componentName component of - Just name -> name == Text.pack ("exe:" <> pkg) - Nothing -> False - -addExeSuffix :: String -> String -addExeSuffix s = if ".exe" `List.isSuffixOf` s - then s - else s <> exeSuffix - -exeSuffix :: String -exeSuffix = if OS.isWin32 then ".exe" else "" diff --git a/cardano-testnet/src/Testnet/Property/Util.hs b/cardano-testnet/src/Testnet/Property/Util.hs index 4453ed9dbcd..9db518d81c7 100644 --- a/cardano-testnet/src/Testnet/Property/Util.hs +++ b/cardano-testnet/src/Testnet/Property/Util.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -16,23 +15,14 @@ module Testnet.Property.Util import Cardano.Api -import Control.Exception.Safe -import Control.Monad -import Control.Monad.Trans.Resource -import qualified Control.Retry as R import qualified Data.Aeson as Aeson import GHC.Stack -import qualified System.Directory as IO import qualified System.Environment as IO -import System.FilePath (()) import System.Info (os) -import qualified System.IO as IO -import qualified System.IO.Temp as IO import qualified System.IO.Unsafe as IO import qualified Hedgehog as H import qualified Hedgehog.Extras as H -import qualified Hedgehog.Extras.Stock.CallStack as H import Hedgehog.Internal.Property (MonadTest) @@ -53,52 +43,16 @@ integrationRetryWorkspace n workspaceName f = withFrozenCallStack $ if disableRetries then integration $ - H.runFinallies $ workspace (workspaceName <> "-no-retries") f + H.runFinallies $ H.workspace (workspaceName <> "-no-retries") f else integration $ H.retry n $ \i -> - H.runFinallies $ workspace (workspaceName <> "-" <> show i) f - --- | Create a workspace directory which will exist for at least the duration of --- the supplied block. --- --- The directory will have the supplied prefix but contain a generated random --- suffix to prevent interference between tests --- --- The directory will be deleted if the block succeeds, but left behind if --- the block fails. --- TODO: this is a version which retries deleting of a workspace on exception - upstream to hedgehog-extras -workspace - :: MonadTest m - => HasCallStack - => MonadResource m - => FilePath - -> (FilePath -> m ()) - -> m () -workspace prefixPath f = withFrozenCallStack $ do - systemTemp <- H.evalIO IO.getCanonicalTemporaryDirectory - maybeKeepWorkspace <- H.evalIO $ IO.lookupEnv "KEEP_WORKSPACE" - ws <- H.evalIO $ IO.createTempDirectory systemTemp $ prefixPath <> "-test" - H.annotate $ "Workspace: " <> ws - H.evalIO $ IO.writeFile (ws "module") H.callerModuleName - f ws - when (os /= "mingw32" && maybeKeepWorkspace /= Just "1") $ do - -- try to delete the directory 5 times, 100ms apart - let retryPolicy = R.constantDelay 100_000 <> R.limitRetries 10 - -- retry only on IOExceptions - ioExH _ = Handler $ \(_ :: IOException) -> pure True - -- For some reason, the temporary directory removal sometimes fails. - -- Lets wrap this in MonadResource try multiple times before we fail. - void - . register - . R.recovering retryPolicy [ioExH] - . const - $ IO.removePathForcibly ws + H.runFinallies $ H.workspace (workspaceName <> "-" <> show i) f -- | The 'FilePath' in '(FilePath -> H.Integration ())' is the work space directory. -- This is created (and returned) via 'H.workspace'. integrationWorkspace :: HasCallStack => FilePath -> (FilePath -> H.Integration ()) -> H.Property integrationWorkspace workspaceName f = withFrozenCallStack $ - integration $ H.runFinallies $ workspace workspaceName f + integration $ H.runFinallies $ H.workspace workspaceName f isLinux :: Bool isLinux = os == "linux" diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index e4471a773e8..b11b726cdb7 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -60,7 +60,7 @@ import qualified Hedgehog.Extras.Test.Concurrent as H data NodeStartFailure = ProcessRelatedFailure ProcessError - | ExecutableRelatedFailure ExecutableError + | ExecutableRelatedFailure SomeException | FileRelatedFailure IOException | NodeExecutableError (Doc Ann) | NodeAddressAlreadyInUseError (Doc Ann) @@ -143,8 +143,8 @@ startNode tp node ipv4 port testnetMagic nodeCmd = GHC.withFrozenCallStack $ do let socketAbsPath = H.sprocketSystemName sprocket nodeProcess - <- firstExceptT ExecutableRelatedFailure - $ hoistExceptT liftIO $ procNode $ mconcat + <- newExceptT . fmap (first ExecutableRelatedFailure) . try + $ procNode $ mconcat [ nodeCmd , [ "--socket-path", H.sprocketArgumentName sprocket , "--port", show port 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 bf96df3a827..761cfa67844 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 @@ -141,17 +141,16 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H -- Run cardano-node with pipe as stdin. Use 0 file descriptor as shutdown-ipc - eRes <- H.evalIO . runExceptT $ procNode - [ "run" - , "--config", tempAbsPath' "configuration.yaml" - , "--topology", tempAbsPath' "mainnet-topology.json" - , "--database-path", tempAbsPath' "db" - , "--socket-path", IO.sprocketArgumentName sprocket - , "--host-addr", "127.0.0.1" - , "--port", show @Int port - , "--shutdown-ipc", "0" - ] - res <- H.evalEither eRes + res <- procNode + [ "run" + , "--config", tempAbsPath' "configuration.yaml" + , "--topology", tempAbsPath' "mainnet-topology.json" + , "--database-path", tempAbsPath' "db" + , "--socket-path", IO.sprocketArgumentName sprocket + , "--host-addr", "127.0.0.1" + , "--port", show @Int port + , "--shutdown-ipc", "0" + ] let process = res { IO.std_in = IO.CreatePipe , IO.std_out = IO.UseHandle hNodeStdout , IO.std_err = IO.UseHandle hNodeStderr