diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 7d0c209e076..097d3762ed3 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -177,6 +177,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Misc Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution + Cardano.Testnet.Test.LedgerEvents.Gov.TreasuryWithdrawal Cardano.Testnet.Test.LedgerEvents.SanityCheck Cardano.Testnet.Test.Node.Shutdown @@ -200,8 +201,10 @@ test-suite cardano-testnet-test , hedgehog , hedgehog-extras , http-conduit + , lifted-base , lens-aeson , microlens + , monad-control , process , regex-compat , tasty @@ -209,6 +212,10 @@ test-suite cardano-testnet-test , time , transformers , transformers-except + , unliftio + , resourcet + , transformers-base + , lifted-async ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 957e76980e6..1cb7acc96ad 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} @@ -111,10 +112,11 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') $ HM.adjust (J.rewriteObject (HM.insert "major" (toJSON @Int 8))) "protocolVersion" + . HM.insert "rho" (toJSON @Double 0.1) + . HM.insert "tau" (toJSON @Double 0.1) ) "protocolParams" - . HM.insert "rho" (toJSON @Double 0.1) - . HM.insert "tau" (toJSON @Double 0.1) . HM.insert "updateQuorum" (toJSON @Int 2) + . HM.insert "maxLovelaceSupply" (toJSON @Int 1_000_000_000_000_000) ) execCli_ @@ -122,8 +124,13 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') , "--genesis-dir", tempAbsPath' , "--testnet-magic", show @Int testnetMagic , "--gen-pools", show @Int numPoolNodes - , "--supply", "1000000000000" - , "--supply-delegated", "1000000000000" + , "--supply", show @Integer 1_000_000_000_000 + , "--supply-delegated", show @Integer 140_000_000_002 + -- 1_140_000_000_002 + -- -7_999_800_000_000_001 + -- 2_000_000_000_000 -- supply + -- 240_000_000_002 -- supply delegated + -- 10_000_000_000_000 -- mas lovelace supply , "--gen-stake-delegs", "3" , "--gen-utxo-keys", show numSeededUTxOKeys , "--start-time", DTC.formatIso8601 startTime @@ -146,6 +153,14 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') H.renameFile (tempAbsPath' "genesis.conway.json") (genesisShelleyDir "genesis.conway.json") H.renameFile (tempAbsPath' "genesis.json") (genesisShelleyDir "genesis.json") + H.rewriteJsonFile (genesisShelleyDir "genesis.json") . J.rewriteObject $ + HM.insert "maxLovelaceSupply" (toJSON @Int 10_000_000_000_000_000) + . HM.insert "activeSlotsCoeff" (toJSON @Double 0.3) + + H.rewriteJsonFile (genesisShelleyDir "genesis.conway.json") . J.rewriteObject $ + HM.insert "dRepActivity" (Number 200) + . HM.insert "govActionLifetime" (Number 2) + return genesisShelleyDir ifaceAddress :: String 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 54322dbda77..4bd7deb550b 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 @@ -89,7 +89,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr -- Create Conway constitution gov <- H.createDirectoryIfMissing $ work "governance" - proposalAnchorFile <- H.note $ work gov "sample-proposFal-anchor" + proposalAnchorFile <- H.note $ work gov "sample-proposal-anchor" consitutionFile <- H.note $ work gov "sample-constitution" constitutionActionFp <- H.note $ work gov "constitution.action" @@ -139,7 +139,6 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr ] -- Retrieve UTxOs for registration submission - void $ H.execCli' execConfig [ "conway", "query", "utxo" , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets @@ -149,12 +148,13 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr ] utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" - UTxO utxo1 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo1Json - txin1 <- H.noteShow =<< H.headM (Map.keys utxo1) + UTxO utxo1 <- H.noteShowM $ decodeEraUTxO sbe utxo1Json + txin1 <- H.noteShowM $ H.headM (Map.keys utxo1) drepRegTxbodyFp <- H.note $ work "drep.registration.txbody" drepRegTxSignedFp <- H.note $ work "drep.registration.tx" + -- TX: UTXO1 -> UTXO2 void $ H.execCli' execConfig [ "conway", "transaction", "build" , "--testnet-magic", show @Int testnetMagic @@ -186,7 +186,6 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr ] -- Create constitution proposal - void $ H.execCli' execConfig [ "conway", "governance", "action", "create-constitution" , "--testnet" @@ -211,9 +210,10 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr ] utxo2Json <- H.leftFailM . H.readJsonFile $ work "utxo-2.json" - UTxO utxo2 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo2Json + UTxO utxo2 <- H.noteShowM $ decodeEraUTxO sbe utxo2Json txin2 <- H.noteShow =<< H.headM (Map.keys utxo2) + -- TX: UTXO2 -> UTXO1 void $ H.execCli' execConfig [ "conway", "transaction", "build" , "--testnet-magic", show @Int testnetMagic @@ -277,7 +277,6 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr ] -- We need more UTxOs - void $ H.execCli' execConfig [ "conway", "query", "utxo" , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets @@ -287,13 +286,14 @@ hprop_ledger_events_propose_new_constitution = H.integrationRetryWorkspace 2 "pr ] utxo3Json <- H.leftFailM . H.readJsonFile $ work "utxo-3.json" - UTxO utxo3 <- H.noteShowM $ H.noteShowM $ decodeEraUTxO sbe utxo3Json + UTxO utxo3 <- H.noteShowM $ decodeEraUTxO sbe utxo3Json txin3 <- H.noteShow =<< H.headM (Map.keys utxo3) voteTxFp <- H.note $ work gov "vote.tx" voteTxBodyFp <- H.note $ work gov "vote.txbody" -- Submit votes + -- TX: UTXO3 -> UTXO2 void $ H.execCli' execConfig [ "conway", "transaction", "build" , "--testnet-magic", show @Int testnetMagic @@ -412,5 +412,6 @@ filterRatificationState _ _ = False -- TODO: Move to cardano-api and share with -- https://github.com/input-output-hk/cardano-cli/blob/694782210c6d73a1b5151400214ef691f6f3ecb0/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Hash.hs#L67 -- when doing so +-- remove after merging https://github.com/IntersectMBO/cardano-api/commit/d589604b51d5d31ecfb5cc311cd55e5ce0f93ae1 renderSafeHashAsHex :: Ledger.SafeHash c tag -> Text.Text renderSafeHashAsHex = hashToTextAsHex . Ledger.extractHash diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/TreasuryWithdrawal.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/TreasuryWithdrawal.hs new file mode 100644 index 00000000000..b03cc36c09a --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/TreasuryWithdrawal.hs @@ -0,0 +1,601 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Use head" #-} + +module Cardano.Testnet.Test.LedgerEvents.Gov.TreasuryWithdrawal + ( hprop_ledger_events_treasury_withdrawal + ) where + +import Cardano.Api +import Cardano.Api.Shelley +import Cardano.Testnet +import Control.Monad.Base +import Control.Monad.IO.Class +import Control.Monad.Trans.Control + +import Prelude + +import qualified Cardano.Ledger.Conway.Governance as Ledger +import Control.Monad +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra +import Control.Monad.Trans.Resource +import qualified Data.Map.Strict as Map +import Data.String +import qualified Data.Text as Text +import Data.Word +import GHC.IO.Exception (IOException) +import GHC.Stack (HasCallStack, callStack) +import Lens.Micro +import System.FilePath (()) + +import Hedgehog +import qualified Hedgehog.Extras as H +import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO +import qualified Testnet.Process.Cli as P +import qualified Testnet.Process.Run as H + +import qualified Control.Concurrent.Async.Lifted as LA +import qualified Control.Concurrent.Lifted as IO +import Data.Char (isSpace) +import qualified Data.Map as M +import qualified System.Timeout.Lifted as LB +import Testnet.Components.SPO +import qualified Testnet.Property.Utils as H +import Testnet.Runtime +import qualified UnliftIO + +newtype AdditionalCatcher + = IOE IOException + deriving Show + + +hprop_ledger_events_treasury_withdrawal:: Property +hprop_ledger_events_treasury_withdrawal = H.integrationRetryWorkspace 0 {- FIXME set to 2 -} "treasury-withdrawal" $ \tempAbsBasePath' -> do + -- Start a local test net + conf@Conf { tempAbsPath } <- H.noteShowM $ 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 + , cardanoSlotLength = 0.1 + , cardanoNodeEra = cEra + } + + testnetRuntime@TestnetRuntime + { testnetMagic + , poolNodes + , wallets + } + <- cardanoTestnet fastTestnetOptions conf + + poolNode1 <- H.headM poolNodes + poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 + + let socketName' = IO.sprocketName poolSprocket1 + socketBase = IO.sprocketBase poolSprocket1 -- /tmp + socketPath = socketBase socketName' + + H.note_ $ "Sprocket: " <> show poolSprocket1 + H.note_ $ "Abs path: " <> tempAbsBasePath' + H.note_ $ "Socketpath: " <> socketPath + H.note_ $ "Foldblocks config file: " <> configurationFile testnetRuntime + + gov <- H.createDirectoryIfMissing $ work "governance" + proposalAnchorFile <- H.note $ work gov "sample-proposal-anchor" + treasuryWithdrawalActionFp <- H.note $ work gov "treasury-withdrawal.action" + + H.writeFile proposalAnchorFile "dummy anchor data" + + proposalAnchorDataHash <- H.execCli' execConfig + [ "conway", "governance" + , "hash", "--file-text", proposalAnchorFile + ] + + + let drepVkeyFp :: Int -> FilePath + drepVkeyFp n = gov "drep-keys" <>"drep" <> show n <> ".vkey" + + drepSKeyFp :: Int -> FilePath + drepSKeyFp n = gov "drep-keys" <>"drep" <> show n <> ".skey" + + -- {{{ Create DReps + -- TODO: Refactor with shelleyKeyGen + LA.forConcurrently_ [1..3] $ \n -> do + H.execCli' execConfig + [ "conway", "governance", "drep", "key-gen" + , "--verification-key-file", drepVkeyFp n + , "--signing-key-file", drepSKeyFp n + ] + + -- Create Drep registration certificates + let drepCertFile :: Int -> FilePath + drepCertFile n = gov "drep-keys" <>"drep" <> show n <> ".regcert" + LA.forConcurrently_ [1..3] $ \n -> do + H.execCli' execConfig + [ "conway", "governance", "drep", "registration-certificate" + , "--drep-verification-key-file", drepVkeyFp n + , "--key-reg-deposit-amt", show @Int 0 + , "--out-file", drepCertFile n + ] + + + -- Retrieve UTxOs for registration submission + txin1 <- do + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr $ head wallets + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-1.json" + ] + + utxoJson <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" + UTxO utxo <- H.noteShowM $ decodeEraUTxO sbe utxoJson + H.noteShowM $ H.headM (Map.keys utxo) + + drepRegTxbodyFp <- H.note $ work "drep.registration.txbody" + drepRegTxSignedFp <- H.note $ work "drep.registration.tx" + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show @Int testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr (wallets !! 0) + , "--tx-in", Text.unpack $ renderTxIn txin1 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 1)) <> "+" <> show @Int 15_000_000 + , "--certificate-file", drepCertFile 1 + , "--certificate-file", drepCertFile 2 + , "--certificate-file", drepCertFile 3 + , "--witness-override", show @Int 4 + , "--out-file", drepRegTxbodyFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show @Int testnetMagic + , "--tx-body-file", drepRegTxbodyFp + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair (wallets !! 0) + , "--signing-key-file", drepSKeyFp 1 + , "--signing-key-file", drepSKeyFp 2 + , "--signing-key-file", drepSKeyFp 3 + , "--out-file", drepRegTxSignedFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show @Int testnetMagic + , "--tx-file", drepRegTxSignedFp + ] + -- }}} + + txin2 <- do + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr (wallets !! 1) + , "--cardano-mode" + , "--testnet-magic", show testnetMagic + , "--out-file", work "utxo-2.json" + ] + + utxoJson <- H.leftFailM . H.readJsonFile $ work "utxo-2.json" + UTxO utxo <- H.noteShowM $ decodeEraUTxO sbe utxoJson + H.noteShowM $ H.headM (Map.keys utxo) + + -- {{{ Register stake address + let stakeVkeyFp = gov "stake.vkey" + stakeSKeyFp = gov "stake.skey" + stakeCertFp = gov "stake.regcert" + + _ <- P.cliStakeAddressKeyGen tempAbsPath' + $ P.KeyNames { P.verificationKeyFile = stakeVkeyFp + , P.signingKeyFile = stakeSKeyFp + } + + void $ H.execCli' execConfig + [ "conway", "stake-address", "registration-certificate" + , "--stake-verification-key-file", stakeVkeyFp + , "--key-reg-deposit-amt", show @Int 0 -- TODO take from pparams + , "--out-file", stakeCertFp + ] + + let trim xs = dropSpaceTail "" $ dropWhile isSpace xs + + dropSpaceTail _ "" = "" + dropSpaceTail maybeStuff (x:xs) + | isSpace x = dropSpaceTail (x:maybeStuff) xs + | null maybeStuff = x : dropSpaceTail "" xs + | otherwise = reverse maybeStuff ++ x : dropSpaceTail "" xs + + stakeAddress <- fmap trim $ H.noteM $ H.execCli' execConfig + [ "conway", "stake-address", "build" + , "--stake-verification-key-file", stakeVkeyFp + , "--testnet-magic", show @Int testnetMagic + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "stake-address-info" + , "--address", stakeAddress + , "--cardano-mode" + , "--testnet-magic", show testnetMagic + ] + + stakeCertTxBodyFp <- H.note $ work "stake.registration.txbody" + stakeCertTxSignedFp <- H.note $ work "stake.registration.tx" + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show @Int testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr (wallets !! 1) + , "--tx-in", Text.unpack $ renderTxIn txin2 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 0)) <> "+" <> show @Int 10_000_000 + , "--certificate-file", stakeCertFp + , "--witness-override", show @Int 2 + , "--out-file", stakeCertTxBodyFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show testnetMagic + , "--tx-body-file", stakeCertTxBodyFp + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 1 + , "--signing-key-file", stakeSKeyFp + , "--out-file", stakeCertTxSignedFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show testnetMagic + , "--tx-file", stakeCertTxSignedFp + ] + -- }}} + + -- {{{ Create treasury withdrawal + void $ H.execCli' execConfig + [ "conway", "governance", "action", "create-treasury-withdrawal" + , "--testnet" + , "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + , "--governance-action-deposit", show @Int 0 -- TODO: Get this from the node + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + , "--transfer", show @Int 3_300_777 + , "--funds-receiving-stake-verification-key-file", stakeVkeyFp + , "--out-file", treasuryWithdrawalActionFp + ] + + + txbodyFp <- H.note $ work "tx.body" + txbodySignedFp <- H.note $ work "tx.body.signed" + + -- wait for UTXO in wallet 1 to get updated + -- TODO replace with waiting for ledger event or loop checking for a condition + IO.threadDelay 10_000_000 + + txin3 <- do + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack $ paymentKeyInfoAddr (wallets !! 0) + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-3.json" + ] + + utxoJson <- H.leftFailM . H.readJsonFile $ work "utxo-3.json" + UTxO utxo <- H.noteShowM $ decodeEraUTxO sbe utxoJson + H.noteShow =<< H.headM (Map.keys utxo) + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 0 + , "--tx-in", Text.unpack $ renderTxIn txin3 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 1)) <> "+" <> show @Int 5_000_000 + , "--proposal-file", treasuryWithdrawalActionFp + , "--out-file", txbodyFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show testnetMagic + , "--tx-body-file", txbodyFp + , "--signing-key-file", paymentSKey . paymentKeyInfoPair $ wallets !! 0 + , "--out-file", txbodySignedFp + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--testnet-magic", show @Int testnetMagic + , "--whole-utxo" + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show testnetMagic + , "--tx-file", txbodySignedFp + ] + -- }}} + + txidString <- mconcat . lines <$> H.execCli' execConfig + [ "transaction", "txid" + , "--tx-file", txbodySignedFp + ] + + !propSubmittedResult + <- runExceptT $ handleIOExceptT IOE + $ runExceptT $ foldBlocks + (File $ configurationFile testnetRuntime) + (File socketPath) + FullValidation + Nothing -- Initial accumulator state + (foldBlocksCheckProposalWasSubmitted (fromString txidString)) + + newProposalEvents <- case propSubmittedResult of + Left (IOE e) -> + H.failMessage callStack + $ "foldBlocksCheckProposalWasSubmitted failed with: " <> show e + Right (Left e) -> + H.failMessage callStack + $ "foldBlocksCheckProposalWasSubmitted failed with: " <> Text.unpack (renderFoldBlocksError e) + Right (Right events) -> return events + + governanceActionIndex <- retrieveGovernanceActionIndex newProposalEvents + + let voteFp :: Int -> FilePath + voteFp n = work gov "vote-" <> show n + + -- Proposal was successfully submitted, now we vote on the proposal and confirm it was ratified + LA.forConcurrently_ [1..3] $ \n -> do + H.execCli' execConfig + [ "conway", "governance", "vote", "create" + , "--yes" + , "--governance-action-tx-id", txidString + , "--governance-action-index", show @Word32 governanceActionIndex + , "--drep-verification-key-file", drepVkeyFp n + , "--out-file", voteFp n + ] + + txin4 <- do + void $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--address", Text.unpack . paymentKeyInfoAddr $ wallets !! 1 + , "--cardano-mode" + , "--testnet-magic", show @Int testnetMagic + , "--out-file", work "utxo-4.json" + ] + + utxoJson <- H.leftFailM . H.readJsonFile $ work "utxo-4.json" + UTxO utxo <- H.noteShowM $ decodeEraUTxO sbe utxoJson + H.noteShow =<< H.headM (Map.keys utxo) + + voteTxFp <- H.note $ work gov "vote.tx" + voteTxBodyFp <- H.note $ work gov "vote.txbody" + + -- {{{ Submit votes + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--testnet-magic", show @Int testnetMagic + , "--change-address", Text.unpack $ paymentKeyInfoAddr $ wallets !! 1 + , "--tx-in", Text.unpack $ renderTxIn txin4 + , "--tx-out", Text.unpack (paymentKeyInfoAddr (wallets !! 0)) <> "+" <> show @Int 3_000_000 + , "--vote-file", voteFp 1 + , "--vote-file", voteFp 2 + , "--vote-file", voteFp 3 + , "--witness-override", show @Int 4 + , "--out-file", voteTxBodyFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "sign" + , "--testnet-magic", show testnetMagic + , "--tx-body-file", voteTxBodyFp + , "--signing-key-file", paymentSKey $ paymentKeyInfoPair $ wallets !! 1 + , "--signing-key-file", drepSKeyFp 1 + , "--signing-key-file", drepSKeyFp 2 + , "--signing-key-file", drepSKeyFp 3 + , "--out-file", voteTxFp + ] + + void $ H.execCli' execConfig + [ "conway", "transaction", "submit" + , "--testnet-magic", show @Int testnetMagic + , "--tx-file", voteTxFp + ] + -- }}} + + H.noteM_ $ H.execCli' execConfig + [ "--version" ] + + -- H.noteM_ $ H.execCli' execConfig + -- [ "conway", "query", "gov-state" + -- , "--testnet-magic", show testnetMagic + -- ] + -- + -- ledgerStateFp <- H.note $ work "ledgerstate.cbor" + -- H.noteM_ $ H.execCli' execConfig + -- [ "query", "ledger-state" + -- , "--testnet-magic", show testnetMagic + -- , "--out-file", ledgerStateFp + -- ] + -- + -- H.noteM_ $ H.execCli' execConfig + -- [ "query", "ledger-state" + -- , "--testnet-magic", show testnetMagic + -- -- , "--out-file", ledgerStateFp + -- ] + + -- + -- v' <- H.leftFailM . H.readJsonFile $ ledgerStateFp + -- + -- H.note_ . show $ v' ^? A.key "stateBefore" . A.key "esAccountState" + + -- H.noteM_ $ H.execCli' execConfig + -- [ "conway", "query", "committee-state" + -- , "--testnet-magic", show testnetMagic + -- ] + -- + -- + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--testnet-magic", show @Int testnetMagic + , "--whole-utxo" + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "stake-pools" + , "--testnet-magic", show @Int testnetMagic + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "tip" + , "--testnet-magic", show @Int testnetMagic + ] + + !meTreasuryWithdrawed + <- LB.timeout 65_000_000_000 $ runExceptT $ handleIOExceptT IOE + $ runExceptT $ foldBlocks + (File $ configurationFile testnetRuntime) + (File socketPath) + FullValidation + [] -- Initial accumulator state + (foldBlocksCheckTreasuryWithdrawalWasRatified $ tempAbsPath' "events.log") + + H.noteM_ $ H.execCli' execConfig + [ "query", "stake-snapshot" + , "--testnet-magic", show testnetMagic + , "--all-stake-pools" + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "gov-state" + , "--testnet-magic", show testnetMagic + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "drep-stake-distribution" + , "--testnet-magic", show testnetMagic + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "utxo" + , "--testnet-magic", show @Int testnetMagic + , "--whole-utxo" + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "stake-address-info" + , "--address", stakeAddress + , "--cardano-mode" + , "--testnet-magic", show testnetMagic + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "stake-pools" + , "--testnet-magic", show @Int testnetMagic + ] + + H.noteM_ $ H.execCli' execConfig + [ "conway", "query", "tip" + , "--testnet-magic", show @Int testnetMagic + ] + + eTreasuryWithdrawed <- H.nothingFail meTreasuryWithdrawed + + case eTreasuryWithdrawed of + Left (IOE e) -> + H.failMessage callStack + $ "foldBlocksCheckTreasuryWithdrawalWasRatified failed with: " <> show e + Right (Left e) -> + H.failMessage callStack + $ "foldBlocksCheckTreasuryWithdrawalWasRatified failed with: " <> Text.unpack (renderFoldBlocksError e) + Right (Right _events) -> success + + pure () + +foldBlocksCheckProposalWasSubmitted + :: TxId -- TxId of submitted tx + -> Env + -> LedgerState + -> [LedgerEvent] + -> BlockInMode -- Block i + -> Maybe LedgerEvent -- ^ Accumulator at block i - 1 + -> IO (Maybe LedgerEvent, FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksCheckProposalWasSubmitted txid _ _ allEvents _ _ = do + let newGovProposal = filter (filterNewGovProposals txid) allEvents + if null newGovProposal + then return (Nothing, ContinueFold) + else return (Just $ head newGovProposal , StopFold) + +filterNewGovProposals :: TxId -> LedgerEvent -> Bool +filterNewGovProposals txid (NewGovernanceProposals eventTxId (AnyProposals props)) = + let _govActionStates = Ledger.proposalsGovActionStates props + in fromShelleyTxId eventTxId == txid +filterNewGovProposals _ _ = False + +retrieveGovernanceActionIndex + :: (HasCallStack, MonadTest m) + => Maybe LedgerEvent -> m Word32 +retrieveGovernanceActionIndex mEvent = do + case mEvent of + Nothing -> H.failMessage callStack "retrieveGovernanceActionIndex: No new governance proposals found" + Just (NewGovernanceProposals _ (AnyProposals props)) -> + -- In this test there will only be one + let govActionStates = [i + | Ledger.GovActionIx i <- map Ledger.gaidGovActionIx . Map.keys $ Ledger.proposalsGovActionStates props + ] + in return $ head govActionStates + Just unexpectedEvent -> + H.failMessage callStack + $ mconcat ["retrieveGovernanceActionIndex: Expected NewGovernanceProposals, got: " + , show unexpectedEvent + ] + +foldBlocksCheckTreasuryWithdrawalWasRatified + :: FilePath + -> Env + -> LedgerState + -> [LedgerEvent] + -> BlockInMode -- Block i + -> [LedgerEvent] -- ^ Accumulator at block i - 1 + -> IO ([LedgerEvent], FoldStatus) -- ^ Accumulator at block i and fold status +foldBlocksCheckTreasuryWithdrawalWasRatified df _ ls allEvents _ _ = do + appendFile df "#### BLOCK\n" + appendFile df $ show ls <> "\n" + appendFile df $ unlines $ map show allEvents + if any filterRatificationState allEvents + then return (allEvents , StopFold) + else return ([], ContinueFold) + +filterRatificationState + :: LedgerEvent + -> Bool +filterRatificationState (EpochBoundaryRatificationState (AnyRatificationState rState)) = do + let withdrawals = rState ^. Ledger.rsEnactStateL . Ledger.ensWithdrawalsL + not $ M.null withdrawals +filterRatificationState _ = False + +instance MonadBase IO (ResourceT IO) where + liftBase = liftIO + +instance MonadBaseControl IO (ResourceT IO) where + type StM (ResourceT IO) a = a + liftBaseWith = UnliftIO.withRunInIO + restoreM = pure + 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 a7c4a661e55..be1ed09bc74 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -12,6 +12,7 @@ import qualified Cardano.Testnet.Test.Cli.KesPeriodInfo import qualified Cardano.Testnet.Test.Cli.QuerySlotNumber import qualified Cardano.Testnet.Test.FoldBlocks import qualified Cardano.Testnet.Test.LedgerEvents.Gov.ProposeNewConstitution as LedgerEvents +import qualified Cardano.Testnet.Test.LedgerEvents.Gov.TreasuryWithdrawal as LedgerEvents import qualified Cardano.Testnet.Test.LedgerEvents.SanityCheck as LedgerEvents import qualified Cardano.Testnet.Test.Node.Shutdown import qualified Cardano.Testnet.Test.SubmitApi.Babbage.Transaction @@ -33,7 +34,9 @@ tests = pure $ T.testGroup "test/Spec.hs" [ T.testGroup "Ledger Events" [ H.ignoreOnWindows "Sanity Check" LedgerEvents.hprop_ledger_events_sanity_check , T.testGroup "Governance" - [ H.ignoreOnWindows "ProposeAndRatifyNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution] + [ H.ignoreOnWindows "ProposeAndRatifyNewConstitution" LedgerEvents.hprop_ledger_events_propose_new_constitution + , H.ignoreOnWindows "TreasuryWithdrawal" LedgerEvents.hprop_ledger_events_treasury_withdrawal + ] ] , T.testGroup "CLI" [ H.ignoreOnWindows "Shutdown" Cardano.Testnet.Test.Node.Shutdown.hprop_shutdown