diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 08a8678e27..877e7ddbdf 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -58,7 +58,7 @@ import Cardano.CLI.Types.Errors.TxValidationError import Cardano.CLI.Types.Output (renderScriptCosts) import Cardano.CLI.Types.TxFeature -import Control.Monad (forM) +import Control.Monad (forM, unless) import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) @@ -208,6 +208,44 @@ runTransactionBuildCmd forM_ proposals (checkProposalHashes eon . fst) + -- Extract return addresses from proposals and check that the return address in each proposal is registered + + let returnAddrHashes = + fromList + [ StakeCredentialByKey returnAddrHash + | (proposal, _) <- proposals + , let (_, returnAddrHash, _) = fromProposalProcedure eon proposal -- fromProposalProcedure needs to be adjusted so that it works with script hashes. + ] + treasuryWithdrawalAddresses = + fromList + [ stakeCred + | (proposal, _) <- proposals + , let (_, _, govAction) = fromProposalProcedure eon proposal + , TreasuryWithdrawal withdrawalsList _ <- [govAction] -- Match on TreasuryWithdrawal action + , (_, stakeCred, _) <- withdrawalsList -- Extract fund-receiving stake credentials + ] + allAddrHashes = Set.union returnAddrHashes treasuryWithdrawalAddresses + + (balances, _) <- + lift + ( executeLocalStateQueryExpr + localNodeConnInfo + Consensus.VolatileTip + (queryStakeAddresses eon allAddrHashes networkId) + ) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + & onLeft (left . TxCmdTxSubmitErrorEraMismatch) + + let unregisteredAddresses = + Set.filter + (\stakeCred -> Map.notMember (makeStakeAddress networkId stakeCred) balances) + allAddrHashes + + unless (null unregisteredAddresses) $ + throwError $ + TxCmdUnregisteredStakeAddress unregisteredAddresses + -- the same collateral input can be used for several plutus scripts let filteredTxinsc = nubOrd txinsc diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index 510ebf6193..19582fba41 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -31,6 +31,7 @@ import Cardano.CLI.Types.Output import Cardano.CLI.Types.TxFeature import qualified Cardano.Prelude as List +import Data.Set (Set) import Data.Text (Text) {- HLINT ignore "Use let" -} @@ -88,6 +89,7 @@ data TxCmdError | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era) | TxCmdPoolMetadataHashError AnchorDataFromCertificateError | TxCmdHashCheckError L.Url HashCheckError + | TxCmdUnregisteredStakeAddress !(Set StakeCredential) renderTxCmdError :: TxCmdError -> Doc ann renderTxCmdError = \case @@ -225,6 +227,8 @@ renderTxCmdError = \case "Hash of the pool metadata hash is not valid:" <+> prettyError e TxCmdHashCheckError url e -> "Hash of the file is not valid. Url:" <+> pretty (L.urlToText url) <+> prettyException e + TxCmdUnregisteredStakeAddress credentials -> + "Stake credential specified in the proposal is not registered on-chain:" <+> pshow credentials prettyPolicyIdList :: [PolicyId] -> Doc ann prettyPolicyIdList =