Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Check if stake addresses in proposals are registered onchain #963

Merged
merged 5 commits into from
Nov 15, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 39 additions & 1 deletion cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
CarlosLopezDeLara marked this conversation as resolved.
Show resolved Hide resolved
, (_, 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

Expand Down
4 changes: 4 additions & 0 deletions cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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" -}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
Loading