ToJSON instances for error types

IntersectMBO · Nov 20, 2023 · bb1e073 · bb1e073
1 parent 74cc58b
commit bb1e073
Show file tree

Hide file tree

Showing 4 changed files with 61 additions and 41 deletions.
diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal
@@ -68,8 +68,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

diff --git a/cardano-submit-api/src/Cardano/TxSubmit/ErrorRender.hs b/cardano-submit-api/src/Cardano/TxSubmit/ErrorRender.hs
diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Orphans.hs b/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
diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Types.hs b/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
@@ -18,7 +22,9 @@ module Cardano.TxSubmit.Types
 
 import           Cardano.Api (AnyCardanoEra, Error (..), TxId, textShow)
 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)
@@ -37,11 +43,13 @@ 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
   displayError (RawCborDecodeError decodeErrors) = "RawCborDecodeError decode error: \n" <> L.intercalate "  \n" (fmap show decodeErrors)
 
+deriving anyclass instance ToJSON RawCborDecodeError
+
 -- | An error that can occur in the transaction submission web API.
 data TxSubmitWebApiError
   = TxSubmitDecodeHex
@@ -50,7 +58,17 @@ 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
@@ -59,27 +77,30 @@ data TxCmdError
   | TxCmdTxSubmitError !Text
   | TxCmdTxSubmitErrorEraMismatch !EraMismatch
 
-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
+renderTxCmdError = \case
+  TxCmdSocketEnvError socketError ->
+    "socket env error " <> textShow socketError
+  TxCmdEraConsensusModeMismatch era ->
+    "era consensus mode mismatch " <> textShow era
+  TxCmdTxReadError envelopeError ->
+    "transaction read error " <> textShow envelopeError
+  TxCmdTxSubmitError msg ->
+    "transaction submit error " <> msg
+  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
+renderTxSubmitWebApiError = \case
+  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
 
 -- | Servant API which provides access to tx submission webapi
 type TxSubmitApi = "api" :> ToServantApi TxSubmitApiRecord