Add error type in Cardano.CLI.EraBased.Run

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

@@ -67,7 +67,7 @@ data GovernanceCmdError
 instance Error GovernanceCmdError where
   displayError = \case
     StakeCredGovCmdError stakeAddressCmdError ->
-      "Stake credential error: " <> toS (renderShelleyStakeAddressCmdError stakeAddressCmdError)
+      "Stake credential error: " <> displayError stakeAddressCmdError
     VotingCredentialDecodeGovCmdEror decoderError ->
       "Could not decode voting credential: " <> renderDecoderError decoderError
     WriteFileError fileError ->

cardano-cli/src/Cardano/CLI/EraBased/Errors/StakeAddress.hs

@@ -1,16 +1,19 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 module Cardano.CLI.EraBased.Errors.StakeAddress
   ( ShelleyStakeAddressCmdError(..)
   , StakeAddressRegistrationError(..)
   , StakeAddressDelegationError(..)
-  , renderShelleyStakeAddressCmdError
   ) where
 
 import           Cardano.Api
 
 import           Cardano.CLI.Read
+import           Cardano.Prelude (toS)
 
-import           Data.Text (Text)
-import qualified Data.Text as Text
+import qualified Data.Aeson as A
 
 data ShelleyStakeAddressCmdError
   = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError)
@@ -20,15 +23,30 @@ data ShelleyStakeAddressCmdError
   | StakeDelegationError !StakeAddressDelegationError
   deriving Show
 
-renderShelleyStakeAddressCmdError :: ShelleyStakeAddressCmdError -> Text
-renderShelleyStakeAddressCmdError err =
-  case err of
-    ShelleyStakeAddressCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr)
-    ShelleyStakeAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr)
-    ShelleyStakeAddressCmdReadScriptFileError fileErr -> Text.pack (displayError fileErr)
-    StakeRegistrationError regErr -> Text.pack $ show regErr
-    StakeDelegationError delegErr -> Text.pack $ show delegErr
+
+instance Error ShelleyStakeAddressCmdError where
+  displayError = \case
+    ShelleyStakeAddressCmdReadKeyFileError fileErr    -> displayError fileErr
+    ShelleyStakeAddressCmdWriteFileError fileErr      -> displayError fileErr
+    ShelleyStakeAddressCmdReadScriptFileError fileErr -> displayError fileErr
+    StakeRegistrationError regErr                     -> displayError regErr
+    StakeDelegationError delegErr                     -> displayError delegErr
 
 data StakeAddressRegistrationError = StakeAddressRegistrationDepositRequired deriving Show
 
+instance Error StakeAddressRegistrationError where
+  displayError = \case
+    StakeAddressRegistrationDepositRequired -> "Stake address deposit required."
+
 newtype StakeAddressDelegationError = VoteDelegationNotSupported AnyShelleyToBabbageEra deriving Show
+
+instance Error StakeAddressDelegationError where
+  displayError = \case
+    VoteDelegationNotSupported (AnyShelleyToBabbageEra stbe) -> "Vote delegation not supported in " <> eraTxt stbe <> " era."
+      where
+        eraTxt :: forall era. ShelleyToBabbageEra era -> String
+        eraTxt stbe' = shelleyToBabbageEraConstraints stbe' $
+          case A.toJSON (cardanoEra @era) of
+            A.String str -> toS str
+            other -> show other
+

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

@@ -6,12 +6,11 @@ module Cardano.CLI.EraBased.Run
   , runAnyEraCommand
   , runEraBasedCommand
   , runEraBasedGovernanceCmds
-
-  , renderAnyEraCmdError
   ) where
 
 import           Cardano.Api
 
+import           Cardano.CLI.Commands.Governance
 import           Cardano.CLI.EraBased.Commands
 import           Cardano.CLI.EraBased.Options.Governance
 import           Cardano.CLI.EraBased.Run.Certificate
@@ -22,72 +21,85 @@ import           Cardano.CLI.EraBased.Vote
 
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
-import           Data.Text (Text)
-
-newtype AnyEraCmdError
-  = AnyEraCmdGenericError ()
-
-renderAnyEraCmdError :: AnyEraCmdError -> Text
-renderAnyEraCmdError = \case
-  AnyEraCmdGenericError () -> "Generic any era command error"
+import           Data.Function ((&))
+
+data AnyEraCmdError
+  = AnyEraCmdGovernanceCmdError        !GovernanceCmdError
+  | AnyEraCmdEraDelegationError        !EraBasedDelegationError
+  | AnyEraCmdEraBasedRegistrationError !EraBasedRegistrationError
+  | AnyEraCmdEraBasedVoteError         !EraBasedVoteError
+  | AnyEraCmdGovernanceCommitteeError  !GovernanceCommitteeError
+  | AnyEraCmdGovernanceActionError     !GovernanceActionsError
+  deriving Show
+
+instance Error AnyEraCmdError where
+  displayError = \case
+    AnyEraCmdGovernanceCmdError e -> displayError e
+    AnyEraCmdEraDelegationError e -> displayError e
+    AnyEraCmdEraBasedRegistrationError e -> displayError e
+    AnyEraCmdEraBasedVoteError e -> displayError e
+    AnyEraCmdGovernanceCommitteeError e -> displayError e
+    AnyEraCmdGovernanceActionError e -> displayError e
 
 runAnyEraCommand :: ()
   => AnyEraCommand
   -> ExceptT AnyEraCmdError IO ()
 runAnyEraCommand = \case
   AnyEraCommandOf sbe cmd ->
-    firstExceptT AnyEraCmdGenericError $ shelleyBasedEraConstraints sbe $ runEraBasedCommand cmd
+    shelleyBasedEraConstraints sbe $ runEraBasedCommand cmd
 
 runEraBasedCommand :: ()
-  => EraBasedCommand era -> ExceptT () IO ()
+  => EraBasedCommand era -> ExceptT AnyEraCmdError IO ()
 runEraBasedCommand = \case
   EraBasedGovernanceCmds cmd -> runEraBasedGovernanceCmds cmd
 
 runEraBasedGovernanceCmds :: ()
   => EraBasedGovernanceCmds era
-  -> ExceptT () IO ()
+  -> ExceptT AnyEraCmdError IO ()
 runEraBasedGovernanceCmds = \case
   EraBasedGovernancePreConwayCmd w ->
     runEraBasedGovernancePreConwayCmd w
   EraBasedGovernancePostConwayCmd w ->
     runEraBasedGovernancePostConwayCmd w
   EraBasedGovernanceMIRPayStakeAddressesCertificate w mirpot vKeys rewards out ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceMIRCertificatePayStakeAddrs w mirpot vKeys rewards out
+    runGovernanceMIRCertificatePayStakeAddrs w mirpot vKeys rewards out
+      & firstExceptT AnyEraCmdGovernanceCmdError
 
   EraBasedGovernanceMIRTransfer w ll oFp direction ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceMIRCertificateTransfer w ll oFp direction
+    runGovernanceMIRCertificateTransfer w ll oFp direction
+      & firstExceptT AnyEraCmdGovernanceCmdError
 
   EraBasedGovernanceDelegationCertificateCmd stakeIdentifier delegationTarget outFp ->
-    firstExceptT (const ()) -- TODO fix error handling
-      $ runGovernanceDelegationCertificate stakeIdentifier delegationTarget outFp
+    runGovernanceDelegationCertificate stakeIdentifier delegationTarget outFp
+      & firstExceptT AnyEraCmdEraDelegationError
 
   EraBasedGovernanceRegistrationCertificateCmd regTarget outFp ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceRegistrationCertificate regTarget outFp
+    runGovernanceRegistrationCertificate regTarget outFp
+      & firstExceptT AnyEraCmdEraBasedRegistrationError
+
   EraBasedGovernanceVoteCmd anyVote outFp ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceVote anyVote outFp
+    runGovernanceVote anyVote outFp
+      & firstExceptT AnyEraCmdEraBasedVoteError
 
   EraBasedGovernanceCommitteeCmds cmds ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceCommitteeCmds cmds
+    runGovernanceCommitteeCmds cmds
+      & firstExceptT AnyEraCmdGovernanceCommitteeError
 
   EraBasedGovernanceActionCmds cmds ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceActionCmds cmds
+    runGovernanceActionCmds cmds
+      & firstExceptT AnyEraCmdGovernanceActionError
 
   EraBasedGovernanceDRepGenerateKey w vrf sgn ->
-    firstExceptT (const ()) -- TODO: Conway era - fix error handling
-      $ runGovernanceDRepKeyGen w vrf sgn
+    runGovernanceDRepKeyGen w vrf sgn
+      & firstExceptT AnyEraCmdGovernanceCmdError
+
 
 runEraBasedGovernancePreConwayCmd
   :: ShelleyToBabbageEra era
-  -> ExceptT () IO ()
+  -> ExceptT e IO ()
 runEraBasedGovernancePreConwayCmd _w = pure ()
 
 runEraBasedGovernancePostConwayCmd
   :: ConwayEraOnwards era
-  -> ExceptT () IO ()
+  -> ExceptT e IO ()
 runEraBasedGovernancePostConwayCmd _w = pure ()

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
@@ -30,6 +31,7 @@ import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra
 import           Data.Function
+import           GHC.Generics (Generic)
 
 -- Delegation Certificate related
 
@@ -38,7 +40,18 @@ data EraBasedDelegationError
   | EraBasedCredentialError !ShelleyStakeAddressCmdError -- TODO: Refactor. We shouldn't be using legacy error types
   | EraBasedCertificateWriteFileError !(FileError ())
   | EraBasedDRepReadError !(FileError InputDecodeError)
-  | EraBasedDelegationGenericError -- TODO Delete and replace with more specific errors
+  deriving (Show, Generic)
+
+instance Error EraBasedDelegationError where
+  displayError = \case
+    EraBasedDelegReadError e ->
+      "Cannot read delegation target: " <> displayError e
+    EraBasedCredentialError e ->
+      "Cannot get stake credential: " <> displayError e
+    EraBasedCertificateWriteFileError e ->
+      "Cannot write certificate: " <> displayError e
+    EraBasedDRepReadError e ->
+      "Cannot read DRep key: " <> displayError e
 
 runGovernanceDelegationCertificate
   :: StakeIdentifier
@@ -123,7 +136,15 @@ data EraBasedRegistrationError
   = EraBasedRegistReadError !(FileError InputDecodeError)
   | EraBasedRegistWriteFileError !(FileError ())
   | EraBasedRegistStakeCredReadError !ShelleyStakeAddressCmdError -- TODO: Conway era - don't use legacy error type
-  | EraBasedRegistStakeError StakeAddressRegistrationError
+  | EraBasedRegistStakeError !StakeAddressRegistrationError
+  deriving Show
+
+instance Error EraBasedRegistrationError where
+  displayError = \case
+    EraBasedRegistReadError e -> "Cannot read registration certificate: " <> displayError e
+    EraBasedRegistWriteFileError e -> "Cannot write registration certificate: " <> displayError e
+    EraBasedRegistStakeCredReadError e -> "Cannot read stake credential: " <> displayError e
+    EraBasedRegistStakeError e -> "Stake address registation error: " <> displayError e
 
 runGovernanceRegistrationCertificate
   :: AnyRegistrationTarget

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs

@@ -3,6 +3,7 @@
 
 module Cardano.CLI.EraBased.Run.Governance.Actions
   ( runGovernanceActionCmds
+  , GovernanceActionsError(..)
   ) where
 
 import           Cardano.Api
@@ -25,7 +26,16 @@ data GovernanceActionsError
   = GovernanceActionsCmdWriteFileError (FileError ())
   | GovernanceActionsCmdReadFileError (FileError InputDecodeError)
   | GovernanceActionsCmdNonUtf8EncodedConstitution UnicodeException
-
+  deriving Show
+
+instance Error GovernanceActionsError where
+  displayError = \case
+    GovernanceActionsCmdWriteFileError e ->
+      "Cannot write file: " <> displayError e
+    GovernanceActionsCmdReadFileError e ->
+      "Cannot read file: " <> displayError e
+    GovernanceActionsCmdNonUtf8EncodedConstitution e ->
+      "Cannot read constitution: " <> show e
 
 runGovernanceActionCmds :: ()
   => GovernanceActionCmds era

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Committee.hs

@@ -3,6 +3,7 @@
 
 module Cardano.CLI.EraBased.Run.Governance.Committee
   ( runGovernanceCommitteeCmds
+  , GovernanceCommitteeError(..)
   ) where
 
 import           Cardano.Api
@@ -19,6 +20,12 @@ import           Data.Function
 data GovernanceCommitteeError
   = GovernanceCommitteeCmdWriteFileError (FileError ())
   | GovernanceCommitteeCmdTextEnvReadFileError (FileError TextEnvelopeError)
+  deriving Show
+
+instance Error GovernanceCommitteeError where
+  displayError = \case
+    GovernanceCommitteeCmdWriteFileError e -> "Cannot write file: " <> displayError e
+    GovernanceCommitteeCmdTextEnvReadFileError e -> "Cannot read file: " <> displayError e
 
 runGovernanceCommitteeCmds :: ()
   => GovernanceCommitteeCmds era

cardano-cli/src/Cardano/CLI/EraBased/Vote.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.EraBased.Vote where
 
@@ -9,15 +10,30 @@ import           Cardano.Api.Shelley
 import           Cardano.Binary (DecoderError)
 import           Cardano.CLI.Types.Governance
 import           Cardano.CLI.Types.Key
+import           Cardano.Prelude (toS)
 
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Except.Extra
 import           Data.Bifunctor
+import qualified Data.Text.Lazy.Builder as TL
+import qualified Formatting.Buildable as B
 
 data EraBasedVoteError
   = EraBasedVoteReadError !(FileError InputDecodeError)
   | EraBasedVotingCredentialDecodeError !DecoderError
   | EraBasedVoteWriteError !(FileError ())
+  deriving Show
+
+instance Error EraBasedVoteError where
+  displayError = \case
+    EraBasedVoteReadError e ->
+      "Cannot read verification key: " <> displayError e
+    EraBasedVotingCredentialDecodeError e ->
+      "Cannot decode voting credential: " <> renderDecoderError e
+    EraBasedVoteWriteError e ->
+      "Cannot write vote: " <> displayError e
+    where
+      renderDecoderError = toS . TL.toLazyText . B.build
 
 runGovernanceVote
   :: AnyVote

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

@@ -20,6 +20,7 @@ import           Cardano.CLI.Legacy.Run.Query
 import           Cardano.CLI.Legacy.Run.StakeAddress
 import           Cardano.CLI.Legacy.Run.TextView
 import           Cardano.CLI.Legacy.Run.Transaction
+import           Cardano.Prelude (toS)
 
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
@@ -52,7 +53,7 @@ renderLegacyClientCmdError cmd err =
     LegacyCmdPoolError poolCmdErr ->
        renderError cmd renderShelleyPoolCmdError poolCmdErr
     LegacyCmdStakeAddressError stakeAddrCmdErr ->
-       renderError cmd renderShelleyStakeAddressCmdError stakeAddrCmdErr
+       renderError cmd (toS . displayError) stakeAddrCmdErr
     LegacyCmdTextViewError txtViewErr ->
        renderError cmd renderShelleyTextViewFileError txtViewErr
     LegacyCmdTransactionError txErr ->