From 4d01928e7eac3d4b5211c1b3b36a709ec8da60c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 29 May 2024 16:42:59 +0200 Subject: [PATCH] cardano-testnet: Test treasury donation --- cardano-testnet/cardano-testnet.cabal | 1 + .../src/Testnet/Components/Query.hs | 13 ++ .../Testnet/Test/Gov/TreasuryDonation.hs | 149 ++++++++++++++++++ .../cardano-testnet-test.hs | 2 + 4 files changed, 165 insertions(+) create mode 100644 cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index c95c0502ff8..d7f550acd71 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -197,6 +197,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.ProposeNewConstitution Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO Cardano.Testnet.Test.Gov.GovActionTimeout + Cardano.Testnet.Test.Gov.TreasuryDonation Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal Cardano.Testnet.Test.Misc diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 020e6770ba8..226bc232f7e 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -20,6 +20,7 @@ module Testnet.Components.Query , getMinGovActionDeposit , getGovState , getCurrentEpochNo + , getTreasuryValue , TestnetWaitPeriod (..) , waitForEpochs @@ -466,6 +467,18 @@ getGovState epochStateView ceo = withFrozenCallStack $ do Refl <- H.leftFail $ assertErasEqual sbe sbe' pure $ conwayEraOnwardsConstraints ceo $ newEpochState ^. L.newEpochStateGovStateL +-- | Obtain the current value of the treasury from the node +getTreasuryValue + :: HasCallStack + => MonadAssertion m + => MonadIO m + => MonadTest m + => EpochStateView + -> m L.Coin -- ^ The current value of the treasury +getTreasuryValue epochStateView = withFrozenCallStack $ do + AnyNewEpochState _ newEpochState <- getEpochState epochStateView + pure $ newEpochState ^. L.nesEpochStateL . L.epochStateTreasuryL + -- | Obtain minimum deposit amount for governance action from node getMinGovActionDeposit :: HasCallStack 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 new file mode 100644 index 00000000000..c3ca218a8d9 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Testnet.Test.Gov.TreasuryDonation + ( hprop_ledger_events_treasury_donation + ) where + +import Cardano.Api +import Cardano.Api.Ledger + +import qualified Cardano.Ledger.Coin as L +import Cardano.Testnet + +import Prelude + +import Control.Monad.Catch (MonadCatch) +import Control.Monad (void, when) +import qualified Data.Text as Text +import GHC.Stack (HasCallStack) +import System.Exit +import System.FilePath (()) + +import Testnet.Components.Query +import Testnet.Process.Run (execCli', execCliAny, mkExecConfig) +import Testnet.Property.Util (integrationWorkspace) +import Testnet.Types + +import Hedgehog +import qualified Hedgehog as H +import qualified Hedgehog.Extras as H + +{- HLINT ignore "Use unless" -} + +-- | Test that donating to the treasury indeed increases the treasury +-- 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 + conf@Conf { tempAbsPath=tempAbsPath@(TmpAbsolutePath work) } + <- mkConf tempAbsBasePath' + let tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath + + let ceo = ConwayEraOnwardsConway + sbe = conwayEraOnwardsToShelleyBasedEra ceo + era = toCardanoEra sbe + cEra = AnyCardanoEra era + fastTestnetOptions = cardanoDefaultTestnetOptions + { cardanoEpochLength = 100 + , cardanoSlotLength = 0.1 + , cardanoNodeEra = cEra + } + + TestnetRuntime + { testnetMagic + , poolNodes + , wallets=wallet0:_ + , configurationFile + } + <- cardanoTestnetDefault fastTestnetOptions conf + + PoolNode{poolRuntime} <- H.headM poolNodes + poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime + execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + let socketPath = nodeSocketPath poolRuntime + + epochStateView <- getEpochStateView configurationFile socketPath + + H.note_ $ "Sprocket: " <> show poolSprocket1 + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> unFile socketPath + H.note_ $ "Foldblocks config file: " <> unFile configurationFile + + L.Coin currentTreasury <- getTreasuryValue epochStateView + H.note_ $ "currentTreasury: " <> show currentTreasury + currentTreasury H.=== 0 -- Treasury should initially be 0 + + let doOneDonation = doTreasuryDonation sbe execConfig work epochStateView wallet0 + + doOneDonation 0 Nothing 500 + doOneDonation 1 Nothing 500_013 + doOneDonation 2 Nothing (-497) -- Test donation that should fail because donation is negative + doOneDonation 3 (Just 1_234) (-497) -- Test donation that should fail because current treasury value is wrong + +doTreasuryDonation :: () + => (HasCallStack, MonadCatch m, MonadTest m, MonadIO m, H.MonadAssertion m) + => ShelleyBasedEra era + -> H.ExecConfig + -> FilePath -- ^ Where temporary files can be stored + -> EpochStateView + -> PaymentKeyInfo-- ^ The key paying the fee + -> Int -- ^ The number of the call, used to create unique temporary file names. Starts at 0. + -> Maybe Int -- ^ The current treasury value to use. If unspecified, it will obtained from the node. + -> Int -- ^ The amount to donate + -> m () +doTreasuryDonation sbe execConfig work epochStateView wallet0 idx currentTreasury' treasuryDonation = do + currentTreasury <- + case currentTreasury' of + Nothing -> do + v <- unCoin <$> getTreasuryValue epochStateView + H.note_ $ "currentTreasury: " <> show v + return v + Just x -> pure $ toInteger x + + txBodyFp <- H.note $ work "treasury-donation-" <> show idx <> ".body" + signedTxFp <- H.note $ work "treasury-donation-" <> show idx <> ".signed" + + txIn0 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + (exitCode, stdout, stderr) <- execCliAny execConfig + [ "conway", "transaction", "build" + , "--tx-in", Text.unpack $ renderTxIn txIn0 + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet0 + , "--treasury-donation", show treasuryDonation + , "--out-file", txBodyFp + ] + when (not $ null stdout) (H.note_ stdout) + when (not $ null stderr) (H.note_ stderr) + + (exitCode == ExitSuccess) H.=== (currentTreasury >= 0 && treasuryDonation >= 0) + + case exitCode of + ExitFailure _ -> do + return () + ExitSuccess -> do + H.noteM_ $ execCli' execConfig + [ "conway", "transaction", "view" , "--tx-file", txBodyFp ] + + H.noteM_ $ execCli' execConfig + [ "conway", "transaction", "sign" + , "--tx-body-file", txBodyFp + , "--signing-key-file", signingKeyFp $ paymentKeyInfoPair wallet0 + , "--out-file", signedTxFp + ] + + H.noteM_ $ execCli' execConfig + [ "conway", "transaction", "view" , "--tx-file", signedTxFp ] + + H.noteM_ $ execCli' execConfig + [ "conway", "transaction", "submit" , "--tx-file", signedTxFp ] + + void $ waitForEpochs epochStateView (EpochInterval 3) + + L.Coin finalTreasury <- getTreasuryValue epochStateView + H.note_ $ "finalTreasury: " <> show finalTreasury + finalTreasury H.=== (currentTreasury + toInteger treasuryDonation) 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 420b85cbd01..96144033195 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -21,6 +21,7 @@ import qualified Cardano.Testnet.Test.Gov.NoConfidence as Gov import qualified Cardano.Testnet.Test.Gov.PParamChangeFailsSPO as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitution as Gov import qualified Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO as Gov +import qualified Cardano.Testnet.Test.Gov.TreasuryDonation as Gov import qualified Cardano.Testnet.Test.Gov.TreasuryGrowth as Gov import qualified Cardano.Testnet.Test.Gov.TreasuryWithdrawal as Gov import qualified Cardano.Testnet.Test.Node.Shutdown @@ -63,6 +64,7 @@ tests = do , ignoreOnWindows "Gov Action Timeout" Gov.hprop_check_gov_action_timeout , ignoreOnWindows "Treasury Withdrawal" Gov.hprop_ledger_events_treasury_withdrawal , ignoreOnWindows "PParam change fails for SPO" Gov.hprop_check_pparam_fails_spo + , ignoreOnWindows "Treasury Donation" Gov.hprop_ledger_events_treasury_donation -- FIXME Those tests are flaky -- , ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action ]