Merge pull request #304 from input-output-hk/KtorZ/260/api-better-errors

Remove temporary code from CLI for raw server errors + some small error fixes

cardano-wallet.cabal

@@ -31,6 +31,7 @@ executable cardano-wallet
       -O2
   build-depends:
       base
+    , aeson
     , aeson-pretty
     , bytestring
     , cardano-wallet-cli
@@ -39,7 +40,6 @@ executable cardano-wallet
     , docopt
     , file-embed
     , http-client
-    , http-types
     , regex-applicative
     , servant-client
     , servant-client-core

exe/wallet/Main.hs

@@ -60,31 +60,31 @@ import Control.Arrow
     ( second )
 import Control.Monad
     ( when )
+import Data.Aeson
+    ( (.:) )
 import Data.FileEmbed
     ( embedFile )
 import Data.Function
     ( (&) )
 import Data.Functor
     ( (<&>) )
 import qualified Data.List.NonEmpty as NE
+import Data.Maybe
+    ( fromMaybe )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Text
     ( Text )
 import Data.Text.Class
     ( FromText (..), ToText (..) )
-import Data.Typeable
-    ( Typeable, tyConName, typeRep, typeRepTyCon )
 import Network.HTTP.Client
     ( Manager, defaultManagerSettings, newManager )
-import Network.HTTP.Types.Status
-    ( status404, status409 )
 import Servant
     ( (:<|>) (..), (:>) )
 import Servant.Client
     ( BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM )
 import Servant.Client.Core
-    ( ServantError (..), responseBody, responseStatusCode )
+    ( ServantError (..), responseBody )
 import System.Console.Docopt
     ( Arguments
     , Docopt
@@ -111,7 +111,9 @@ import qualified Cardano.Wallet.Api.Server as Server
 import qualified Cardano.Wallet.DB.MVar as MVar
 import qualified Cardano.Wallet.Network.HttpBridge as HttpBridge
 import qualified Cardano.Wallet.Transaction.HttpBridge as HttpBridge
+import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
+import qualified Data.Aeson.Types as Aeson
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Char8 as BL8
@@ -187,12 +189,12 @@ exec manager args
 
     | args `isPresent` command "wallet" &&
       args `isPresent` command "list" = do
-        runClient @Wallet Aeson.encodePretty listWallets
+        runClient Aeson.encodePretty listWallets
 
     | args `isPresent` command "wallet" &&
       args `isPresent` command "get" = do
         wId <- args `parseArg` argument "wallet-id"
-        runClient @Wallet Aeson.encodePretty $ getWallet $ ApiT wId
+        runClient Aeson.encodePretty $ getWallet $ ApiT wId
 
     | args `isPresent` command "wallet" &&
       args `isPresent` command "create" = do
@@ -211,7 +213,7 @@ exec manager args
                 (Nothing, _) -> Nothing
                 (Just a, t) -> Just (a, t)
         wPwd <- getPassphraseWithConfirm
-        runClient @Wallet Aeson.encodePretty $ postWallet $ WalletPostData
+        runClient Aeson.encodePretty $ postWallet $ WalletPostData
             (Just $ ApiT wGap)
             (ApiMnemonicT . second T.words $ wSeed)
             (ApiMnemonicT . second T.words <$> wSndFactor)
@@ -222,28 +224,28 @@ exec manager args
       args `isPresent` command "update" = do
         wId <- args `parseArg` argument "wallet-id"
         wName <- args `parseArg` longOption "name"
-        runClient @Wallet Aeson.encodePretty $ putWallet (ApiT wId) $ WalletPutData
+        runClient Aeson.encodePretty $ putWallet (ApiT wId) $ WalletPutData
             (Just $ ApiT wName)
 
     | args `isPresent` command "wallet" &&
       args `isPresent` command "delete" = do
         wId <- args `parseArg` argument "wallet-id"
-        runClient @Wallet (const "") $ deleteWallet (ApiT wId)
+        runClient (const "") $ deleteWallet (ApiT wId)
 
     | args `isPresent` command "transaction" &&
       args `isPresent` command "create" = do
         wId <- args `parseArg` argument "wallet-id"
         ts <- args `parseAllArgs` longOption "payment"
         wPwd <- getPassphrase
-        runClient @Wallet Aeson.encodePretty $ createTransaction (ApiT wId) $
+        runClient Aeson.encodePretty $ createTransaction (ApiT wId) $
             PostTransactionData
                 ts
                 (ApiT wPwd)
 
     | args `isPresent` command "address" &&
       args `isPresent` command "list" = do
         wId <- args `parseArg` argument "wallet-id"
-        runClient @Wallet Aeson.encodePretty $ listAddresses (ApiT wId) Nothing
+        runClient Aeson.encodePretty $ listAddresses (ApiT wId) Nothing
 
     | args `isPresent` longOption "version" = do
         let cabal = B8.unpack $(embedFile "cardano-wallet.cabal")
@@ -301,7 +303,7 @@ exec manager args
     -- runClient @Wallet ...
     -- @
     runClient
-        :: forall b a. Typeable b
+        :: forall a. ()
         => (a -> BL.ByteString)
         -> ClientM a
         -> IO ()
@@ -310,24 +312,19 @@ exec manager args
         let env = mkClientEnv manager (BaseUrl Http "localhost" port "")
         res <- runClientM cmd env
         case res of
-            Left (FailureResponse r) | responseStatusCode r == status404 -> do
-                let typ = T.pack $ tyConName $ typeRepTyCon $ typeRep $ Proxy @b
-                putErrLn $ typ <> " not found."
-            Left (FailureResponse r) | responseStatusCode r == status409 -> do
-                let typ = T.pack $ tyConName $ typeRepTyCon $ typeRep $ Proxy @b
-                putErrLn $ typ <> " already exists."
-            Left (FailureResponse r) ->
-                putErrLn $ T.decodeUtf8 $ BL.toStrict $ responseBody r
-            Left (ConnectionError t) ->
-                putErrLn t
-            Left e ->
-                putErrLn $ T.pack $ show e
             Right a -> do
                 TIO.hPutStrLn stderr "Ok."
                 BL8.putStrLn (encode a)
-
--- | Namespaces for commands.
-data Wallet deriving (Typeable)
+            Left e -> do
+                let msg = case e of
+                        FailureResponse r -> fromMaybe
+                            (T.decodeUtf8 $ BL.toStrict $ responseBody r)
+                            (decodeError $ responseBody r)
+                        ConnectionError t ->
+                            t
+                        _ ->
+                            T.pack $ show e
+                putErrLn msg
 
 -- | Start a web-server to serve the wallet backend API on the given port.
 execServer :: Port "wallet" -> Port "bridge" -> IO ()
@@ -374,3 +371,11 @@ optional
 optional parse = \case
     m | m == mempty -> Right Nothing
     m  -> Just <$> parse m
+
+-- | Decode API error messages and extract the corresponding message.
+decodeError
+    :: BL.ByteString
+    -> Maybe Text
+decodeError bytes = do
+    obj <- Aeson.decode bytes
+    Aeson.parseMaybe (Aeson.withObject "Error" (.: "message")) obj

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -77,6 +77,8 @@ import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.Generics.Labels
     ()
+import Data.Maybe
+    ( isJust )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
@@ -354,7 +356,7 @@ instance LiftHandler ErrCoinSelection where
                 [ "I can't process this payment because there's not enough "
                 , "UTxO available in the wallet. The total UTxO sums up to "
                 , showT utxo, " Lovelace, but I need ", showT payment
-                , " Lovelace (inclusive of fee amount) in order to proceed "
+                , " Lovelace (excluding fee amount) in order to proceed "
                 , " with the payment."
                 ]
 
@@ -447,7 +449,8 @@ instance LiftHandler ErrUpdatePassphrase where
         ErrUpdatePassphraseWithRootKey e  -> handler e
 
 instance LiftHandler ServantErr where
-    handler err@(ServantErr code _ body headers) = case code of
+    handler err@(ServantErr code _ body headers)
+      | not (isJSON body) = case code of
         400 -> apiError err' BadRequest (utf8 body)
         404 -> apiError err' NotFound $ mconcat
             [ "I couldn't find the requested endpoint. If the endpoint "
@@ -478,8 +481,10 @@ instance LiftHandler ServantErr where
             , "don't yet know how to handle this type of situation. Here's "
             , "some information about what happened: ", utf8 body
             ]
+      | otherwise = err
       where
         utf8 = T.replace "\"" "'" . T.decodeUtf8 . BL.toStrict
+        isJSON = isJust . Aeson.decode @Aeson.Value
         err' = err
             { errHeaders =
                 ( hContentType

lib/core/src/Network/Wai/Middleware/ServantError.hs

@@ -17,8 +17,6 @@ import Control.Monad
     ( guard )
 import Data.ByteString.Lazy
     ( ByteString )
-import Network.HTTP.Types.Header
-    ( ResponseHeaders )
 import Network.HTTP.Types.Status
     ( statusCode, statusMessage )
 import Network.Wai
@@ -30,7 +28,6 @@ import Servant.Server.Internal.ServantErr
 
 import qualified Data.Binary.Builder as Binary
 import qualified Data.ByteString.Char8 as B8
-import qualified Network.HTTP.Types.Status as HTTP
 
 -- | Make sure every error is converted to a suitable application-level error.
 --
@@ -72,16 +69,7 @@ eitherRawError res =
             (Right res)
             (Left . flip (ServantErr code reason) headers)
     in
-        maybeToEither $ guard (isRawError status headers) *> body
-
--- | Raw 'Servant' errors don't have any Content-Type. This is a lean predicate
--- but for lack of any better way of identifying them, that's a best effort.
-isRawError
-    :: HTTP.Status
-    -> ResponseHeaders
-    -> Bool
-isRawError status headers =
-    statusCode status >= 400 && null headers
+        maybeToEither $ guard (code >= 400) *> body
 
 -- | Extract raw body of a response, only if it suitables for transformation.
 -- Servant doesn't return files or streams by default, so if one of the two is

lib/http-bridge/test/integration/Test/Integration/Scenario/CLISpec.hs

@@ -178,7 +178,8 @@ specWithCluster = do
             (Exit c, Stdout out, Stderr err) <- getWalletViaCLI walId
             out `shouldBe` ""
             if (title == "40 chars hex") then
-                err `shouldBe` "Wallet not found.\n"
+                err `shouldBe` "I couldn't find a wallet with the given id:\
+                    \ 1111111111111111111111111111111111111111\n"
             else
                 err `shouldBe` "wallet id should be an hex-encoded string of\
                     \ 40 characters\n"