Merge pull request #3702 from input-output-hk/KtorZ/CBR-461/improve-n…

…ot-enough-money-error [CBR-461] Improve diagnostic for `NotEnoughMoney` error
input-output-hk · Oct 3, 2018 · 5d59841 · 5d59841
2 parents 3c0016e + 0b3f791
commit 5d59841
Show file tree

Hide file tree

Showing 12 changed files with 160 additions and 33 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -60,6 +60,7 @@
 
 - The codebase now relies on the package `cryptonite` (instead of `ed25519`) for Ed25519 implementation (CO-325)
 
+- **[API BREAKING CHANGE]** Improve diagnostic for `NotEnoughMoney` error (CBR-461)
 
 ### Specifications
 

diff --git a/wallet-new/integration/TransactionSpecs.hs b/wallet-new/integration/TransactionSpecs.hs
@@ -171,7 +171,7 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
                         <> " error, got: "
                         <> show err
 
-        randomTest "fails if you spend too much money" 1 $ do
+        randomTest "fails if you spend more money than your available balance" 1 $ do
             wallet <- run $ sampleWallet wRef wc
             (toAcct, toAddr) <- run $ firstAccountAndId wc wallet
 
@@ -189,8 +189,72 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
                     }
                 tooMuchCash (V1 c) = V1 (Core.mkCoin (Core.getCoin c * 2))
             etxn <- run $ postTransaction wc payment
+            err <- liftIO (etxn `shouldPrism` _Left)
+            case err of
+                ClientWalletError (NotEnoughMoney (ErrAvailableBalanceIsInsufficient _)) ->
+                    return ()
 
-            liftIO $ void $ etxn `shouldPrism` _Left
+                _ ->
+                    liftIO $ expectationFailure $
+                        "Expected 'NotEnoughMoney ~ ErrAvailableBalanceIsInsufficient', got: "
+                        <> show err
+
+        randomTest "fails if you can't cover fee with a transaction" 1 $ run $ do
+            let makePayment
+                    :: Core.Coin
+                    -> (Wallet, Account)
+                    -> Core.Address
+                    -> IO (Either ClientError Transaction)
+                makePayment amount (sourceW, sourceA) destination = do
+                    let payment = Payment
+                            { pmtSource = PaymentSource
+                                { psWalletId     = walId sourceW
+                                , psAccountIndex = accIndex sourceA
+                                }
+                            , pmtDestinations = pure PaymentDistribution
+                                { pdAddress = V1 destination
+                                , pdAmount  = V1 amount
+                                }
+                            , pmtGroupingPolicy   = Nothing
+                            , pmtSpendingPassword = Nothing
+                            }
+                    fmap (fmap wrData) $ postTransaction wc payment
+
+            let getRandomAddress
+                    :: IO Core.Address
+                getRandomAddress = do
+                    wallet <- randomWallet CreateWallet >>= createWalletCheck wc
+                    (_, toAddr) <- firstAccountAndId wc wallet
+                    return (unV1 $ addrId toAddr)
+
+            let fixtureWallet
+                    :: Core.Coin
+                    -> IO (Wallet, Account)
+                fixtureWallet coin = do
+                    genesis <- genesisWallet wc
+                    (genesisAccount, _) <- firstAccountAndId wc genesis
+                    wallet <- randomWallet CreateWallet >>= createWalletCheck wc
+                    (account, address) <- firstAccountAndId wc wallet
+                    txn <- makePayment coin (genesis, genesisAccount) (unV1 $ addrId address) >>= shouldPrismFlipped _Right
+                    pollTransactions wc (walId wallet) (accIndex account) (txId txn)
+                    return (wallet, account)
+
+            let expectFailure
+                    :: Show a
+                    => ClientError
+                    -> Either ClientError a
+                    -> IO ()
+                expectFailure want eresp = do
+                    resp <- eresp `shouldPrism` _Left
+                    want `shouldBe` resp
+
+            --
+            -- Actual test
+            --
+            (wallet, account) <- fixtureWallet (Core.mkCoin 42)
+            resp <- makePayment (Core.mkCoin 42) (wallet, account) =<< getRandomAddress
+            let err = NotEnoughMoney ErrCannotCoverFee
+            expectFailure (ClientWalletError err) resp
 
         randomTest "posted transactions gives rise to nonempty Utxo histogram" 1 $ do
             genesis <- run $ genesisWallet wc

diff --git a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs
@@ -33,10 +33,10 @@ import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
 
 convertTxError :: V0.TxError -> WalletError
 convertTxError err = case err of
-    V0.NotEnoughMoney coin ->
-        NotEnoughMoney . fromIntegral . Core.getCoin $ coin
-    V0.NotEnoughAllowedMoney coin ->
-        NotEnoughMoney . fromIntegral . Core.getCoin $ coin
+    V0.NotEnoughMoney _coin ->
+        NotEnoughMoney ErrCannotCoverFee
+    V0.NotEnoughAllowedMoney _coin ->
+        NotEnoughMoney (ErrAvailableBalanceIsInsufficient (-1))
     V0.FailedToStabilize ->
         TxFailedToStabilize
     V0.OutputIsRedeem addr ->

diff --git a/wallet-new/src/Cardano/Wallet/API/V1/ReifyWalletError.hs b/wallet-new/src/Cardano/Wallet/API/V1/ReifyWalletError.hs
@@ -250,12 +250,8 @@ newTransactionError e = case e of
         unknownHdAccount e'
 
     (Kernel.NewTransactionErrorCoinSelectionFailed e') -> case e' of
-          ex@(CoinSelHardErrOutputCannotCoverFee _outputs fee) ->
-                case (readMaybe $ T.unpack fee) of
-                    Just coin ->
-                        V1.NotEnoughMoney coin
-                    Nothing ->
-                        V1.UnknownError $ (sformat build ex)
+          CoinSelHardErrOutputCannotCoverFee _outputs _fee ->
+                V1.NotEnoughMoney V1.ErrCannotCoverFee
 
           ex@(CoinSelHardErrOutputIsRedeemAddress addr) ->
                 case (decodeTextAddress addr) of
@@ -265,20 +261,20 @@ newTransactionError e = case e of
                         V1.UnknownError $ (sformat build ex)
 
           CoinSelHardErrCannotCoverFee ->
-                V1.NotEnoughMoney (-1)
+                V1.NotEnoughMoney V1.ErrCannotCoverFee
 
           (CoinSelHardErrMaxInputsReached _txt) ->
                 V1.TooBigTransaction
 
           ex@(CoinSelHardErrUtxoExhausted balance _payment) ->
               case (readMaybe $ T.unpack balance) of
                   Just coin ->
-                      V1.NotEnoughMoney coin
+                      V1.NotEnoughMoney (V1.ErrAvailableBalanceIsInsufficient coin)
                   Nothing ->
                       V1.UnknownError $ (sformat build ex)
 
           CoinSelHardErrUtxoDepleted ->
-            V1.NotEnoughMoney (-1)
+            V1.NotEnoughMoney (V1.ErrAvailableBalanceIsInsufficient 0)
 
     (Kernel.NewTransactionErrorCreateAddressFailed e') ->
         createAddressErrorKernel e'

diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs b/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs
@@ -350,7 +350,7 @@ $errors
   errors = T.intercalate "\n" rows
   rows =
     -- 'WalletError'
-    [ mkRow fmtErr $ NotEnoughMoney 1400
+    [ mkRow fmtErr $ NotEnoughMoney (ErrAvailableBalanceIsInsufficient 1400)
     , mkRow fmtErr $ OutputIsRedeem sampleAddress
     , mkRow fmtErr $ UnknownError "Unknown error."
     , mkRow fmtErr $ InvalidAddressFormat "Invalid Base58 representation."

diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs
@@ -124,6 +124,7 @@ module Cardano.Wallet.API.V1.Types (
   , Core.Address
   -- * Wallet Errors
   , WalletError(..)
+  , ErrNotEnoughMoney(..)
   , toServantError
   , toHttpErrorStatus
 
@@ -139,7 +140,8 @@ import           Control.Lens (At, Index, IxValue, at, ix, makePrisms, to, (?~))
 import           Data.Aeson
 import qualified Data.Aeson.Options as Serokell
 import           Data.Aeson.TH as A
-import           Data.Aeson.Types (Value (..), toJSONKeyText, typeMismatch)
+import           Data.Aeson.Types (Parser, Value (..), toJSONKeyText,
+                     typeMismatch)
 import           Data.Bifunctor (first)
 import qualified Data.ByteArray as ByteArray
 import qualified Data.ByteString as BS
@@ -206,7 +208,6 @@ import           Pos.Wallet.Web.ClientTypes.Instances ()
 import qualified Pos.Wallet.Web.State.Storage as OldStorage
 import           Test.Pos.Core.Arbitrary ()
 
-
 -- | Declare generic schema, while documenting properties
 --   For instance:
 --
@@ -267,8 +268,10 @@ genericSchemaDroppingPrefix prfx extraDoc proxy = do
 
 
 optsADTCamelCase :: A.Options
-optsADTCamelCase =
-    defaultOptions { A.constructorTagModifier = mkJsonKey }
+optsADTCamelCase = defaultOptions
+    { A.constructorTagModifier = mkJsonKey
+    , A.sumEncoding            = A.ObjectWithSingleField
+    }
 
 
 --
@@ -2953,6 +2956,53 @@ instance Example WalletImport where
 -- Wallet Errors
 --
 
+-- | Details about what 'NotEnoughMoney' means
+data ErrNotEnoughMoney
+    -- | UTxO exhausted whilst trying to pick inputs to cover remaining fee
+    = ErrCannotCoverFee
+
+    -- | UTxO exhausted during input selection
+    --
+    -- We record the available balance of the UTxO
+    | ErrAvailableBalanceIsInsufficient Int
+
+    deriving (Eq, Show, Generic)
+
+instance Buildable ErrNotEnoughMoney where
+    build = \case
+        ErrCannotCoverFee ->
+             bprint "Not enough coins to cover fee."
+        ErrAvailableBalanceIsInsufficient _ ->
+             bprint "Not enough available coins to proceed."
+
+instance ToJSON ErrNotEnoughMoney where
+    toJSON = \case
+        e@ErrCannotCoverFee -> object
+            [ "msg" .= sformat build e
+            ]
+        e@(ErrAvailableBalanceIsInsufficient balance) -> object
+            [ "msg"              .= sformat build e
+            , "availableBalance" .= balance
+            ]
+
+instance FromJSON ErrNotEnoughMoney where
+    parseJSON v =
+            withObject "AvailableBalanceIsInsufficient" availableBalanceIsInsufficientParser v
+        <|> withObject "CannotCoverFee" cannotCoverFeeParser v
+      where
+        cannotCoverFeeParser :: Object -> Parser ErrNotEnoughMoney
+        cannotCoverFeeParser o = do
+            msg <- o .: "msg"
+            when (msg /= sformat build ErrCannotCoverFee) mempty
+            pure ErrCannotCoverFee
+
+        availableBalanceIsInsufficientParser :: Object -> Parser ErrNotEnoughMoney
+        availableBalanceIsInsufficientParser o = do
+            msg <- o .: "msg"
+            when (msg /= sformat build (ErrAvailableBalanceIsInsufficient 0)) mempty
+            ErrAvailableBalanceIsInsufficient <$> (o .: "availableBalance")
+
+
 -- | Type representing any error which might be thrown by wallet.
 --
 -- Errors are represented in JSON in the JSend format (<https://labs.omniti.com/labs/jsend>):
@@ -2982,7 +3032,7 @@ instance Example WalletImport where
 -- TODO: change fields' types to actual Cardano core types, like `Coin` and `Address`
 data WalletError =
     -- | NotEnoughMoney weNeedMore
-      NotEnoughMoney !Int
+      NotEnoughMoney !ErrNotEnoughMoney
     -- | OutputIsRedeem weAddress
     | OutputIsRedeem !(V1 Core.Address)
     -- | UnknownError weMsg
@@ -3034,7 +3084,10 @@ instance FromJSON WalletError where
 
 instance Arbitrary WalletError where
     arbitrary = Gen.oneof
-        [ NotEnoughMoney <$> Gen.choose (1, 1000)
+        [ NotEnoughMoney <$> Gen.oneof
+            [ pure ErrCannotCoverFee
+            , ErrAvailableBalanceIsInsufficient <$> Gen.choose (1, 1000)
+            ]
         , OutputIsRedeem . V1 <$> arbitrary
         , UnknownError <$> arbitraryText
         , InvalidAddressFormat <$> arbitraryText
@@ -3075,8 +3128,8 @@ instance Arbitrary WalletError where
 -- | Give a short description of an error
 instance Buildable WalletError where
     build = \case
-        NotEnoughMoney _ ->
-             bprint "Not enough available coins to proceed."
+        NotEnoughMoney x ->
+             bprint build x
         OutputIsRedeem _ ->
              bprint "One of the TX outputs is a redemption address."
         UnknownError _ ->
@@ -3161,7 +3214,7 @@ instance ToServantError WalletError where
 instance HasDiagnostic WalletError where
     getDiagnosticKey = \case
         NotEnoughMoney{} ->
-            "needMore"
+            "details"
         OutputIsRedeem{} ->
             "address"
         UnknownError{} ->

diff --git a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs
@@ -288,6 +288,7 @@ runCoinSelT opts pickUtxo policy request utxo = do
     policy' :: CoinSelT Core.Utxo CoinSelHardErr m
                  ([CoinSelResult Cardano], SelectedUtxo Cardano)
     policy' = do
+        when (Map.null utxo) $ throwError CoinSelHardErrUtxoDepleted
         mapM_ validateOutput request
         css <- intInputGrouping (csoInputGrouping opts)
         -- We adjust for fees /after/ potentially dealing with grouping

diff --git a/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs b/wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs
@@ -302,7 +302,11 @@ data CoinSelHardErr =
     -- See also 'CoinSelHardErrCannotCoverFee'
   | CoinSelHardErrUtxoExhausted Text Text
 
-    -- | UTxO depleted using input selection
+    -- | UTxO depleted using input selection.
+    --
+    -- This occurs when there's actually no UTxO to pick from in a first place,
+    -- like an edge-case of CoinSelHardErrUtxoExhausted (which suggests that we
+    -- could at least start selecting UTxO).
   | CoinSelHardErrUtxoDepleted
 
 instance Arbitrary CoinSelHardErr where

diff --git a/wallet-new/test/WalletNewJson.hs b/wallet-new/test/WalletNewJson.hs
@@ -9,8 +9,8 @@ import           Hedgehog (Property)
 import           Cardano.Wallet.API.Response (JSONValidationError (..))
 import           Cardano.Wallet.API.V1.Migration.Types (MigrationError (..))
 import           Cardano.Wallet.API.V1.Swagger.Example (genExample)
-import           Cardano.Wallet.API.V1.Types (V1 (..), WalletError (..),
-                     exampleWalletId)
+import           Cardano.Wallet.API.V1.Types (ErrNotEnoughMoney (..), V1 (..),
+                     WalletError (..), exampleWalletId)
 
 import           Test.Pos.Core.ExampleHelpers (exampleAddress)
 import           Test.Pos.Util.Golden (discoverGolden, goldenTestJSON)
@@ -30,11 +30,18 @@ tests =
 -- WalletError
 -------------------------------------------------------------------------------
 
-golden_WalletError_NotEnoughMoney :: Property
-golden_WalletError_NotEnoughMoney =
+golden_WalletError_NotEnoughMoneyAvailableBalanceIsInsufficient :: Property
+golden_WalletError_NotEnoughMoneyAvailableBalanceIsInsufficient =
     goldenTestJSON
-        (NotEnoughMoney 10)
-            "test/golden/WalletError_NotEnoughMoney"
+        (NotEnoughMoney (ErrAvailableBalanceIsInsufficient 14))
+            "test/golden/WalletError_NotEnoughMoneyAvailableBalanceIsInsufficient"
+
+golden_WalletError_NotEnoughMoneyCannotCoverFee :: Property
+golden_WalletError_NotEnoughMoneyCannotCoverFee =
+    goldenTestJSON
+        (NotEnoughMoney ErrCannotCoverFee)
+            "test/golden/WalletError_NotEnoughMoneyCannotCoverFee"
+
 
 golden_WalletError_OutputIsRedeem :: Property
 golden_WalletError_OutputIsRedeem =

diff --git a/wallet-new/test/golden/WalletError_NotEnoughMoney b/wallet-new/test/golden/WalletError_NotEnoughMoney
diff --git a/wallet-new/test/golden/WalletError_NotEnoughMoneyAvailableBalanceIsInsufficient b/wallet-new/test/golden/WalletError_NotEnoughMoneyAvailableBalanceIsInsufficient
@@ -0,0 +1 @@
+{"status":"error","diagnostic":{"details":{"msg":"Not enough available coins to proceed.","availableBalance":14}},"message":"NotEnoughMoney"}
diff --git a/wallet-new/test/golden/WalletError_NotEnoughMoneyCannotCoverFee b/wallet-new/test/golden/WalletError_NotEnoughMoneyCannotCoverFee
@@ -0,0 +1 @@
+{"status":"error","diagnostic":{"details":{"msg":"Not enough coins to cover fee."}},"message":"NotEnoughMoney"}