From 796dc528fc5af6175785073ee9a52dc6c1416433 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 | 12 ++ .../Testnet/Test/Gov/TreasuryDonation.hs | 160 ++++++++++++++++++ .../cardano-testnet-test.hs | 2 + 4 files changed, 175 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 22e7802d860..ad80427ab69 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -195,6 +195,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.NoConfidence Cardano.Testnet.Test.Gov.ProposeNewConstitution Cardano.Testnet.Test.Gov.ProposeNewConstitutionSPO + 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 a15cad08234..d99056ee08c 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 @@ -464,6 +465,17 @@ getGovState epochStateView ceo = withFrozenCallStack $ do Refl <- H.leftFail $ assertErasEqual sbe sbe' pure $ conwayEraOnwardsConstraints ceo $ newEpochState ^. L.newEpochStateGovStateL +getTreasuryValue + :: HasCallStack + => MonadAssertion m + => MonadIO m + => MonadTest m + => EpochStateView + -> m L.Coin -- ^ TODO +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..7a0a6a97ea1 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs @@ -0,0 +1,160 @@ +{-# 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.Components.TestWatchdog +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 + +-- | 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' -> 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 + -> 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 + , "--current-treasury-value", show currentTreasury + , "--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 + H.assert (currentTreasury < 0 || treasuryDonation < 0) + 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 5) + + L.Coin finalTreasury <- getTreasuryValue epochStateView + H.note_ $ "finalTreasury: " <> show finalTreasury + finalTreasury H.=== (currentTreasury + (toInteger treasuryDonation)) \ No newline at end of file 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 693502e446c..c2ea5f92f97 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -19,6 +19,7 @@ import qualified Cardano.Testnet.Test.Gov.DRepRetirement as Gov import qualified Cardano.Testnet.Test.Gov.NoConfidence 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 @@ -59,6 +60,7 @@ tests = do , ignoreOnMacAndWindows "Propose And Ratify New Constitution" Gov.hprop_ledger_events_propose_new_constitution , ignoreOnWindows "Propose New Constitution SPO" Gov.hprop_ledger_events_propose_new_constitution_spo , ignoreOnWindows "Treasury Withdrawal" Gov.hprop_ledger_events_treasury_withdrawal + , ignoreOnWindows "Treasury Donation" Gov.hprop_ledger_events_treasury_donation -- FIXME Those tests are flaky -- , ignoreOnWindows "InfoAction" LedgerEvents.hprop_ledger_events_info_action ]