Make ApiErrorTxOutputLovelaceInsufficient a parameter of `UtxoTooSm…

…all`.
cardano-foundation · Oct 29, 2022 · 4eb9d44 · 4eb9d44
1 parent 616328d
commit 4eb9d44
Show file tree

Hide file tree

Showing 2 changed files with 42 additions and 22 deletions.
diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs
@@ -75,7 +75,12 @@ import Cardano.Wallet
     , ErrWrongPassphrase (..)
     )
 import Cardano.Wallet.Api.Types
-    ( ApiError (..), ApiErrorInfo (..), ApiErrorMessage (..), Iso8601Time (..) )
+    ( ApiError (..)
+    , ApiErrorInfo (..)
+    , ApiErrorMessage (..)
+    , ApiErrorTxOutputLovelaceInsufficient (..)
+    , Iso8601Time (..)
+    )
 import Cardano.Wallet.CoinSelection
     ( SelectionBalanceError (..)
     , SelectionCollateralError
@@ -136,6 +141,7 @@ import Servant.Server
     )
 
 import qualified Cardano.Api as Cardano
+import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Cardano.Wallet.Write.Tx as WriteTx
@@ -790,23 +796,24 @@ instance IsServerError
     (SelectionOutputCoinInsufficientError WalletSelectionContext)
   where
     toServerError e =
-        apiError err403 UtxoTooSmall $ T.unlines [preamble, details]
+        apiError err403 (UtxoTooSmall details) message
       where
-        preamble = T.unwords
+        message = T.unwords
             [ "One of the outputs you've specified has an ada quantity that is"
             , "below the minimum required. Either increase the ada quantity to"
             , "at least the minimum, or specify an ada quantity of zero, in"
             , "which case the wallet will automatically assign the correct"
             , "minimum ada quantity to the output."
             ]
-        details = T.unlines
-            [ "Destination address:"
-            , pretty (fst $ view #output e)
-            , "Required minimum ada quantity:"
-            , pretty (view #minimumExpectedCoin e)
-            , "Specified ada quantity:"
-            , pretty (TokenBundle.getCoin $ snd $ view #output e)
-            ]
+        details = ApiErrorTxOutputLovelaceInsufficient
+            { txOutputIndex =
+                -- TODO: ADP-2299
+                0
+            , txOutputLovelaceSpecified =
+                Coin.toQuantity $ TokenBundle.getCoin $ snd $ view #output e
+            , txOutputLovelaceRequiredMinimum =
+                Coin.toQuantity $ view #minimumExpectedCoin e
+            }
 
 instance IsServerError
     (SelectionOutputSizeExceedsLimitError WalletSelectionContext)

diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Types.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Types.hs
@@ -407,6 +407,8 @@ import Control.DeepSeq
     ( NFData (..) )
 import Control.Monad
     ( guard, when, (<=<), (>=>) )
+import Data.Aeson.Extra
+    ( objectUnion )
 import Data.Aeson.Types
     ( FromJSON (..)
     , Parser
@@ -458,6 +460,8 @@ import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Map.Strict
     ( Map )
+import Data.Maybe
+    ( fromMaybe )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
@@ -1660,20 +1664,16 @@ data ApiError = ApiError
     deriving anyclass NFData
 
 instance ToJSON ApiError where
-    toJSON ApiError {info, message} = object
-        [ "code" .= info
-        , "message" .= message
-        ]
+    toJSON ApiError {info, message}
+        = fromMaybe (error "ToJSON ApiError: Unexpected encoding")
+        $ toJSON info `objectUnion` toJSON message
 
 instance FromJSON ApiError where
-    parseJSON = withObject "ApiError" $ \o ->
-        ApiError
-            <$> o .: "code"
-            <*> o .: "message"
+    parseJSON o = ApiError <$> parseJSON o <*> parseJSON o
 
 newtype ApiErrorMessage = ApiErrorMessage {message :: Text}
     deriving (Eq, Generic, Show)
-    deriving (FromJSON, ToJSON) via Text
+    deriving (FromJSON, ToJSON) via DefaultRecord ApiErrorMessage
     deriving anyclass NFData
 
 data ApiErrorInfo
@@ -1759,17 +1759,30 @@ data ApiErrorInfo
     | UnresolvedInputs
     | InputResolutionConflicts
     | UnsupportedMediaType
-    | UtxoTooSmall
+    | UtxoTooSmall ApiErrorTxOutputLovelaceInsufficient
     | WalletAlreadyExists
     | WalletNotResponding
     | WithdrawalNotWorth
     | WrongEncryptionPassphrase
     | WrongMnemonic
     | ValidityIntervalNotInsideScriptTimelock
     deriving (Eq, Generic, Show, Data, Typeable)
-    deriving (FromJSON, ToJSON) via DefaultSum ApiErrorInfo
     deriving anyclass NFData
 
+instance FromJSON ApiErrorInfo where
+    parseJSON = genericParseJSON apiErrorInfoOptions
+
+instance ToJSON ApiErrorInfo where
+    toJSON = genericToJSON apiErrorInfoOptions
+
+apiErrorInfoOptions :: Aeson.Options
+apiErrorInfoOptions = defaultSumTypeOptions
+    { sumEncoding = TaggedObject
+        { tagFieldName = "code"
+        , contentsFieldName = "info"
+        }
+    }
+
 data ApiErrorTxOutputLovelaceInsufficient = ApiErrorTxOutputLovelaceInsufficient
     { txOutputIndex
         :: !Word32