ToJSON instances for error types

cardano-submit-api/cardano-submit-api.cabal

@@ -43,7 +43,6 @@ library
                       , cardano-binary
                       , cardano-cli ^>= 8.17.0.0
                       , cardano-crypto-class ^>= 2.1.2
-                      , formatting
                       , http-media
                       , iohk-monitoring
                       , mtl
@@ -68,8 +67,8 @@ library
   other-modules:        Cardano.TxSubmit.CLI.Parsers
                       , Cardano.TxSubmit.CLI.Types
                       , Cardano.TxSubmit.Config
-                      , Cardano.TxSubmit.ErrorRender
                       , Cardano.TxSubmit.Metrics
+                      , Cardano.TxSubmit.Orphans
                       , Cardano.TxSubmit.Rest.Parsers
                       , Cardano.TxSubmit.Rest.Types
                       , Cardano.TxSubmit.Rest.Web

cardano-submit-api/src/Cardano/TxSubmit/Orphans.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.TxSubmit.Orphans
+  (
+  ) where
+
+import           Cardano.Api
+import           Cardano.Binary (DecoderError)
+import           Data.Aeson (ToJSON (..))
+import qualified Data.Aeson as Aeson
+import           Ouroboros.Consensus.Cardano.Block
+
+instance ToJSON DecoderError where
+  toJSON = Aeson.String . textShow
+
+deriving anyclass instance ToJSON EraMismatch

cardano-submit-api/src/Cardano/TxSubmit/Types.hs

@@ -1,7 +1,11 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Cardano.TxSubmit.Types
@@ -12,36 +16,39 @@ module Cardano.TxSubmit.Types
   , EnvSocketError(..)
   , TxCmdError(..)
   , RawCborDecodeError(..)
-  , renderTxSubmitWebApiError
   , renderTxCmdError
   ) where
 
-import           Cardano.Api (AnyCardanoEra, Error (..), TxId, textShow)
+import           Cardano.Api (AnyCardanoEra, Error (..), TxId, TxValidationErrorInCardanoMode (..),
+                   textShow)
 import           Cardano.Api.Pretty
 import           Cardano.Binary (DecoderError)
-import           Data.Aeson (ToJSON (..), Value (..))
+import           Cardano.TxSubmit.Orphans ()
+import           Data.Aeson (ToJSON (..), Value (..), (.=))
+import qualified Data.Aeson as Aeson
 import           Data.ByteString.Char8 (ByteString)
 import           Data.Text (Text)
-import           Formatting (build, sformat)
 import           GHC.Generics (Generic)
 import           Network.HTTP.Media ((//))
-import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
 import           Servant (Accept (..), JSON, MimeRender (..), MimeUnrender (..), PostAccepted,
                    ReqBody, (:>))
 import           Servant.API.Generic (ToServantApi, (:-))
 
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Data.Text as T
 
 newtype TxSubmitPort = TxSubmitPort Int
 
 -- | The errors that the raw CBOR transaction parsing\/decoding functions can return.
 --
 newtype RawCborDecodeError = RawCborDecodeError [DecoderError]
-  deriving (Eq, Show)
+  deriving (Eq, Generic, Show)
 
 instance Error RawCborDecodeError where
   prettyError (RawCborDecodeError decodeErrors) = "RawCborDecodeError decode error: " <> pshow (fmap pshow decodeErrors)
 
+deriving anyclass instance ToJSON RawCborDecodeError
+
 -- | An error that can occur in the transaction submission web API.
 data TxSubmitWebApiError
   = TxSubmitDecodeHex
@@ -50,36 +57,40 @@ data TxSubmitWebApiError
   | TxSubmitBadTx !Text
   | TxSubmitFail TxCmdError
 
-newtype EnvSocketError = CliEnvVarLookup Text deriving (Eq, Show)
+deriving instance Generic TxSubmitWebApiError
+
+deriving anyclass instance ToJSON TxSubmitWebApiError
+
+newtype EnvSocketError = CliEnvVarLookup Text
+  deriving (Eq, Generic, Show)
+
+instance ToJSON EnvSocketError where
+  toJSON (CliEnvVarLookup msg) = Aeson.object
+    [ "message" .= String msg
+    ]
 
 data TxCmdError
   = TxCmdSocketEnvError EnvSocketError
   | TxCmdEraConsensusModeMismatch !AnyCardanoEra
   | TxCmdTxReadError !RawCborDecodeError
-  | TxCmdTxSubmitError !Text
-  | TxCmdTxSubmitErrorEraMismatch !EraMismatch
+  | TxCmdTxSubmitValidationError !TxValidationErrorInCardanoMode
 
-instance ToJSON TxSubmitWebApiError where
-  toJSON = convertJson
+deriving instance Generic TxCmdError
 
-convertJson :: TxSubmitWebApiError -> Value
-convertJson = String . renderTxSubmitWebApiError
+deriving anyclass instance ToJSON TxCmdError
 
 renderTxCmdError :: TxCmdError -> Text
-renderTxCmdError (TxCmdSocketEnvError socketError) = "socket env error " <> textShow socketError
-renderTxCmdError (TxCmdEraConsensusModeMismatch era) = "era consensus mode mismatch " <> textShow era
-renderTxCmdError (TxCmdTxReadError envelopeError) = "transaction read error " <> textShow envelopeError
-renderTxCmdError (TxCmdTxSubmitError msg) = "transaction submit error " <> msg
-renderTxCmdError (TxCmdTxSubmitErrorEraMismatch eraMismatch) = "transaction submit era mismatch" <> textShow eraMismatch
-
-renderTxSubmitWebApiError :: TxSubmitWebApiError -> Text
-renderTxSubmitWebApiError st =
-  case st of
-    TxSubmitDecodeHex -> "Provided data was hex encoded and this webapi expects raw binary"
-    TxSubmitEmpty -> "Provided transaction has zero length"
-    TxSubmitDecodeFail err -> sformat build err
-    TxSubmitBadTx tt -> mconcat ["Transactions of type '", tt, "' not supported"]
-    TxSubmitFail err -> renderTxCmdError err
+renderTxCmdError = \case
+  TxCmdSocketEnvError socketError ->
+    "socket env error " <> textShow socketError
+  TxCmdEraConsensusModeMismatch era ->
+    "era consensus mode mismatch " <> textShow era
+  TxCmdTxReadError envelopeError ->
+    "transaction read error " <> textShow envelopeError
+  TxCmdTxSubmitValidationError e ->
+    case e of
+      TxValidationErrorInCardanoMode err -> "transaction submit error " <> T.pack (show err)
+      TxValidationEraMismatch eraMismatch -> "transaction submit era mismatch" <> textShow eraMismatch
 
 -- | Servant API which provides access to tx submission webapi
 type TxSubmitApi = "api" :> ToServantApi TxSubmitApiRecord

cardano-submit-api/src/Cardano/TxSubmit/Web.hs

@@ -26,14 +26,14 @@ import qualified Cardano.Crypto.Hash.Class as Crypto
 import           Cardano.TxSubmit.Metrics (TxSubmitMetrics (..))
 import           Cardano.TxSubmit.Rest.Types (WebserverConfig (..), toWarpSettings)
 import qualified Cardano.TxSubmit.Rest.Web as Web
-import           Cardano.TxSubmit.Types (EnvSocketError (..), RawCborDecodeError (..),
-                   TxCmdError (TxCmdTxReadError, TxCmdTxSubmitError, TxCmdTxSubmitErrorEraMismatch),
-                   TxSubmitApi, TxSubmitApiRecord (..), TxSubmitWebApiError (TxSubmitFail),
-                   renderTxCmdError)
+
 import           Cardano.TxSubmit.Util (logException)
 import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx
 
+import           Cardano.TxSubmit.Types (EnvSocketError (..), RawCborDecodeError (..),
+                   TxCmdError (..), TxSubmitApi, TxSubmitApiRecord (..),
+                   TxSubmitWebApiError (TxSubmitFail), renderTxCmdError)
 import           Control.Applicative (Applicative (pure), (<$>))
 import           Control.Monad (Functor (fmap), Monad (return), (=<<))
 import           Control.Monad.Except (ExceptT, MonadError (throwError), runExceptT)
@@ -59,17 +59,16 @@ import           Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
+import qualified Servant
+import           Servant (Application, Handler, ServerError (..), err400, throwError)
+import           Servant.API.Generic (toServant)
+import           Servant.Server.Generic (AsServerT)
 import           System.Environment (lookupEnv)
 import qualified System.IO as IO
 import           System.IO (IO)
 import qualified System.Metrics.Prometheus.Metric.Gauge as Gauge
 import           Text.Show (Show (show))
 
-import qualified Servant
-import           Servant (Application, Handler, ServerError (..), err400, throwError)
-import           Servant.API.Generic (toServant)
-import           Servant.Server.Generic (AsServerT)
-
 runTxSubmitServer
   :: Trace IO Text
   -> TxSubmitMetrics
@@ -147,10 +146,8 @@ txSubmitPost trace metrics p@(CardanoModeParams cModeParams) networkId socketPat
       Net.Tx.SubmitSuccess -> do
         liftIO $ T.putStrLn "Transaction successfully submitted."
         return $ getTxId (getTxBody tx)
-      Net.Tx.SubmitFail reason ->
-        case reason of
-          TxValidationErrorInCardanoMode err -> left . TxCmdTxSubmitError . T.pack $ show err
-          TxValidationEraMismatch mismatchErr -> left $ TxCmdTxSubmitErrorEraMismatch mismatchErr
+      Net.Tx.SubmitFail e ->
+        left $ TxCmdTxSubmitValidationError e
     where
       handle :: ExceptT TxCmdError IO TxId -> Handler TxId
       handle f = do

cardano-testnet/cardano-testnet.cabal

@@ -196,6 +196,7 @@ test-suite cardano-testnet-test
                       , time
                       , transformers
                       , transformers-except
+                      , yaml
 
   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
 

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs

@@ -43,11 +43,13 @@ import qualified Testnet.Property.Utils as H
 import           Testnet.Runtime
 
 import qualified Cardano.Api.Ledger as L
+import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Lens as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.List as List
+import qualified Data.Yaml as Yaml
 import qualified Hedgehog.Extras.Test.Golden as H
 import           Lens.Micro
 import           Testnet.SubmitApi
@@ -93,6 +95,7 @@ hprop_transaction = H.integrationRetryWorkspace 0 "submit-api-babbage-transactio
   txbodySignedFp <- H.note $ work </> "tx.body.signed"
   txbodySignedBinFp <- H.note $ work </> "tx.body.signed.bin"
   txFailedResponseFp <- H.note $ work </> "tx.failed.response"
+  txFailedResponseYamlFp <- H.note $ work </> "tx.failed.response.yaml"
 
   void $ execCli' execConfig
     [ "babbage", "query", "utxo"
@@ -190,7 +193,13 @@ hprop_transaction = H.integrationRetryWorkspace 0 "submit-api-babbage-transactio
 
     H.evalIO $ LBS.writeFile txFailedResponseFp $ redactHashLbs $ getResponseBody response
 
-    H.diffFileVsGoldenFile txFailedResponseFp "test/cardano-testnet-test/files/golden/tx.failed.response.golden"
+    v <- H.leftFailM $ H.evalIO $ Aeson.eitherDecodeFileStrict @Aeson.Value txFailedResponseFp
+
+    let opts = Yaml.defaultEncodeOptions
+
+    H.evalIO $ Yaml.encodeFileWith opts txFailedResponseYamlFp v
+
+    H.diffFileVsGoldenFile txFailedResponseYamlFp "test/cardano-testnet-test/files/golden/tx.failed.response.yaml.golden"
 
 
 redactHashLbs :: LBS.ByteString -> LBS.ByteString

cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.yaml.golden

@@ -0,0 +1,21 @@
+contents:
+  contents:
+    contents:
+      era: ShelleyBasedEraBabbage
+      error:
+      - contents:
+          contents: AlonzoInBabbageUtxoPredFailure (ValueNotConservedUTxO (MaryValue
+            (Coin 0) (MultiAsset (fromList []))) (MaryValue (Coin 300000000000) (MultiAsset
+            (fromList []))))
+          tag: UtxoFailure
+        tag: UtxowFailure
+      - contents:
+          contents: AlonzoInBabbageUtxoPredFailure (BadInputsUTxO (fromList [TxIn
+            (TxId {unTxId = SafeHash "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"})
+            (TxIx 0)]))
+          tag: UtxoFailure
+        tag: UtxowFailure
+      kind: ShelleyTxValidationError
+    tag: TxValidationErrorInCardanoMode
+  tag: TxCmdTxSubmitValidationError
+tag: TxSubmitFail

nix/haskell.nix

@@ -197,7 +197,7 @@ let
                 "cardano-testnet/test/cardano-testnet-golden/files/golden/mary_node_default_config.json"
                 "cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json"
                 "cardano-testnet/test/cardano-testnet-golden/files/golden/shelley_node_default_config.json"
-                "cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.golden"
+                "cardano-testnet/test/cardano-testnet-test/files/golden/tx.failed.response.yaml.golden"
                 "cardano-testnet/files/data/alonzo/genesis.alonzo.spec.json"
                 "cardano-testnet/files/data/conway/genesis.conway.spec.json"
               ];