Improve shelley cli errors to include which command failed

cardano-cli/src/Cardano/CLI/Run.hs

@@ -39,18 +39,20 @@ data ClientCommand =
 
 data ClientCommandErrors
   = ByronClientError ByronClientCmdError
-  | ShelleyClientError ShelleyClientCmdError
+  | ShelleyClientError ShelleyCommand ShelleyClientCmdError
   deriving Show
   --TODO: We should include an AgnosticClientError
 
 runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO ()
-runClientCommand (ByronCommand   c) = firstExceptT ByronClientError $ runByronClientCommand c
-runClientCommand (ShelleyCommand c) = firstExceptT ShelleyClientError $ runShelleyClientCommand c
-runClientCommand DisplayVersion     = runDisplayVersion
+runClientCommand (ByronCommand c) = firstExceptT ByronClientError $ runByronClientCommand c
+runClientCommand (ShelleyCommand c) = firstExceptT (ShelleyClientError c) $ runShelleyClientCommand c
+runClientCommand DisplayVersion = runDisplayVersion
 
 renderClientCommandError :: ClientCommandErrors -> Text
-renderClientCommandError (ByronClientError err) = renderByronClientCmdError err
-renderClientCommandError (ShelleyClientError err) = renderShelleyClientCmdError err
+renderClientCommandError (ByronClientError err) =
+  renderByronClientCmdError err
+renderClientCommandError (ShelleyClientError cmd err) =
+  runIdentity $ renderShelleyClientCmdError cmd err
 
 runDisplayVersion :: ExceptT ClientCommandErrors IO ()
 runDisplayVersion = do

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -13,6 +13,7 @@ module Cardano.CLI.Shelley.Commands
   , GovernanceCmd (..)
   , GenesisCmd (..)
   , TextViewCmd (..)
+  , renderShelleyCommand
 
     -- * CLI flag types
   , AddressKeyType (..)
@@ -70,6 +71,19 @@ data ShelleyCommand
   | TextViewCmd     TextViewCmd
   deriving (Eq, Show)
 
+renderShelleyCommand :: ShelleyCommand -> Text
+renderShelleyCommand sc =
+  case sc of
+    AddressCmd cmd -> renderAddressCmd cmd
+    StakeAddressCmd cmd -> renderStakeAddressCmd cmd
+    KeyCmd cmd -> renderKeyCmd cmd
+    TransactionCmd cmd -> renderTransactionCmd cmd
+    NodeCmd cmd -> renderNodeCmd cmd
+    PoolCmd cmd -> renderPoolCmd cmd
+    QueryCmd cmd -> renderQueryCmd cmd
+    GovernanceCmd cmd -> renderGovernanceCmd cmd
+    GenesisCmd cmd -> renderGenesisCmd cmd
+    TextViewCmd cmd -> renderTextViewCmd cmd
 
 data AddressCmd
   = AddressKeyGen AddressKeyType VerificationKeyFile SigningKeyFile
@@ -79,6 +93,16 @@ data AddressCmd
   | AddressInfo Text (Maybe OutputFile)
   deriving (Eq, Show)
 
+
+renderAddressCmd :: AddressCmd -> Text
+renderAddressCmd cmd =
+  case cmd of
+    (AddressKeyGen _ _ _) -> "address key-gen"
+    (AddressKeyHash _ _) -> "address key-hash"
+    (AddressBuild _ _ _ _) -> "address build"
+    (AddressBuildMultiSig) -> "address build-multisig"
+    (AddressInfo _ _) -> "address info"
+
 data StakeAddressCmd
   = StakeAddressKeyGen VerificationKeyFile SigningKeyFile
   | StakeAddressKeyHash VerificationKeyFile (Maybe OutputFile)
@@ -88,6 +112,16 @@ data StakeAddressCmd
   | StakeKeyDeRegistrationCert VerificationKeyFile OutputFile
   deriving (Eq, Show)
 
+renderStakeAddressCmd :: StakeAddressCmd -> Text
+renderStakeAddressCmd cmd =
+  case cmd of
+    StakeAddressKeyGen _ _ -> "stake-address key-gen"
+    StakeAddressKeyHash _ _ -> "stake-address key-hash"
+    StakeAddressBuild _ _ _ -> "stake-address build"
+    StakeKeyRegistrationCert _ _ -> "stake-address registration-certificate"
+    StakeKeyDelegationCert _ _ _ -> "stake-address delegation-certificate"
+    StakeKeyDeRegistrationCert _ _ -> "stake-address deregistration-certificate"
+
 data KeyCmd
   = KeyGetVerificationKey SigningKeyFile VerificationKeyFile
   | KeyNonExtendedKey  VerificationKeyFile VerificationKeyFile
@@ -98,6 +132,17 @@ data KeyCmd
   | KeyConvertITNBip32ToStakeKey SomeKeyFile OutputFile
   deriving (Eq, Show)
 
+renderKeyCmd :: KeyCmd -> Text
+renderKeyCmd cmd =
+  case cmd of
+    KeyGetVerificationKey _ _ -> "key verification-key"
+    KeyNonExtendedKey  _ _ -> "key non-extended-key"
+    KeyConvertByronKey _ _ _ _ -> "key convert-byron-key"
+    KeyConvertByronGenesisVKey _ _ -> "key convert-byron-genesis-key"
+    KeyConvertITNStakeKey _ _ -> "key convert-itn-key"
+    KeyConvertITNExtendedToStakeKey _ _ -> "key convert-itn-extended-key"
+    KeyConvertITNBip32ToStakeKey _ _ -> "key convert-itn-bip32-key"
+
 data TransactionCmd
   = TxBuildRaw
       [TxIn]
@@ -124,6 +169,16 @@ data TransactionCmd
   | TxGetTxId TxBodyFile
   deriving (Eq, Show)
 
+renderTransactionCmd :: TransactionCmd -> Text
+renderTransactionCmd cmd =
+  case cmd of
+    TxBuildRaw _ _ _ _ _ _ _ _ _ -> "transaction build-raw"
+    TxSign _ _ _ _ -> "transaction sign"
+    TxWitness _ _ _ _ -> "transaction witness"
+    TxSignWitness _ _ _ -> "transaction sign-witness"
+    TxSubmit _ _ _ -> "transaction submit"
+    TxCalculateMinFee _ _ _ _ _ _ _ -> "transaction calculate-min-fee"
+    TxGetTxId _ -> "transaction txid"
 
 data NodeCmd
   = NodeKeyGenCold VerificationKeyFile SigningKeyFile OpCertCounterFile
@@ -135,6 +190,17 @@ data NodeCmd
                     KESPeriod OutputFile
   deriving (Eq, Show)
 
+renderNodeCmd :: NodeCmd -> Text
+renderNodeCmd cmd = do
+  case cmd of
+    NodeKeyGenCold _ _ _ -> "node key-gen"
+    NodeKeyGenKES  _ _ -> "node key-gen-KES"
+    NodeKeyGenVRF  _ _ -> "node key-gen-VRF"
+    NodeKeyHashVRF  _ _ -> "node key-hash-VRF"
+    NodeNewCounter  _ _ _ -> "node new-counter"
+    NodeIssueOpCert _ _ _ _ _ -> "node issue-op-cert"
+
+
 data PoolCmd
   = PoolRegistrationCert
       VerificationKeyFile
@@ -167,6 +233,13 @@ data PoolCmd
   | PoolMetaDataHash PoolMetaDataFile (Maybe OutputFile)
   deriving (Eq, Show)
 
+renderPoolCmd :: PoolCmd -> Text
+renderPoolCmd cmd =
+  case cmd of
+    PoolRegistrationCert _ _ _ _ _ _ _ _ _ _ _ -> "stake-pool registration-certificate"
+    PoolRetirementCert _ _ _ -> "stake-pool deregistration-certificate"
+    PoolGetId _ -> "stake-pool id"
+    PoolMetaDataHash _ _ -> "stake-pool metadata-hash"
 
 data QueryCmd =
     QueryProtocolParameters Protocol NetworkId (Maybe OutputFile)
@@ -177,18 +250,37 @@ data QueryCmd =
   | QueryLedgerState Protocol NetworkId (Maybe OutputFile)
   deriving (Eq, Show)
 
+renderQueryCmd :: QueryCmd -> Text
+renderQueryCmd cmd =
+  case cmd of
+    QueryProtocolParameters _ _ _ -> "query protocol-parameters "
+    QueryTip _ _ _ -> "query tip"
+    QueryStakeDistribution _ _ _ -> "query stake-distribution"
+    QueryStakeAddressInfo _ _ _ _ -> "query stake-address-info"
+    QueryUTxO _ _ _ _ -> "query utxo"
+    QueryLedgerState _ _ _ -> "query ledger-state"
+
 data GovernanceCmd
   = GovernanceMIRCertificate MIRPot [VerificationKeyFile] [Lovelace] OutputFile
   | GovernanceUpdateProposal OutputFile EpochNo
                              [VerificationKeyFile]
                              ProtocolParametersUpdate
   deriving (Eq, Show)
 
+renderGovernanceCmd :: GovernanceCmd -> Text
+renderGovernanceCmd cmd =
+  case cmd of
+    GovernanceMIRCertificate _ _ _ _ -> "governance create-mir-certificate"
+    GovernanceUpdateProposal _ _ _ _ -> "governance create-update-proposal"
 
 data TextViewCmd
   = TextViewInfo !FilePath (Maybe OutputFile)
   deriving (Eq, Show)
 
+
+renderTextViewCmd :: TextViewCmd -> Text
+renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor"
+
 data GenesisCmd
   = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId
   | GenesisKeyGenGenesis VerificationKeyFile SigningKeyFile
@@ -201,6 +293,19 @@ data GenesisCmd
   | GenesisHashFile GenesisFile
   deriving (Eq, Show)
 
+renderGenesisCmd :: GenesisCmd -> Text
+renderGenesisCmd cmd =
+  case cmd of
+    GenesisCreate _ _ _ _ _ _-> "genesis create"
+    GenesisKeyGenGenesis _ _ -> "genesis key-gen-genesis"
+    GenesisKeyGenDelegate _ _ _ -> "genesis key-gen-delegate"
+    GenesisKeyGenUTxO _ _ -> "genesis key-gen-utxo"
+    GenesisCmdKeyHash _ -> "genesis key-hash"
+    GenesisVerKey _ _ -> "genesis get-ver-key"
+    GenesisTxIn _ _ _ -> "genesis initial-txin"
+    GenesisAddr _ _ _ -> "genesis initial-addr"
+    GenesisHashFile _ -> "genesis hash"
+
 --
 -- Shelley CLI flag/option data types
 --

cardano-cli/src/Cardano/CLI/Shelley/Run.hs

@@ -36,19 +36,36 @@ data ShelleyClientCmdError
   | ShelleyCmdKeyError !ShelleyKeyCmdError
   deriving Show
 
-renderShelleyClientCmdError :: ShelleyClientCmdError -> Text
-renderShelleyClientCmdError err =
-  case err of
-    ShelleyCmdAddressError addrCmdErr -> renderShelleyAddressCmdError addrCmdErr
-    ShelleyCmdGenesisError genesisCmdErr -> renderShelleyGenesisCmdError genesisCmdErr
-    ShelleyCmdGovernanceError govCmdErr -> renderShelleyGovernanceError govCmdErr
-    ShelleyCmdNodeError nodeCmdErr -> renderShelleyNodeCmdError nodeCmdErr
-    ShelleyCmdPoolError poolCmdErr -> renderShelleyPoolCmdError poolCmdErr
-    ShelleyCmdStakeAddressError stakeAddrCmdErr -> renderShelleyStakeAddressCmdError stakeAddrCmdErr
-    ShelleyCmdTextViewError txtViewErr -> renderShelleyTextViewFileError txtViewErr
-    ShelleyCmdTransactionError txErr -> renderShelleyTxCmdError txErr
-    ShelleyCmdQueryError queryErr -> renderShelleyQueryCmdError queryErr
-    ShelleyCmdKeyError keyErr -> renderShelleyKeyCmdError keyErr
+-- Identity monad is used to avoid boilerplate
+renderShelleyClientCmdError :: ShelleyCommand -> ShelleyClientCmdError -> Identity Text
+renderShelleyClientCmdError cmd err = do
+  cmdError <- case err of
+                ShelleyCmdAddressError addrCmdErr ->
+                  return $ renderShelleyAddressCmdError addrCmdErr
+                ShelleyCmdGenesisError genesisCmdErr ->
+                  return $ renderShelleyGenesisCmdError genesisCmdErr
+                ShelleyCmdGovernanceError govCmdErr ->
+                  return $ renderShelleyGovernanceError govCmdErr
+                ShelleyCmdNodeError nodeCmdErr ->
+                  return $ renderShelleyNodeCmdError nodeCmdErr
+                ShelleyCmdPoolError poolCmdErr ->
+                  return $ renderShelleyPoolCmdError poolCmdErr
+                ShelleyCmdStakeAddressError stakeAddrCmdErr ->
+                  return $ renderShelleyStakeAddressCmdError stakeAddrCmdErr
+                ShelleyCmdTextViewError txtViewErr ->
+                  return $ renderShelleyTextViewFileError txtViewErr
+                ShelleyCmdTransactionError txErr ->
+                  return $ renderShelleyTxCmdError txErr
+                ShelleyCmdQueryError queryErr ->
+                  return $ renderShelleyQueryCmdError queryErr
+                ShelleyCmdKeyError keyErr ->
+                  return $ renderShelleyKeyCmdError keyErr
+
+  return $ "Shelley command failed: "
+         <> renderShelleyCommand cmd
+         <> "  Error: "
+         <> cmdError
+
 
 --
 -- CLI shelley command dispatch