cardano-testnet: Test treasury donation

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

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/TreasuryDonation.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+
+module Cardano.Testnet.Test.Gov.TreasuryDonation
+  ( hprop_ledger_events_treasury_donation
+  ) where
+
+import Control.Concurrent (threadDelay)
+
+import           Cardano.Api
+import           Cardano.Api.Ledger
+
+import qualified Cardano.Ledger.Coin as L
+import qualified Cardano.Ledger.Conway.Governance as L
+import qualified Cardano.Ledger.Shelley.LedgerState as L
+import           Cardano.Testnet
+
+import           Prelude
+
+import           Control.Monad (void)
+import           Control.Monad.Trans.State.Strict (put)
+import           Data.Bifunctor (Bifunctor (..))
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+import           GHC.Stack (HasCallStack)
+import           Lens.Micro
+import           System.FilePath ((</>))
+
+import           Testnet.Components.Query
+import           Testnet.Components.TestWatchdog
+import           Testnet.Defaults
+import           Testnet.Process.Cli.DRep
+import           Testnet.Process.Cli.Keys
+import qualified Testnet.Process.Cli.SPO as SPO
+import           Testnet.Process.Cli.Transaction
+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
+
+  L.Coin currentTreasuryValue <- getTreasuryValue epochStateView
+  H.note_ $ "currentTreasuryValue: " <> show currentTreasuryValue
+
+  txBodyFp <- H.note $ work </> "treasury-donation.body"
+  signedTxFp <- H.note $ work </> "treasury-donation.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 currentTreasuryValue
+    , "--treasury-donation", "500"
+    , "--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 10)
+
+  L.Coin finalTreasuryValue <- getTreasuryValue epochStateView
+  H.note_ $ "finalTreasuryValue: " <> show finalTreasuryValue
+
+  liftIO $ threadDelay (15 * 60 * 1000) -- 15 minutes
+
+  H.assert False

cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs

@@ -59,6 +59,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
                 ]