diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 813a3830255..bc12ed026ad 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -74,7 +74,7 @@ library , scientific , si-timers , stm - , tasty + , tasty ^>= 1.5 , tasty-expected-failure , tasty-hedgehog , text @@ -89,6 +89,7 @@ library Testnet.Start.Byron Testnet.Start.Types Testnet.Components.Configuration + Testnet.Components.DReps Testnet.Components.SPO Testnet.Components.Query Testnet.Defaults @@ -152,7 +153,7 @@ test-suite cardano-testnet-golden , hedgehog-extras , process , regex-compat - , tasty + , tasty ^>= 1.5 , tasty-hedgehog , text @@ -185,6 +186,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution Cardano.Testnet.Test.LedgerEvents.Gov.InfoAction Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO + Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits Cardano.Testnet.Test.LedgerEvents.SanityCheck Cardano.Testnet.Test.LedgerEvents.TreasuryGrowth @@ -220,7 +222,7 @@ test-suite cardano-testnet-test , mtl , process , regex-compat - , tasty + , tasty ^>= 1.5 , text , time , transformers diff --git a/cardano-testnet/src/Testnet/Components/DReps.hs b/cardano-testnet/src/Testnet/Components/DReps.hs new file mode 100644 index 00000000000..e3be276897f --- /dev/null +++ b/cardano-testnet/src/Testnet/Components/DReps.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} + +module Testnet.Components.DReps + ( generateDRepKeyPair + , generateRegistrationCertificate + , createDRepRegistrationTxBody + , signTx + , submitTx + , failToSubmitTx + ) where + +import Cardano.Api (AnyCardanoEra (..), FileDirection (In), ShelleyBasedEra (..), + renderTxIn) + +import Cardano.CLI.Types.Common (File (..)) + +import Prelude + +import Control.Monad (void) +import Control.Monad.Catch (MonadCatch) +import Control.Monad.IO.Class (MonadIO) +import qualified Data.Text as Text +import GHC.IO.Exception (ExitCode (..)) +import GHC.Stack (HasCallStack) +import qualified GHC.Stack as GHC +import System.FilePath (()) + +import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey) +import qualified Testnet.Process.Run as H +import Testnet.Runtime (PaymentKeyInfo (paymentKeyInfoAddr), PaymentKeyPair (..)) +import Testnet.Start.Types (anyEraToString) + +import Hedgehog (MonadTest) +import qualified Hedgehog.Extras as H + +-- | Generates a key pair for a decentralized representative (DRep) using @cardano-cli@. +-- +-- The function takes three parameters: +-- +-- * 'execConfig': Specifies the CLI execution configuration. +-- * 'work': Base directory path where keys will be stored. +-- * 'prefix': Name for the subfolder that will be created under 'work' folder to store the output keys. +-- +-- Returns the generated 'PaymentKeyPair' containing paths to the verification and +-- signing key files. +generateDRepKeyPair :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + => H.ExecConfig + -> FilePath + -> String + -> m PaymentKeyPair +generateDRepKeyPair execConfig work prefix = do + baseDir <- H.createDirectoryIfMissing $ work prefix + let dRepKeyPair = PaymentKeyPair { paymentVKey = baseDir "verification.vkey" + , paymentSKey = baseDir "signature.skey" + } + void $ H.execCli' execConfig [ "conway", "governance", "drep", "key-gen" + , "--verification-key-file", paymentVKey dRepKeyPair + , "--signing-key-file", paymentSKey dRepKeyPair + ] + return dRepKeyPair + +-- DRep registration certificate generation + +data DRepRegistrationCertificate + +-- | Generates a registration certificate for a decentralized representative (DRep) +-- using @cardano-cli@. +-- +-- The function takes five parameters: +-- +-- * 'execConfig': Specifies the CLI execution configuration. +-- * 'work': Base directory path where the certificate file will be stored. +-- * 'prefix': Prefix for the output certificate file name. The extension will be @.regcert@. +-- * 'drepKeyPair': Payment key pair associated with the DRep. Can be generated using +-- 'generateDRepKeyPair'. +-- * 'depositAmount': Deposit amount required for DRep registration. The right amount +-- can be obtained using 'getMinDRepDeposit'. +-- +-- Returns the generated @File DRepRegistrationCertificate In@ file path to the +-- registration certificate. +generateRegistrationCertificate + :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack) + => H.ExecConfig + -> FilePath + -> String + -> PaymentKeyPair + -> Integer + -> m (File DRepRegistrationCertificate In) +generateRegistrationCertificate execConfig work prefix drepKeyPair depositAmount = do + let dRepRegistrationCertificate = File (work prefix <> ".regcert") + void $ H.execCli' execConfig [ "conway", "governance", "drep", "registration-certificate" + , "--drep-verification-key-file", paymentVKey drepKeyPair + , "--key-reg-deposit-amt", show @Integer depositAmount + , "--out-file", unFile dRepRegistrationCertificate + ] + return dRepRegistrationCertificate + +-- DRep registration transaction composition (without signing) + +data TxBody + +-- | Composes a decentralized representative (DRep) registration transaction body +-- (without signing) using @cardano-cli@. +-- +-- This function takes seven parameters: +-- +-- * 'execConfig': Specifies the CLI execution configuration. +-- * 'epochStateView': Current epoch state view for transaction building. It can be obtained +-- using the 'getEpochStateView' function. +-- * 'sbe': The Shelley-based era (e.g., 'ShelleyEra') in which the transaction will be constructed. +-- * 'work': Base directory path where the transaction body file will be stored. +-- * 'prefix': Prefix for the output transaction body file name. The extension will be @.txbody@. +-- * 'drepRegCert': The file name of the registration certificate for the DRep, obtained using +-- 'generateRegistrationCertificate'. +-- * 'wallet': Payment key information associated with the transaction, +-- as returned by 'cardanoTestnetDefault'. +-- +-- Returns the generated @File TxBody In@ file path to the transaction body. +createDRepRegistrationTxBody + :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig + -> EpochStateView + -> ShelleyBasedEra era + -> FilePath + -> String + -> File DRepRegistrationCertificate In + -> PaymentKeyInfo + -> m (File TxBody In) +createDRepRegistrationTxBody execConfig epochStateView sbe work prefix drepRegCert wallet = do + let dRepRegistrationTxBody = File (work prefix <> ".txbody") + walletLargestUTXO <- findLargestUtxoForPaymentKey epochStateView sbe wallet + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet + , "--tx-in", Text.unpack $ renderTxIn walletLargestUTXO + , "--certificate-file", unFile drepRegCert + , "--witness-override", show @Int 2 + , "--out-file", unFile dRepRegistrationTxBody + ] + return dRepRegistrationTxBody + +-- Transaction signing + +data SignedTx + +-- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs. +-- +-- This function takes five parameters: +-- +-- * 'execConfig': Specifies the CLI execution configuration. +-- * 'cEra': Specifies the current Cardano era. +-- * 'work': Base directory path where the signed transaction file will be stored. +-- * 'prefix': Prefix for the output signed transaction file name. The extension will be @.tx@. +-- * 'txBody': Transaction body to be signed, obtained using 'createDRepRegistrationTxBody' or similar. +-- * 'signatoryKeyPairs': List of payment key pairs used for signing the transaction. +-- +-- Returns the generated @File SignedTx In@ file path to the signed transaction file. +signTx :: (MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig + -> AnyCardanoEra + -> FilePath + -> String + -> File TxBody In + -> [PaymentKeyPair] + -> m (File SignedTx In) +signTx execConfig cEra work prefix txBody signatoryKeyPairs = do + let signedTx = File (work prefix <> ".tx") + void $ H.execCli' execConfig $ + [ anyEraToString cEra, "transaction", "sign" + , "--tx-body-file", unFile txBody + ] ++ (concat [["--signing-key-file", paymentSKey kp] | kp <- signatoryKeyPairs]) ++ + [ "--out-file", unFile signedTx + ] + return signedTx + +-- | Submits a signed transaction using @cardano-cli@. +-- +-- This function takes two parameters: +-- +-- * 'execConfig': Specifies the CLI execution configuration. +-- * 'cEra': Specifies the current Cardano era. +-- * 'signedTx': Signed transaction to be submitted, obtained using 'signTx'. +submitTx + :: (MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig + -> AnyCardanoEra + -> File SignedTx In + -> m () +submitTx execConfig cEra signedTx = + void $ H.execCli' execConfig + [ anyEraToString cEra, "transaction", "submit" + , "--tx-file", unFile signedTx + ] + +-- | Attempts to submit a transaction that is expected to fail using @cardano-cli@. +-- +-- This function takes two parameters: +-- +-- * 'execConfig': Specifies the CLI execution configuration. +-- * 'cEra': Specifies the current Cardano era. +-- * 'signedTx': Signed transaction to be submitted, obtained using 'signTx'. +-- +-- If the submission fails (the expected behavior), the function succeeds. +-- If the submission succeeds unexpectedly, it raises a failure message that is +-- meant to be caught by @Hedgehog@. +failToSubmitTx + :: (MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig + -> AnyCardanoEra + -> File SignedTx In + -> m () +failToSubmitTx execConfig cEra signedTx = GHC.withFrozenCallStack $ do + (exitCode, _, _) <- H.execFlexAny' execConfig "cardano-cli" "CARDANO_CLI" + [ anyEraToString cEra, "transaction", "submit" + , "--tx-file", unFile signedTx + ] + case exitCode of + ExitSuccess -> H.failMessage GHC.callStack "Transaction submission was expected to fail but it succeeded" + _ -> return () diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 2200c738f10..5338b01897e 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -9,6 +9,7 @@ module Testnet.Components.Query ( QueryTip , EpochStateView , checkDRepsNumber + , checkDRepState , getEpochState , getMinDRepDeposit , queryTip @@ -22,8 +23,7 @@ module Testnet.Components.Query ) where import Cardano.Api as Api -import Cardano.Api.Ledger (StandardCrypto) -import qualified Cardano.Api.Ledger as L +import Cardano.Api.Ledger (Credential, DRepState, KeyRole (DRepRole), StandardCrypto) import Cardano.Api.Shelley (ShelleyLedgerEra, fromShelleyTxIn, fromShelleyTxOut) import Cardano.CLI.Types.Output @@ -238,55 +238,62 @@ checkDRepsNumber :: -> H.ExecConfig -> Int -> m () -checkDRepsNumber sbe configurationFile socketPath execConfig expectedDRepsNb = do - QueryTipLocalStateOutput{mEpoch} <- P.execCliStdoutToJson execConfig [ "query", "tip" ] - currentEpoch <- H.evalMaybe mEpoch - let terminationEpoch = succ . succ $ currentEpoch - void $ H.evalMaybeM $ checkDRepsNumber' sbe configurationFile socketPath terminationEpoch expectedDRepsNb +checkDRepsNumber sbe configurationFile socketPath execConfig expectedDRepsNb = + checkDRepState sbe configurationFile socketPath execConfig + (\m -> if length m == expectedDRepsNb then Just () else Nothing) --- | @checkDRepsNumber' config socket terminationEpoch n@ --- wait until @terminationEpoch@ for the number of DReps being @n@. If --- this number is not attained before @terminationEpoch@, the test is failed. --- So if you call this function, you are expecting the number of DReps to already --- be @n@, or to be @n@ before @terminationEpoch@ -checkDRepsNumber' :: +-- | @checkDRepState sbe configurationFile socketPath execConfig f@ +-- This functions helps check properties about the DRep state. +-- It waits up to two epochs for the result of applying @f@ to the DRepState +-- to become 'Just'. If @f@ keeps returning 'Nothing' the test fails. +-- If @f@ returns 'Just', the contents of the 'Just' are returned. +checkDRepState :: (HasCallStack, MonadCatch m, MonadIO m, MonadTest m) => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs -> NodeConfigFile In -> SocketPath - -> EpochNo -- ^ The termination epoch: the constitution proposal must be found *before* this epoch - -> Int -- ^ The expected numbers of DReps. If this number is not reached until the termination epoch, this function fails the test. - -> m (Maybe [L.DRepState StandardCrypto]) -- ^ The DReps when the expected number of DReps was attained. -checkDRepsNumber' sbe nodeConfigFile socketPath maxEpoch expectedDRepsNb = do - result <- runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing + -> H.ExecConfig + -> (Map (Credential 'DRepRole StandardCrypto) + (DRepState StandardCrypto) -> Maybe a) -- ^ A function that checks whether the DRep state is correct or up to date + -- and potentially inspects it. + -> m a +checkDRepState sbe configurationFile socketPath execConfig f = do + QueryTipLocalStateOutput{mEpoch} <- P.execCliStdoutToJson execConfig [ "query", "tip" ] + currentEpoch <- H.evalMaybe mEpoch + let terminationEpoch = succ . succ $ currentEpoch + result <- runExceptT $ foldEpochState configurationFile socketPath QuickValidation terminationEpoch Nothing $ \(AnyNewEpochState actualEra newEpochState) _slotNb _blockNb -> do case testEquality sbe actualEra of Just Refl -> do - let dreps = Map.elems $ shelleyBasedEraConstraints sbe newEpochState - ^. L.nesEsL - . L.esLStateL - . L.lsCertStateL - . L.certVStateL - . L.vsDRepsL - if length dreps == expectedDRepsNb then do - put $ Just dreps - pure ConditionMet - else - pure ConditionNotMet + let dreps = shelleyBasedEraConstraints sbe newEpochState + ^. L.nesEsL + . L.esLStateL + . L.lsCertStateL + . L.certVStateL + . L.vsDRepsL + case f dreps of + Nothing -> pure ConditionNotMet + Just a -> do put $ Just a + pure ConditionMet Nothing -> do error $ "Eras mismatch! expected: " <> show sbe <> ", actual: " <> show actualEra case result of Left (FoldBlocksApplyBlockError (TerminationEpochReached epochNo)) -> do H.note_ $ unlines - [ "waitDRepsNumber: drep number did not become " <> show expectedDRepsNb <> " before termination epoch: " <> show epochNo + [ "checkDRepState: condition not met before termination epoch: " <> show epochNo , "This is likely an error of this test." ] H.failure Left err -> do H.note_ $ unlines - [ "waitDRepsNumber: could not reach termination epoch: " <> docToString (prettyError err) + [ "checkDRepState: could not reach termination epoch: " <> docToString (prettyError err) , "This is probably an error unrelated to this test." ] H.failure - Right (_, val) -> + Right (_, Nothing) -> do + H.note_ $ unlines + [ "checkDRepState: foldEpochState returned Nothing: " + , "This is probably an error related to foldEpochState." ] + H.failure + Right (_, Just val) -> return val -- | Obtain minimum deposit amount for DRep registration from node @@ -304,4 +311,3 @@ getMinDRepDeposit execConfig = do . _Integral H.evalMaybe mMinDRepDeposit - diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs new file mode 100644 index 00000000000..95ccdd1fcdb --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits + ( hprop_ledger_events_drep_deposits + ) where + +import Cardano.Api (AnyCardanoEra (..), File (..), ShelleyBasedEra (..), + ToCardanoEra (..)) +import qualified Cardano.Api.Ledger as L + +import Cardano.Testnet + (CardanoTestnetOptions (cardanoEpochLength, cardanoNodeEra, cardanoNumDReps), + Conf (Conf, tempAbsPath), NodeRuntime (nodeSprocket), + TmpAbsolutePath (unTmpAbsPath), cardanoDefaultTestnetOptions, + cardanoTestnetDefault, makeTmpBaseAbsPath, mkConf) + +import Prelude + +import qualified Data.Map as Map +import System.FilePath (()) + +import Testnet.Components.DReps (createDRepRegistrationTxBody, failToSubmitTx, + generateDRepKeyPair, generateRegistrationCertificate, signTx, submitTx) +import Testnet.Components.Query (checkDRepState, getEpochStateView, getMinDRepDeposit) +import qualified Testnet.Process.Run as H +import qualified Testnet.Property.Utils as H +import Testnet.Runtime (PaymentKeyInfo (paymentKeyInfoPair), PoolNode (poolRuntime), + TestnetRuntime (TestnetRuntime, configurationFile, poolNodes, testnetMagic, wallets)) + +import Hedgehog (Property) +import qualified Hedgehog.Extras as H +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO + + +-- | Execute me with: +-- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/DRep Deposits/"'@ +hprop_ledger_events_drep_deposits :: Property +hprop_ledger_events_drep_deposits = H.integrationWorkspace "drep-deposits" $ \tempAbsBasePath' -> do + + -- Start a local test net + conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + let sbe = ShelleyBasedEraConway + era = toCardanoEra sbe + cEra = AnyCardanoEra era + fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoNodeEra = cEra + , cardanoNumDReps = 0 + } + + TestnetRuntime + { testnetMagic + , poolNodes + , wallets=wallet0:wallet1:_ + , configurationFile + } + <- cardanoTestnetDefault fastTestnetOptions conf + + poolNode1 <- H.headM poolNodes + poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + + let socketName' = IO.sprocketName poolSprocket1 + socketBase = IO.sprocketBase poolSprocket1 -- /tmp + socketPath = socketBase socketName' + + epochStateView <- getEpochStateView (File configurationFile) (File socketPath) + + H.note_ $ "Sprocket: " <> show poolSprocket1 + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> socketPath + H.note_ $ "Foldblocks config file: " <> configurationFile + + gov <- H.createDirectoryIfMissing $ work "governance" + + minDRepDeposit <- getMinDRepDeposit execConfig + + -- DRep 1 (not enough deposit) + + drepDir1 <- H.createDirectoryIfMissing $ gov "drep1" + + drepKeyPair1 <- generateDRepKeyPair execConfig drepDir1 "keys" + drepRegCert1 <- generateRegistrationCertificate execConfig drepDir1 "reg-cert" + drepKeyPair1 (minDRepDeposit - 1) + drepRegTxBody1 <- createDRepRegistrationTxBody execConfig epochStateView sbe drepDir1 "reg-cert-txbody" + drepRegCert1 wallet0 + drepSignedRegTx1 <- signTx execConfig cEra drepDir1 "signed-reg-tx" + drepRegTxBody1 [drepKeyPair1, paymentKeyInfoPair wallet0] + + failToSubmitTx execConfig cEra drepSignedRegTx1 + + -- DRep 2 (enough deposit) + + drepDir2 <- H.createDirectoryIfMissing $ gov "drep2" + + drepKeyPair2 <- generateDRepKeyPair execConfig drepDir2 "keys" + drepRegCert2 <- generateRegistrationCertificate execConfig drepDir2 "reg-cert" + drepKeyPair2 minDRepDeposit + drepRegTxBody2 <- createDRepRegistrationTxBody execConfig epochStateView sbe drepDir2 "reg-cert-txbody" + drepRegCert2 wallet1 + drepSignedRegTx2 <- signTx execConfig cEra drepDir2 "signed-reg-tx" + drepRegTxBody2 [drepKeyPair2, paymentKeyInfoPair wallet1] + + submitTx execConfig cEra drepSignedRegTx2 + + checkDRepState sbe (File configurationFile) (File socketPath) execConfig + (\m -> if map L.drepDeposit (Map.elems m) == [L.Coin minDRepDeposit] then Just () else Nothing) + + diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs index 5b5d8c9d69e..780ad41b140 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs @@ -74,7 +74,6 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n cEra = AnyCardanoEra era fastTestnetOptions = cardanoDefaultTestnetOptions { cardanoEpochLength = 100 - , cardanoSlotLength = 0.1 , cardanoNodeEra = cEra , cardanoNumDReps = numVotes } diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index 7870e463193..a5e4fc09b0e 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -14,6 +14,7 @@ import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.Queries import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks +import qualified Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitutionSPO as LedgerEvents import qualified Cardano.Testnet.Test.LedgerEvents.SanityCheck as LedgerEvents @@ -24,6 +25,8 @@ import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction import Prelude import qualified System.Environment as E +import qualified System.Exit as IO +import qualified System.IO as IO import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8) import qualified Testnet.Property.Run as H @@ -31,40 +34,42 @@ import qualified Testnet.Property.Run as H import qualified Test.Tasty as T import Test.Tasty (TestTree) import qualified Test.Tasty.Ingredients as T +import qualified Test.Tasty.Options as T +import qualified Test.Tasty.Runners as T tests :: IO TestTree tests = do - testGroup <- runTestGroup <$> shouldRunInParallel - pure $ testGroup "test/Spec.hs" - [ testGroup "Spec" - [ testGroup "Ledger Events" + pure $ T.testGroup "test/Spec.hs" + [ T.testGroup "Spec" + [ T.testGroup "Ledger Events" [ H.ignoreOnWindows "Sanity Check" LedgerEvents.hprop_ledger_events_sanity_check , H.ignoreOnWindows "Treasury Growth" LedgerEvents.prop_check_if_treasury_is_growing -- TODO: Replace foldBlocks with checkLedgerStateCondition - , testGroup "Governance" + , T.testGroup "Governance" [ H.ignoreOnMacAndWindows "ProposeAndRatifyNewConstitution" Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution.hprop_ledger_events_propose_new_constitution + , H.ignoreOnWindows "DRep Deposits" Cardano.Testnet.Test.LedgerEvents.Gov.DRepDeposits.hprop_ledger_events_drep_deposits -- FIXME Those tests are flaky -- , H.ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action , H.ignoreOnWindows "ProposeNewConstitutionSPO" LedgerEvents.hprop_ledger_events_propose_new_constitution_spo , H.ignoreOnWindows "DRepRetirement" DRepRetirement.hprop_drep_retirement ] - , testGroup "Plutus" + , T.testGroup "Plutus" [ H.ignoreOnWindows "PlutusV3" Cardano.Testnet.Test.Cli.Conway.Plutus.hprop_plutus_v3] ] - , testGroup "CLI" + , T.testGroup "CLI" [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown -- ShutdownOnSigint fails on Mac with -- "Log file: /private/tmp/tmp.JqcjW7sLKS/kes-period-info-2-test-30c2d0d8eb042a37/logs/test-spo.stdout.log had no logs indicating the relevant node has minted blocks." , H.ignoreOnMacAndWindows "ShutdownOnSigint" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSigint -- ShutdownOnSlotSynced FAILS Still. The node times out and it seems the "shutdown-on-slot-synced" flag does nothing -- , H.ignoreOnWindows "ShutdownOnSlotSynced" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdownOnSlotSynced - , testGroup "Babbage" + , T.testGroup "Babbage" [ H.ignoreOnMacAndWindows "leadership-schedule" Cardano.Testnet.Test.Cli.Babbage.LeadershipSchedule.hprop_leadershipSchedule -- FAILS , H.ignoreOnWindows "stake-snapshot" Cardano.Testnet.Test.Cli.Babbage.StakeSnapshot.hprop_stakeSnapshot , H.ignoreOnWindows "transaction" Cardano.Testnet.Test.Cli.Babbage.Transaction.hprop_transaction ] -- TODO: Conway - Re-enable when create-staked is working in conway again - --, testGroup "Conway" + --, T.testGroup "Conway" -- [ H.ignoreOnWindows "stake-snapshot" Cardano.Testnet.Test.Cli.Conway.StakeSnapshot.hprop_stakeSnapshot -- ] -- Ignored on Windows due to : commitBuffer: invalid argument (invalid character) @@ -75,27 +80,27 @@ tests = do , H.ignoreOnWindows "CliQueries" Cardano.Testnet.Test.Cli.Queries.hprop_cli_queries ] ] - , testGroup "SubmitApi" - [ testGroup "Babbage" + , T.testGroup "SubmitApi" + [ T.testGroup "Babbage" [ H.ignoreOnWindows "transaction" Cardano.Testnet.Test.SubmitApi.Babbage.Transaction.hprop_transaction ] ] ] -shouldRunInParallel :: IO Bool -shouldRunInParallel = (== Just "1") <$> E.lookupEnv "PARALLEL_TESTNETS" +defaultMainWithIngredientsAndOptions :: [T.Ingredient] -> T.OptionSet -> T.TestTree -> IO () +defaultMainWithIngredientsAndOptions ins opts testTree = do + T.installSignalHandlers + parsedOpts <- T.parseOptions ins testTree + let opts' = opts <> parsedOpts --- FIXME Right now when running tests concurrently it makes them flaky -runTestGroup - :: Bool -- ^ True to run in parallel - -> T.TestName - -> [TestTree] - -> TestTree -runTestGroup True name = T.testGroup name -runTestGroup False name = T.sequentialTestGroup name T.AllFinish - -ingredients :: [T.Ingredient] -ingredients = T.defaultIngredients + case T.tryIngredients ins opts' testTree of + Nothing -> do + IO.hPutStrLn IO.stderr + "No ingredients agreed to run. Something is wrong either with your ingredient set or the options." + IO.exitFailure + Just act -> do + ok <- act + if ok then IO.exitSuccess else IO.exitFailure main :: IO () main = do @@ -105,4 +110,6 @@ main = do hSetEncoding stdout utf8 args <- E.getArgs - E.withArgs args $ tests >>= T.defaultMainWithIngredients ingredients + let opts = T.singleOption $ T.NumThreads 1 + + E.withArgs args $ tests >>= defaultMainWithIngredientsAndOptions T.defaultIngredients opts