Check if stake address in proposals are registered onchain

IntersectMBO · Nov 7, 2024 · b81a3ea · b81a3ea
1 parent 808d843
commit b81a3ea
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 0 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -57,6 +57,7 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx
 
 import           Control.Monad (forM)
+import           Control.Monad.Cont (unless)
 import           Data.Aeson ((.=))
 import qualified Data.Aeson as Aeson
 import           Data.Aeson.Encode.Pretty (encodePretty)
@@ -198,6 +199,44 @@ runTransactionBuildCmd
         first TxCmdProposalError
           <$> readTxGovernanceActions eon proposalFiles
 
+    -- Extract return addresses from proposals and check that the return address in each proposal is registered
+
+    let returnAddrHashes =
+          Set.fromList
+            [ StakeCredentialByKey returnAddrHash
+            | (proposal, _) <- proposals
+            , let (_, returnAddrHash, _) = fromProposalProcedure eon proposal -- fromProposalProcedure needs to be adjusted so that it works with script hashes.
+            ]
+        treasuryWithdrawalAddresses =
+          Set.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
@@ -29,6 +29,7 @@ import           Cardano.CLI.Types.TxFeature
 import qualified Cardano.Prelude as List
 import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
 
+import           Data.Set (Set)
 import           Data.Text (Text)
 
 {- HLINT ignore "Use let" -}
@@ -84,6 +85,7 @@ data TxCmdError
   | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError
   | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era)
   | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era)
+  | TxCmdUnregisteredStakeAddress !(Set StakeCredential)
 
 renderTxCmdError :: TxCmdError -> Doc ann
 renderTxCmdError = \case
@@ -217,6 +219,8 @@ renderTxCmdError = \case
     prettyError e
   TxCmdFeeEstimationError e ->
     prettyError e
+  TxCmdUnregisteredStakeAddress credentials ->
+    "One or more stake addresses in proposals is not registered:" <+> pshow credentials
 
 prettyPolicyIdList :: [PolicyId] -> Doc ann
 prettyPolicyIdList =