Merge pull request #963 from IntersectMBO/cl/checkproposal

Check if stake addresses in proposals are registered onchain
IntersectMBO · Nov 15, 2024 · 3983bcb · 3983bcb
2 parents fe918b3 + 9f6376c
commit 3983bcb
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 1 deletion.
diff --git 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
@@ -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 =