Merge pull request #5545 from IntersectMBO/newhoggy/structured-errors

Render errors as JSON in http response

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

@@ -43,7 +43,6 @@ library
                       , cardano-binary
                       , cardano-cli ^>= 8.18.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,38 @@ module Cardano.TxSubmit.Types
   , EnvSocketError(..)
   , TxCmdError(..)
   , RawCborDecodeError(..)
-  , renderTxSubmitWebApiError
   , renderTxCmdError
   ) where
 
-import           Cardano.Api (Error (..), TxId, textShow)
+import           Cardano.Api (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,34 +56,56 @@ data TxSubmitWebApiError
   | TxSubmitBadTx !Text
   | TxSubmitFail TxCmdError
 
-newtype EnvSocketError = CliEnvVarLookup Text deriving (Eq, Show)
+deriving instance Generic TxSubmitWebApiError
+
+instance ToJSON TxSubmitWebApiError where
+  toJSON = \case
+    TxSubmitDecodeHex -> Aeson.object
+      [ "tag" .= String "TxSubmitDecodeHex"
+      ]
+    TxSubmitEmpty -> Aeson.object
+      [ "tag" .= String "TxSubmitEmpty"
+      ]
+    TxSubmitDecodeFail err -> Aeson.object
+      [ "tag" .= String "TxSubmitDecodeFail"
+      , "contents" .= toJSON err
+      ]
+    TxSubmitBadTx err -> Aeson.object
+      [ "tag" .= String "TxSubmitBadTx"
+      , "contents" .= toJSON err
+      ]
+    TxSubmitFail err -> Aeson.object
+      [ "tag" .= String "TxSubmitFail"
+      , "contents" .= toJSON err
+      ]
+
+newtype EnvSocketError = CliEnvVarLookup Text
+  deriving (Eq, Generic, Show)
+
+instance ToJSON EnvSocketError where
+  toJSON (CliEnvVarLookup msg) = Aeson.object
+    [ "message" .= String msg
+    ]
 
 data TxCmdError
   = TxCmdSocketEnvError EnvSocketError
   | 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 (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
+  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

@@ -186,6 +186,7 @@ test-suite cardano-testnet-test
   type:                 exitcode-stdio-1.0
 
   build-depends:        aeson
+                      , aeson-pretty
                       , async
                       , base16-bytestring
                       , bytestring

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

@@ -43,6 +43,8 @@ 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.Encode.Pretty as Aeson
 import qualified Data.Aeson.Lens as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
@@ -93,6 +95,8 @@ 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.json"
+  txFailedResponseYamlGoldenFp <- H.note "test/cardano-testnet-test/files/golden/tx.failed.response.json.golden"
 
   void $ execCli' execConfig
     [ "babbage", "query", "utxo"
@@ -190,8 +194,11 @@ 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
 
+    H.evalIO $ LBS.writeFile txFailedResponseYamlFp $ Aeson.encodePretty v
+
+    H.diffFileVsGoldenFile txFailedResponseYamlFp txFailedResponseYamlGoldenFp
 
 redactHashLbs :: LBS.ByteString -> LBS.ByteString
 redactHashLbs = id

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

@@ -0,0 +1,29 @@
+{
+    "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.json.golden"
                 "cardano-testnet/files/data/alonzo/genesis.alonzo.spec.json"
                 "cardano-testnet/files/data/conway/genesis.conway.spec.json"
               ];