diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 6fb0c46e2..49db322af 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -56,7 +56,7 @@ import Cardano.CLI.Types.TxFeature import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx -import Control.Monad (forM, when) +import Control.Monad (forM) import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) @@ -80,7 +80,7 @@ import Data.Type.Equality (TestEquality (..)) import GHC.Exts (IsList (..)) import Lens.Micro ((^.)) import qualified System.IO as IO -import Control.Exception (throwIO) +import Control.Monad.Cont (unless) runTransactionCmds :: Cmd.TransactionCmds era -> ExceptT TxCmdError IO () runTransactionCmds = \case @@ -201,35 +201,29 @@ runTransactionBuildCmd -- Extract return addresses from proposals and check that the return address in each proposal is registered - let returnAddrHashes = Set.fromList --queryStakeAddresses used bellow takes a Set of StakeCredential + 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. ] - - let treasuryWithdrawalAddresses = Set.fromList + treasuryWithdrawalAddresses = Set.fromList [ stakeCred | (proposal, _) <- proposals , let (_, _, govAction) = fromProposalProcedure eon proposal , TreasuryWithdrawal withdrawalsList _ <- [govAction] -- Match on TreasuryWithdrawal action - , (_, stakeCred, _) <- withdrawalsList -- Extract each stake credential in treasury withdrawals + , (_, stakeCred, _) <- withdrawalsList -- Extract fund-receiving stake credentials ] + allAddrHashes = Set.union returnAddrHashes treasuryWithdrawalAddresses - let allAddrHashes = Set.union returnAddrHashes treasuryWithdrawalAddresses - - queryResult <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip $ - queryStakeAddresses eon allAddrHashes networkId + (balances, _) <- lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip (queryStakeAddresses eon allAddrHashes networkId)) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + & onLeft (left . TxCmdTxSubmitErrorEraMismatch) - let unregisteredAddresses = case queryResult of - Right (Right (Right (balances, _))) -> - filter (\stakeCred -> not (Map.member (makeStakeAddress networkId stakeCred) balances)) (Set.toList allAddrHashes) - _ -> Set.toList allAddrHashes -- If query failed, add to the unregistered addresses list. - - -- WIP: This is a temporary solution to handle error message. - when (not (null unregisteredAddresses)) $ liftIO $ do - let errMsg = "Error: One or more stake addresses in proposals is not registered: " ++ show unregisteredAddresses - IO.hPutStrLn IO.stderr errMsg - throwIO $ userError errMsg + 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 e0b9d0134..68a757cf8 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -30,6 +30,7 @@ import qualified Cardano.Prelude as List import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) import Data.Text (Text) +import Data.Set (Set) {- 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,7 +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 = mconcat . List.intersperse ", " . fmap (pretty . serialiseToRawBytesHexText)