From ef3a2c2bb035028b88eafb500dcf4d45ea39d835 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 18 Apr 2024 01:53:10 +0200 Subject: [PATCH] Test predefined always abstain DRep --- .../src/Testnet/Components/DReps.hs | 53 ++-- cardano-testnet/src/Testnet/Defaults.hs | 19 +- .../Test/LedgerEvents/Gov/DRepDeposits.hs | 10 +- .../LedgerEvents/Gov/PredefinedAbstainDRep.hs | 275 +++++++++++++++++- 4 files changed, 321 insertions(+), 36 deletions(-) diff --git a/cardano-testnet/src/Testnet/Components/DReps.hs b/cardano-testnet/src/Testnet/Components/DReps.hs index 9142c87c3f9..edd9c18cb0e 100644 --- a/cardano-testnet/src/Testnet/Components/DReps.hs +++ b/cardano-testnet/src/Testnet/Components/DReps.hs @@ -1,10 +1,13 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} module Testnet.Components.DReps - ( generateDRepKeyPair + ( SomeKeyPair(..) + , generateDRepKeyPair , generateRegistrationCertificate - , createDRepRegistrationTxBody + , createCertificatePublicationTxBody , generateVoteFiles , createVotingTxBody , signTx @@ -32,7 +35,8 @@ import System.FilePath (()) import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey) import qualified Testnet.Process.Run as H -import Testnet.Runtime (PaymentKeyInfo (paymentKeyInfoAddr), PaymentKeyPair (..)) +import Testnet.Runtime (PaymentKeyInfo (paymentKeyInfoAddr), PaymentKeyPair (..), + StakingKeyPair (stakingSKey)) import Testnet.Start.Types (anyEraToString) import Hedgehog (MonadTest) @@ -66,7 +70,7 @@ generateDRepKeyPair execConfig work prefix = do -- DRep registration certificate generation -data DRepRegistrationCertificate +data Certificate -- | Generates a registration certificate for a decentralized representative (DRep) -- using @cardano-cli@. @@ -90,7 +94,7 @@ generateRegistrationCertificate -> String -> PaymentKeyPair -> Integer - -> m (File DRepRegistrationCertificate In) + -> m (File Certificate In) generateRegistrationCertificate execConfig work prefix drepKeyPair depositAmount = do let dRepRegistrationCertificate = File (work prefix <> ".regcert") void $ H.execCli' execConfig [ "conway", "governance", "drep", "registration-certificate" @@ -104,8 +108,7 @@ generateRegistrationCertificate execConfig work prefix drepKeyPair depositAmount data TxBody --- | Composes a decentralized representative (DRep) registration transaction body --- (without signing) using @cardano-cli@. +-- | Composes a certificate publication transaction body (without signing) using @cardano-cli@. -- -- This function takes seven parameters: -- @@ -115,30 +118,29 @@ data TxBody -- * 'sbe': The Shelley-based era (e.g., 'ShelleyEra') in which the transaction will be constructed. -- * 'work': Base directory path where the transaction body file will be stored. -- * 'prefix': Prefix for the output transaction body file name. The extension will be @.txbody@. --- * 'drepRegCert': The file name of the registration certificate for the DRep, obtained using --- 'generateRegistrationCertificate'. +-- * 'certificate': The file name of the certificate. -- * 'wallet': Payment key information associated with the transaction, -- as returned by 'cardanoTestnetDefault'. -- -- Returns the generated @File TxBody In@ file path to the transaction body. -createDRepRegistrationTxBody +createCertificatePublicationTxBody :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) => H.ExecConfig -> EpochStateView -> ShelleyBasedEra era -> FilePath -> String - -> File DRepRegistrationCertificate In + -> File Certificate In -> PaymentKeyInfo -> m (File TxBody In) -createDRepRegistrationTxBody execConfig epochStateView sbe work prefix drepRegCert wallet = do +createCertificatePublicationTxBody execConfig epochStateView sbe work prefix cert wallet = do let dRepRegistrationTxBody = File (work prefix <> ".txbody") walletLargestUTXO <- findLargestUtxoForPaymentKey epochStateView sbe wallet void $ H.execCli' execConfig [ "conway", "transaction", "build" , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet , "--tx-in", Text.unpack $ renderTxIn walletLargestUTXO - , "--certificate-file", unFile drepRegCert + , "--certificate-file", unFile cert , "--witness-override", show @Int 2 , "--out-file", unFile dRepRegistrationTxBody ] @@ -231,6 +233,23 @@ createVotingTxBody execConfig epochStateView sbe work prefix votes wallet = do data SignedTx +class KeyPair a where + secretKey :: a -> FilePath + +instance KeyPair PaymentKeyPair where + secretKey :: PaymentKeyPair -> FilePath + secretKey = paymentSKey + +instance KeyPair StakingKeyPair where + secretKey :: StakingKeyPair -> FilePath + secretKey = stakingSKey + +data SomeKeyPair = forall a . KeyPair a => SomeKeyPair a + +instance KeyPair SomeKeyPair where + secretKey :: SomeKeyPair -> FilePath + secretKey (SomeKeyPair x) = secretKey x + -- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs. -- -- This function takes five parameters: @@ -239,24 +258,24 @@ data SignedTx -- * 'cEra': Specifies the current Cardano era. -- * 'work': Base directory path where the signed transaction file will be stored. -- * 'prefix': Prefix for the output signed transaction file name. The extension will be @.tx@. --- * 'txBody': Transaction body to be signed, obtained using 'createDRepRegistrationTxBody' or similar. +-- * 'txBody': Transaction body to be signed, obtained using 'createCertificatePublicationTxBody' or similar. -- * 'signatoryKeyPairs': List of payment key pairs used for signing the transaction. -- -- Returns the generated @File SignedTx In@ file path to the signed transaction file. -signTx :: (MonadTest m, MonadCatch m, MonadIO m) +signTx :: (MonadTest m, MonadCatch m, MonadIO m, KeyPair k) => H.ExecConfig -> AnyCardanoEra -> FilePath -> String -> File TxBody In - -> [PaymentKeyPair] + -> [k] -> m (File SignedTx In) signTx execConfig cEra work prefix txBody signatoryKeyPairs = do let signedTx = File (work prefix <> ".tx") void $ H.execCli' execConfig $ [ anyEraToString cEra, "transaction", "sign" , "--tx-body-file", unFile txBody - ] ++ (concat [["--signing-key-file", paymentSKey kp] | kp <- signatoryKeyPairs]) ++ + ] ++ (concat [["--signing-key-file", secretKey kp] | kp <- signatoryKeyPairs]) ++ [ "--out-file", unFile signedTx ] return signedTx diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs index 73b851dbbef..3a8b7fab4b5 100644 --- a/cardano-testnet/src/Testnet/Defaults.hs +++ b/cardano-testnet/src/Testnet/Defaults.hs @@ -17,6 +17,7 @@ module Testnet.Defaults , defaultDRepVkeyFp , defaultDRepSkeyFp , defaultDRepKeyPair + , defaultDelegatorStakeKeyPair , defaultShelleyGenesis , defaultGenesisFilepath , defaultYamlHardforkViaConfig @@ -71,7 +72,7 @@ import Numeric.Natural import System.FilePath (()) import Test.Cardano.Ledger.Core.Rational -import Testnet.Runtime (PaymentKeyPair (PaymentKeyPair)) +import Testnet.Runtime (PaymentKeyPair (PaymentKeyPair), StakingKeyPair (StakingKeyPair)) import Testnet.Start.Types {- HLINT ignore "Use underscore" -} @@ -514,6 +515,22 @@ defaultDRepSkeyFp n = "drep-keys" ("drep" <> show n) "drep.skey" defaultDRepKeyPair :: Int -> PaymentKeyPair defaultDRepKeyPair n = PaymentKeyPair (defaultDRepVkeyFp n) (defaultDRepSkeyFp n) +-- | The relative path to stake delegator stake keys in directories created by cardano-testnet +defaultDelegatorStakeVkeyFp + :: Int -- ^The Stake delegator index (starts at 1) + -> FilePath +defaultDelegatorStakeVkeyFp n = "stake-delegators" ("delegator" <> show n) "staking.vkey" + +-- | The relative path to stake delegator stake secret keys in directories created by cardano-testnet +defaultDelegatorStakeSkeyFp + :: Int -- ^The Stake delegator index (starts at 1) + -> FilePath +defaultDelegatorStakeSkeyFp n = "stake-delegators" ("delegator" <> show n) "staking.skey" + +-- | The relative path to stake delegator key pairs in directories created by cardano-testnet +defaultDelegatorStakeKeyPair :: Int -> StakingKeyPair +defaultDelegatorStakeKeyPair n = StakingKeyPair (defaultDelegatorStakeVkeyFp n) (defaultDelegatorStakeSkeyFp n) + -- TODO: We should not hardcode a script like this. We need to move -- plutus-example from plutus apps to cardano-node-testnet. This will -- let us directly compile the plutus validators and avoid bit rotting of diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs index 95ccdd1fcdb..7bea8665d2b 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/DRepDeposits.hs @@ -19,7 +19,7 @@ import Prelude import qualified Data.Map as Map import System.FilePath (()) -import Testnet.Components.DReps (createDRepRegistrationTxBody, failToSubmitTx, +import Testnet.Components.DReps (createCertificatePublicationTxBody, failToSubmitTx, generateDRepKeyPair, generateRegistrationCertificate, signTx, submitTx) import Testnet.Components.Query (checkDRepState, getEpochStateView, getMinDRepDeposit) import qualified Testnet.Process.Run as H @@ -87,8 +87,8 @@ hprop_ledger_events_drep_deposits = H.integrationWorkspace "drep-deposits" $ \te drepKeyPair1 <- generateDRepKeyPair execConfig drepDir1 "keys" drepRegCert1 <- generateRegistrationCertificate execConfig drepDir1 "reg-cert" drepKeyPair1 (minDRepDeposit - 1) - drepRegTxBody1 <- createDRepRegistrationTxBody execConfig epochStateView sbe drepDir1 "reg-cert-txbody" - drepRegCert1 wallet0 + drepRegTxBody1 <- createCertificatePublicationTxBody execConfig epochStateView sbe drepDir1 "reg-cert-txbody" + drepRegCert1 wallet0 drepSignedRegTx1 <- signTx execConfig cEra drepDir1 "signed-reg-tx" drepRegTxBody1 [drepKeyPair1, paymentKeyInfoPair wallet0] @@ -101,8 +101,8 @@ hprop_ledger_events_drep_deposits = H.integrationWorkspace "drep-deposits" $ \te drepKeyPair2 <- generateDRepKeyPair execConfig drepDir2 "keys" drepRegCert2 <- generateRegistrationCertificate execConfig drepDir2 "reg-cert" drepKeyPair2 minDRepDeposit - drepRegTxBody2 <- createDRepRegistrationTxBody execConfig epochStateView sbe drepDir2 "reg-cert-txbody" - drepRegCert2 wallet1 + drepRegTxBody2 <- createCertificatePublicationTxBody execConfig epochStateView sbe drepDir2 "reg-cert-txbody" + drepRegCert2 wallet1 drepSignedRegTx2 <- signTx execConfig cEra drepDir2 "signed-reg-tx" drepRegTxBody2 [drepKeyPair2, paymentKeyInfoPair wallet1] diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs index 7116fd7e9ce..1129430704d 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs @@ -1,21 +1,39 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Testnet.Test.LedgerEvents.Gov.PredefinedAbstainDRep ( hprop_check_predefined_abstain_drep ) where import Cardano.Api as Api +import Cardano.Api.Error (displayError) import Cardano.Testnet import Prelude +import Control.Monad (void) +import Control.Monad.Catch (MonadCatch) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Lens as AL +import Data.ByteString.Lazy.Char8 (pack) +import Data.String (fromString) +import qualified Data.Text as Text +import Data.Word (Word32) +import GHC.Stack (callStack) +import Lens.Micro ((^?)) import System.FilePath (()) -import Testnet.Components.Query (getEpochStateView) +import Testnet.Components.DReps (SomeKeyPair (..), createCertificatePublicationTxBody, + createVotingTxBody, generateVoteFiles, retrieveTransactionId, signTx, submitTx) +import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey, + getCurrentEpochNo, getEpochStateView, getMinDRepDeposit) +import Testnet.Defaults (defaultDRepKeyPair, defaultDelegatorStakeKeyPair) +import qualified Testnet.Process.Cli as P import qualified Testnet.Process.Run as H import qualified Testnet.Property.Utils as H import Testnet.Runtime @@ -28,7 +46,7 @@ import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO -- @DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Predefined Abstain DRep/"'@ hprop_check_predefined_abstain_drep :: Property hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \tempAbsBasePath' -> do - -- Start a local test net + -- Start a local test net conf@Conf { tempAbsPath } <- mkConf tempAbsBasePath' let tempAbsPath' = unTmpAbsPath tempAbsPath tempBaseAbsPath = makeTmpBaseAbsPath tempAbsPath @@ -48,20 +66,20 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ testnetRuntime@TestnetRuntime { testnetMagic , poolNodes - , wallets=_wallet0:_wallet1:_wallet2:_ + , wallets=wallet0:wallet1:wallet2:_ , configurationFile } <- cardanoTestnetDefault fastTestnetOptions conf poolNode1 <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 - _execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + execConfig <- H.mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic let socketName' = IO.sprocketName poolSprocket1 socketBase = IO.sprocketBase poolSprocket1 -- /tmp socketPath = socketBase socketName' - _epochStateView <- getEpochStateView (File configurationFile) (File socketPath) + epochStateView <- getEpochStateView (File configurationFile) (File socketPath) startLedgerNewEpochStateLogging testnetRuntime tempAbsPath' @@ -70,13 +88,244 @@ hprop_check_predefined_abstain_drep = H.integrationWorkspace "test-activity" $ \ H.note_ $ "Socketpath: " <> socketPath H.note_ $ "Foldblocks config file: " <> configurationFile - _gov <- H.createDirectoryIfMissing $ work "governance" + gov <- H.createDirectoryIfMissing $ work "governance" - -- ToDo: Do some proposal and vote yes with the first DRep only. - -- ToDo: ASSERT: Check that proposal does NOT pass. - -- ToDo: Take the last two stake delegators and delegate them to "Abstain". - -- ToDo: This can be done using cardano-cli conway stake-address vote-delegation-certificate --always-abstain - -- ToDo: Do some other proposal and vote yes with first DRep only. - -- ToDo: ASSERT: Check the new proposal passes now. + initialDesiredNumberOfPools <- getDesiredPoolNumberValue execConfig - success + let newNumberOfDesiredPools = fromIntegral (initialDesiredNumberOfPools + 1) + + -- Do some proposal and vote yes with the first DRep only + -- and assert that proposal does NOT pass. + void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath sbe gov "firstProposal" + wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools initialDesiredNumberOfPools 2 + + -- Take the last two stake delegators and delegate them to "Abstain". + delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe gov "delegateToAbstain1" + wallet1 (defaultDelegatorStakeKeyPair 2) + delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe gov "delegateToAbstain2" + wallet2 (defaultDelegatorStakeKeyPair 3) + + -- Do some other proposal and vote yes with first DRep only + -- and assert the new proposal passes now. + let newNumberOfDesiredPools2 = fromIntegral (newNumberOfDesiredPools + 1) + void $ desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath sbe gov "secondProposal" + wallet0 Nothing [(1, "yes")] newNumberOfDesiredPools2 newNumberOfDesiredPools2 2 + +delegateToAlwaysAbstain + :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m) + => H.ExecConfig + -> EpochStateView + -> FilePath + -> FilePath + -> ShelleyBasedEra ConwayEra + -> FilePath + -> String + -> PaymentKeyInfo + -> StakingKeyPair + -> m () +delegateToAlwaysAbstain execConfig epochStateView configurationFile socketPath sbe work prefix + payingWallet skeyPair@(StakingKeyPair vKeyFile _sKeyFile) = do + + let era = toCardanoEra sbe + cEra = AnyCardanoEra era + + baseDir <- H.createDirectoryIfMissing $ work prefix + + -- Create vote delegation certificate + let voteDelegationCertificatePath = baseDir "delegation-certificate.delegcert" + void $ H.execCli' execConfig + [ "conway", "stake-address", "vote-delegation-certificate" + , "--always-abstain" + , "--stake-verification-key-file", vKeyFile + , "--out-file", voteDelegationCertificatePath + ] + + -- Compose transaction to publish delegation certificate + repRegTxBody1 <- createCertificatePublicationTxBody execConfig epochStateView sbe baseDir "del-cert-txbody" + (File voteDelegationCertificatePath) payingWallet + + -- Sign transaction + repRegSignedRegTx1 <- signTx execConfig cEra baseDir "signed-reg-tx" + repRegTxBody1 [ SomeKeyPair (paymentKeyInfoPair payingWallet) + , SomeKeyPair skeyPair] + + -- Submit transaction + submitTx execConfig cEra repRegSignedRegTx1 + + -- Wait two epochs + (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView sbe + void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + 2)) + +desiredPoolNumberProposalTest + :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t) + => H.ExecConfig + -> EpochStateView + -> FilePath + -> FilePath + -> ShelleyBasedEra ConwayEra + -> FilePath + -> FilePath + -> PaymentKeyInfo + -> Maybe (String, Word32) + -> t (Int, String) + -> Integer + -> Integer + -> Integer + -> m (String, Word32) +desiredPoolNumberProposalTest execConfig epochStateView configurationFile socketPath sbe work prefix + wallet previousProposalInfo votes change expected epochsToWait = do + + baseDir <- H.createDirectoryIfMissing $ work prefix + + let propVotes :: [(String, Int)] + propVotes = zip (concatMap (uncurry replicate) votes) [1..] + annotateShow propVotes + + thisProposal@(governanceActionTxId, governanceActionIndex) <- + makeDesiredPoolNumberChangeProposal execConfig epochStateView (File configurationFile) (File socketPath) + sbe baseDir "proposal" previousProposalInfo (fromIntegral change) wallet + + voteChangeProposal execConfig epochStateView sbe baseDir "vote" + governanceActionTxId governanceActionIndex propVotes wallet + + (EpochNo epochAfterProp) <- getCurrentEpochNo epochStateView sbe + H.note_ $ "Epoch after \"" <> prefix <> "\" prop: " <> show epochAfterProp + + void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + fromIntegral epochsToWait)) + desiredPoolNumberAfterProp <- getDesiredPoolNumberValue execConfig + + desiredPoolNumberAfterProp === expected + + return thisProposal + +makeDesiredPoolNumberChangeProposal + :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m) + => H.ExecConfig + -> EpochStateView + -> NodeConfigFile 'In + -> SocketPath + -> ShelleyBasedEra ConwayEra + -> FilePath + -> String + -> Maybe (String, Word32) + -> Word32 + -> PaymentKeyInfo + -> m (String, Word32) +makeDesiredPoolNumberChangeProposal execConfig epochStateView configurationFile socketPath + sbe work prefix prevGovActionInfo desiredPoolNumber wallet = do + + let era = toCardanoEra sbe + cEra = AnyCardanoEra era + + baseDir <- H.createDirectoryIfMissing $ work prefix + + let stakeVkeyFp = baseDir "stake.vkey" + stakeSKeyFp = baseDir "stake.skey" + + _ <- P.cliStakeAddressKeyGen baseDir + $ P.KeyNames { P.verificationKeyFile = stakeVkeyFp + , P.signingKeyFile = stakeSKeyFp + } + + proposalAnchorFile <- H.note $ baseDir "sample-proposal-anchor" + H.writeFile proposalAnchorFile "dummy anchor data" + + proposalAnchorDataHash <- H.execCli' execConfig + [ "conway", "governance" + , "hash", "anchor-data", "--file-text", proposalAnchorFile + ] + + minDRepDeposit <- getMinDRepDeposit execConfig + + proposalFile <- H.note $ baseDir "sample-proposal-file" + + void $ H.execCli' execConfig $ + [ "conway", "governance", "action", "create-protocol-parameters-update" + , "--testnet" + , "--governance-action-deposit", show @Integer minDRepDeposit + , "--deposit-return-stake-verification-key-file", stakeVkeyFp + ] ++ concatMap (\(prevGovernanceActionTxId, prevGovernanceActionIndex) -> + [ "--prev-governance-action-tx-id", prevGovernanceActionTxId + , "--prev-governance-action-index", show prevGovernanceActionIndex + ]) prevGovActionInfo ++ + [ "--number-of-pools", show desiredPoolNumber + , "--anchor-url", "https://tinyurl.com/3wrwb2as" + , "--anchor-data-hash", proposalAnchorDataHash + , "--out-file", proposalFile + ] + + proposalBody <- H.note $ baseDir "tx.body" + txIn <- findLargestUtxoForPaymentKey epochStateView sbe wallet + + void $ H.execCli' execConfig + [ "conway", "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet + , "--tx-in", Text.unpack $ renderTxIn txIn + , "--proposal-file", proposalFile + , "--out-file", proposalBody + ] + + signedProposalTx <- signTx execConfig cEra baseDir "signed-proposal" + (File proposalBody) [paymentKeyInfoPair wallet] + + submitTx execConfig cEra signedProposalTx + + governanceActionTxId <- retrieveTransactionId execConfig signedProposalTx + + !propSubmittedResult <- findCondition (maybeExtractGovernanceActionIndex sbe (fromString governanceActionTxId)) + (unFile configurationFile) + (unFile socketPath) + (EpochNo 30) + + governanceActionIndex <- case propSubmittedResult of + Left e -> + H.failMessage callStack + $ "findCondition failed with: " <> displayError e + Right Nothing -> + H.failMessage callStack "Couldn't find proposal." + Right (Just a) -> return a + + return (governanceActionTxId, governanceActionIndex) + +voteChangeProposal :: (MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m) + => H.ExecConfig + -> EpochStateView + -> ShelleyBasedEra ConwayEra + -> FilePath + -> FilePath + -> String + -> Word32 + -> [([Char], Int)] + -> PaymentKeyInfo + -> m () +voteChangeProposal execConfig epochStateView sbe work prefix governanceActionTxId governanceActionIndex votes wallet = do + baseDir <- H.createDirectoryIfMissing $ work prefix + + let era = toCardanoEra sbe + cEra = AnyCardanoEra era + + voteFiles <- generateVoteFiles execConfig baseDir "vote-files" + governanceActionTxId governanceActionIndex + [(defaultDRepKeyPair idx, vote) | (vote, idx) <- votes] + + voteTxBodyFp <- createVotingTxBody execConfig epochStateView sbe baseDir "vote-tx-body" + voteFiles wallet + + voteTxFp <- signTx execConfig cEra baseDir "signed-vote-tx" voteTxBodyFp + (paymentKeyInfoPair wallet:[defaultDRepKeyPair n | (_, n) <- votes]) + submitTx execConfig cEra voteTxFp + +getDesiredPoolNumberValue :: (MonadTest m, MonadCatch m, MonadIO m) => H.ExecConfig -> m Integer +getDesiredPoolNumberValue execConfig = do + govStateString <- H.execCli' execConfig + [ "conway", "query", "gov-state" + , "--volatile-tip" + ] + + govStateJSON <- H.nothingFail (Aeson.decode (pack govStateString) :: Maybe Aeson.Value) + let mTargetPoolNum :: Maybe Integer + mTargetPoolNum = govStateJSON + ^? AL.key "currentPParams" + . AL.key "stakePoolTargetNum" + . AL._Integer + evalMaybe mTargetPoolNum