From 10da35fb72cca1725dd7f4db3938315c0b978e34 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 | 142 ++++++++++++++++++ .../cardano-testnet-test.hs | 2 + 4 files changed, 157 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..efe922bdd6c --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs @@ -0,0 +1,142 @@ +{-# 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.FilePath (()) + +import Testnet.Components.Query +import Testnet.Components.TestWatchdog +import Testnet.Process.Run (execCli', 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: +-- @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 + + let doOneDonation = doTreasuryDonation sbe execConfig work epochStateView wallet0 + + doOneDonation 0 500 + doOneDonation 1 500_013 + +doTreasuryDonation :: () + => HasCallStack + => MonadCatch m + => MonadTest m + => MonadIO m + => H.MonadAssertion m + -- => MonadCatch 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. + -> Int -- ^ The amount to donate + -> m () +doTreasuryDonation sbe execConfig work epochStateView wallet0 idx treasuryDonation = do + L.Coin currentTreasury <- getTreasuryValue epochStateView + H.note_ $ "currentTreasury: " <> show currentTreasury + + -- If it's the first donation, the current treasury must be zero: + when (idx == 0) (currentTreasury H.=== 0) + + txBodyFp <- H.note $ work "treasury-donation-" <> show idx <> ".body" + signedTxFp <- H.note $ work "treasury-donation-" <> show idx <> ".signed" + + txIn0 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + H.noteM_ $ execCli' 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 + ] + + 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 ]