Improve error handling

IntersectMBO · Nov 7, 2024 · 159e02a · 159e02a
1 parent 900be5f
commit 159e02a
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 21 deletions.
diff --git 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
@@ -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)