Upstream Error instances from cardano-cli. Add lens fixities in fourmolu config.

Author: carbolymer

cardano-api/src/Cardano/Api/Experimental/Era.hs

@@ -39,6 +39,7 @@ import Cardano.Api.Era.Internal.Eon.Convert
 import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
 import Cardano.Api.Era.Internal.Eon.MaryEraOnwards
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra)
+import Cardano.Api.Error
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
 import Cardano.Api.Pretty.Internal.ShowOf
 
@@ -232,6 +233,10 @@ newtype DeprecatedEra era
 
 deriving via (ShowOf (DeprecatedEra era)) instance Pretty (DeprecatedEra era)
 
+instance Error (DeprecatedEra era) where
+  prettyError (DeprecatedEra era) =
+    "The era " <> pretty (show era) <> " is deprecated and no longer supported."
+
 sbeToEra
   :: MonadError (DeprecatedEra era) m
   => ShelleyBasedEra era

cardano-api/src/Cardano/Api/Governance/Internal/Action/VotingProcedure.hs

@@ -17,9 +17,11 @@ module Cardano.Api.Governance.Internal.Action.VotingProcedure where
 import Cardano.Api.Address
 import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
+import Cardano.Api.Error
 import Cardano.Api.Governance.Internal.Action.ProposalProcedure
 import Cardano.Api.HasTypeProxy
 import Cardano.Api.Ledger.Internal.Reexport qualified as Ledger
+import Cardano.Api.Pretty (pshow)
 import Cardano.Api.Serialise.Cbor
 import Cardano.Api.Serialise.TextEnvelope.Internal
 
@@ -144,6 +146,9 @@ newtype VotesMergingConflict era
       )
   deriving Show
 
+instance Error (VotesMergingConflict era) where
+  prettyError = pshow
+
 -- | @mergeVotingProcedures vote1 vote2@ merges @vote1@ and @vote2@ into a single vote,
 -- or fails if the votes are incompatible.
 mergeVotingProcedures

cardano-api/src/Cardano/Api/Governance/Internal/Poll.hs

@@ -37,6 +37,7 @@ module Cardano.Api.Governance.Internal.Poll
 where
 
 import Cardano.Api.Era
+import Cardano.Api.Error
 import Cardano.Api.HasTypeProxy
 import Cardano.Api.Hash
 import Cardano.Api.Key.Internal
@@ -278,6 +279,9 @@ data GovernancePollError
   | ErrGovernancePollInvalidAnswer GovernancePollInvalidAnswerError
   deriving Show
 
+instance Error GovernancePollError where
+  prettyError = pretty . renderGovernancePollError
+
 data GovernancePollInvalidAnswerError = GovernancePollInvalidAnswerError
   { invalidAnswerAcceptableAnswers :: [(Word, Text)]
   , invalidAnswerReceivedAnswer :: Word

cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs

@@ -18,6 +18,7 @@ where
 import Cardano.Api.Error
 import Cardano.Api.Pretty
 
+import Cardano.Chain.Genesis qualified as Byron
 import Cardano.Ledger.Alonzo.PParams qualified as Ledger
 import Cardano.Ledger.Babbage.PParams qualified as Ledger
 import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
@@ -28,6 +29,7 @@ import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Conway.PParams qualified as Ledger
 import Cardano.Ledger.HKD (NoUpdate (..))
 import Cardano.Ledger.Shelley.PParams qualified as Ledger
+import Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
 import PlutusLedgerApi.Common qualified as P
 
 import Codec.Binary.Bech32 qualified as Bech32
@@ -36,8 +38,10 @@ import Data.ListMap (ListMap)
 import Data.ListMap qualified as ListMap
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Monoid
+import Data.Text.Encoding.Error qualified as T
 import GHC.Exts (IsList (..))
 import Network.Mux qualified as Mux
+import Text.Parsec.Error qualified as P
 
 deriving instance Data DecoderError
 
@@ -270,3 +274,21 @@ instance Error CBOR.DecoderError where
 
 instance Error P.ScriptDecodeError where
   prettyError = pshow
+
+instance Error T.UnicodeException where
+  prettyError = pshow
+
+instance Error EraMismatch where
+  prettyError (EraMismatch ledgerEraName' otherEraName') =
+    "The era of the node and the tx do not match. "
+      <> "The node is running in the "
+      <> pshow ledgerEraName'
+      <> " era, but the transaction is for the "
+      <> pshow otherEraName'
+      <> " era."
+
+instance Error Byron.GenesisDataGenerationError where
+  prettyError = pretty . show
+
+instance Error P.ParseError where
+  prettyError = pretty . show

cardano-api/src/Cardano/Api/Network/IPC/Internal.hs

@@ -66,11 +66,13 @@ import Cardano.Api.Block
 import Cardano.Api.Consensus.Internal.InMode
 import Cardano.Api.Consensus.Internal.Mode
 import Cardano.Api.Consensus.Internal.Protocol
+import Cardano.Api.Error
 import Cardano.Api.HasTypeProxy
 import Cardano.Api.IO
 import Cardano.Api.Monad.Error (ExceptT (..))
 import Cardano.Api.Network.IPC.Internal.Version
 import Cardano.Api.Network.Internal.NetworkId
+import Cardano.Api.Pretty
 import Cardano.Api.Query.Internal.Type.QueryInMode
 import Cardano.Api.Tx.Internal.Body
 import Cardano.Api.Tx.Internal.Sign
@@ -566,6 +568,9 @@ data AcquiringFailure
   | AFPointNotOnChain
   deriving (Eq, Show)
 
+instance Error AcquiringFailure where
+  prettyError = pshow
+
 toAcquiringFailure :: Net.Query.AcquireFailure -> AcquiringFailure
 toAcquiringFailure AcquireFailurePointTooOld = AFPointTooOld
 toAcquiringFailure AcquireFailurePointNotOnChain = AFPointNotOnChain

cardano-api/src/Cardano/Api/Network/IPC/Internal/Version.hs

@@ -7,6 +7,9 @@ module Cardano.Api.Network.IPC.Internal.Version
   )
 where
 
+import Cardano.Api.Error
+import Cardano.Api.Pretty
+
 import Cardano.Protocol.Crypto
 import Ouroboros.Consensus.Cardano.Block qualified as Consensus
 import Ouroboros.Consensus.Cardano.Node ()
@@ -52,3 +55,13 @@ data UnsupportedNtcVersionError
       ![NodeToClientVersion]
       -- ^ The versions in which this query is supported
   deriving (Eq, Show)
+
+instance Error UnsupportedNtcVersionError where
+  prettyError (UnsupportedNtcVersionError minNtcVersion ntcVersion) =
+    "Unsupported feature for the node-to-client protocol version.\n"
+      <> "This query requires at least "
+      <> pshow minNtcVersion
+      <> " but the node negotiated "
+      <> pshow ntcVersion
+      <> ".\n"
+      <> "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)."

cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs

@@ -24,6 +24,7 @@ import Cardano.Api.Address
 import Cardano.Api.Certificate.Internal
 import Cardano.Api.Consensus.Internal.Mode
 import Cardano.Api.Era
+import Cardano.Api.Error
 import Cardano.Api.IO
 import Cardano.Api.Monad.Error
 import Cardano.Api.Network.IPC
@@ -62,6 +63,9 @@ data QueryConvenienceError
   | QceUnexpectedException !SomeException
   deriving Show
 
+instance Error QueryConvenienceError where
+  prettyError = pshow . renderQueryConvenienceError
+
 renderQueryConvenienceError :: QueryConvenienceError -> Text
 renderQueryConvenienceError (AcqFailure e) =
   "Acquiring failure: " <> textShow e

cardano-api/src/Cardano/Api/Serialise/Raw.hs

@@ -74,12 +74,6 @@ data RawBytesHexError
       -- ^ error message
   deriving Show
 
-newtype SerialiseAsRawBytesError = SerialiseAsRawBytesError
-  -- TODO We can do better than use String to carry the error message
-  { unSerialiseAsRawBytesError :: String
-  }
-  deriving (Eq, Show)
-
 instance Error RawBytesHexError where
   prettyError = \case
     RawBytesHexErrorBase16DecodeFail input typeRep' message ->
@@ -95,3 +89,12 @@ instance Error RawBytesHexError where
     toText bs = case Text.decodeUtf8' bs of
       Right t -> Text.unpack t
       Left _ -> show bs
+
+newtype SerialiseAsRawBytesError = SerialiseAsRawBytesError
+  -- TODO We can do better than use String to carry the error message
+  { unSerialiseAsRawBytesError :: String
+  }
+  deriving (Eq, Show)
+
+instance Error SerialiseAsRawBytesError where
+  prettyError = pshow . unSerialiseAsRawBytesError

fourmolu.yaml

@@ -54,6 +54,8 @@ sort-deriving-clauses: false
 trailing-section-operators: true
 unicode: never
 respectful: false
-fixities: []
+fixities: 
+  - infixl 1 &
+  - infixr 4 .~
 reexports: []
 local-modules: []