From 8231697beb2e921e1083aa41547e9381c1c044f5 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 21 May 2019 16:26:21 +0200 Subject: [PATCH 1/4] define middleware to adjust raw servant errors before they're sent --- lib/core/cardano-wallet-core.cabal | 4 + .../Network/Wai/Middleware/ServantError.hs | 100 ++++++++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 lib/core/src/Network/Wai/Middleware/ServantError.hs diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 2c82b5c3c7e..9aca6e45f13 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -36,6 +36,7 @@ library , base , base58-bytestring , basement + , binary , bytestring , cardano-crypto , containers @@ -45,6 +46,7 @@ library , fast-logger , fmt , generic-lens + , http-types , http-api-data , http-media , memory @@ -61,6 +63,7 @@ library , time , transformers , vector + , wai hs-source-dirs: src @@ -87,6 +90,7 @@ library Cardano.Wallet.Primitive.Types Cardano.Wallet.Transaction Data.Quantity + Network.Wai.Middleware.ServantError other-modules: Paths_cardano_wallet_core diff --git a/lib/core/src/Network/Wai/Middleware/ServantError.hs b/lib/core/src/Network/Wai/Middleware/ServantError.hs new file mode 100644 index 00000000000..8bd77ad0ec9 --- /dev/null +++ b/lib/core/src/Network/Wai/Middleware/ServantError.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE LambdaCase #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- Middleware between Wai <-> Servant to accomodate raw error responses returned +-- by servant. See also 'handleRawError'. + +module Network.Wai.Middleware.ServantError + ( handleRawError + ) where + +import Prelude + +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 + ( Middleware, responseHeaders, responseStatus ) +import Network.Wai.Internal + ( Response (..) ) +import Servant.Server.Internal.ServantErr + ( ServantErr (..), responseServantErr ) + +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. +-- +-- There are many cases where Servant will handle errors itself and reply to a +-- client without even disturbing the application. This is both handy and clunky +-- since our application return errors in a specific format (e.g. JSON, XML +-- ...). +-- +-- This is the case for instance if the client hits a non-exiting endpoint of +-- the API, or if the client requests an invalid content-type, etc ... +-- +-- Ideally, we would like clients to be able to expect one and only one format, +-- so this middleware allows for manipulating the response returned by a Wai +-- application (what servant boils down to) and adjust the response when +-- necessary. So, any response with or without payload but no content-type will +-- trigger the 'convert' function and offer the caller to adjust the response as +-- needed. +handleRawError + :: (ServantErr -> ServantErr) + -- ^ Convert a raw response into something that better fits the application + -- error + -> Middleware +handleRawError adjust app req send = + app req (send . either (responseServantErr . adjust) id . eitherRawError) + +-- | Analyze whether a given error is a raw error thrown by Servant before +-- reaching our application layer, or one from our application layer. +eitherRawError + :: Response + -> Either ServantErr Response +eitherRawError res = + let + status = responseStatus res + code = statusCode status + reason = B8.unpack (statusMessage status) + headers = responseHeaders res + body = responseBody res + maybeToEither = maybe + (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 + +-- | 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 +-- met, it means it comes from our application layer anyway. +responseBody + :: Response + -> Maybe ByteString +responseBody = \case + ResponseBuilder _ _ b -> + Just (Binary.toLazyByteString b) + ResponseRaw _ r -> + responseBody r + ResponseFile{} -> + Nothing + ResponseStream{} -> + Nothing From 7abb13648a1d1de40e27b58a85700c9828431fed Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 21 May 2019 16:40:21 +0200 Subject: [PATCH 2/4] implement 'LiftHandler' for 'ServantErr' and adjust raw servant errors --- lib/core/src/Cardano/Wallet/Api/Server.hs | 66 ++++++++++++++++++++--- lib/core/src/Cardano/Wallet/Api/Types.hs | 6 +++ 2 files changed, 65 insertions(+), 7 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 9fa2c7f9ddd..77174e75023 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -13,6 +13,7 @@ module Cardano.Wallet.Api.Server ( server + , middlewares ) where import Prelude @@ -75,6 +76,8 @@ import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Generics.Labels () +import Data.Proxy + ( Proxy (..) ) import Data.Quantity ( Quantity (..) ) import Data.Text @@ -83,10 +86,20 @@ import Data.Text.Class ( toText ) import Fmt ( pretty ) +import Network.HTTP.Media.RenderHeader + ( renderHeader ) +import Network.HTTP.Types.Header + ( hContentType ) +import Network.Wai + ( Middleware ) +import Network.Wai.Middleware.ServantError + ( handleRawError ) import Servant ( (:<|>) (..) + , JSON , NoContent (..) , Server + , contentType , err403 , err404 , err409 @@ -99,15 +112,21 @@ import Servant.Server import qualified Cardano.Wallet as W import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE import qualified Data.Text as T - +import qualified Data.Text.Encoding as T -- | A Servant server for our wallet API server :: (TxId t, KeyToAddress t) => WalletLayer (SeqState t) t -> Server Api server w = addresses w :<|> wallets w :<|> transactions w +-- | A list of additional middlewares running on top of our server +middlewares :: [Middleware] +middlewares = + [ handleRawError handler ] + {------------------------------------------------------------------------------- Wallets -------------------------------------------------------------------------------} @@ -272,12 +291,6 @@ class LiftHandler e where liftHandler action = Handler (withExceptT handler action) handler :: e -> ServantErr --- FIXME --- --- For now, just "dumb" mapping from our internal errors to servant errors. --- In practice, we want to create nice error messages giving as much details as --- we can. - apiError :: ServantErr -> ApiErrorCode -> Text -> ServantErr apiError err code message = err { errBody = Aeson.encode $ Aeson.object @@ -417,3 +430,42 @@ instance LiftHandler ErrUpdatePassphrase where handler = \case ErrUpdatePassphraseNoSuchWallet e -> handler e ErrUpdatePassphraseWithRootKey e -> handler e + +instance LiftHandler ServantErr where + handler err@(ServantErr code _ body headers) = case code of + 400 -> apiError err' BadRequest (utf8 body) + 404 -> apiError err' NotFound $ mconcat + [ "I couldn't find the requested endpoint? If the endpoint contains " + , "path parameters, make sure they are well-formed otherwise I " + , "won't be able to route them correctly." + ] + 405 -> apiError err' MethodNotAllowed $ mconcat + [ "You've reached a known endpoint but I don't know how to handle " + , "this HTTP method for it. Please double-check both the endpoint " + , "and the method used: one of them is likely incorrect (e.g. POST " + , "instead of PUT, or GET instead of POST...)." + ] + 406 -> apiError err' NotAcceptable $ mconcat + [ "It seems like you don't accept 'application/json' however, I " + , "only speak 'application/json'! Please, double-check your " + , "'Accept' request header and make sure it's set to " + , "'application/json'." + ] + 415 -> apiError err' UnsupportedMediaType $ mconcat + [ "I am sorry but I only speak 'application/json' and I need you to " + , "tell me what you're speaking before I can comprehend it. Please, " + , "double-check your 'Content-Type' request header and make sure " + , "it's set to 'application/json'." + ] + _ -> apiError err' UnexpectedError $ mconcat + [ "Looks like something went wrong and I wasn't ready for this. " + , "Here is a hint about what happened: ", utf8 body + ] + where + utf8 = T.decodeUtf8 . BL.toStrict + err' = err + { errHeaders = + ( hContentType + , renderHeader $ contentType $ Proxy @JSON + ) : headers + } diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index ae86f5b94b8..8bb9a7bd087 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -193,6 +193,12 @@ data ApiErrorCode | NetworkUnreachable | CreatedInvalidTransaction | RejectedByCoreNode + | BadRequest + | NotFound + | MethodNotAllowed + | NotAcceptable + | UnsupportedMediaType + | UnexpectedError deriving (Eq, Generic, Show) {------------------------------------------------------------------------------- From b0d1bd4a7fddb62f0eb0461c368d30155de3497d Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 21 May 2019 16:40:42 +0200 Subject: [PATCH 3/4] factor out logic for starting wallet server, and mount middleware --- exe/wallet/Main.hs | 8 ++--- lib/core/cardano-wallet-core.cabal | 1 + lib/core/src/Cardano/Wallet/Api/Server.hs | 36 ++++++++++++------- .../cardano-wallet-http-bridge.cabal | 1 - lib/http-bridge/test/integration/Main.hs | 11 ++---- 5 files changed, 30 insertions(+), 27 deletions(-) diff --git a/exe/wallet/Main.hs b/exe/wallet/Main.hs index f19dd5a424d..c9682d44939 100644 --- a/exe/wallet/Main.hs +++ b/exe/wallet/Main.hs @@ -7,6 +7,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} + -- | -- Copyright: © 2018-2019 IOHK -- License: MIT @@ -40,8 +41,6 @@ import Cardano.Wallet ( newWalletLayer ) import Cardano.Wallet.Api ( Api ) -import Cardano.Wallet.Api.Server - ( server ) import Cardano.Wallet.Api.Types ( ApiMnemonicT (..) , ApiT (..) @@ -81,7 +80,7 @@ import Network.HTTP.Client import Network.HTTP.Types.Status ( status404, status409 ) import Servant - ( (:<|>) (..), (:>), serve ) + ( (:<|>) (..), (:>) ) import Servant.Client ( BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM ) import Servant.Client.Core @@ -108,6 +107,7 @@ import System.IO import Text.Regex.Applicative ( anySym, few, match, string, sym ) +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 @@ -337,7 +337,7 @@ execServer (Port port) (Port bridgePort) = do nw <- HttpBridge.newNetworkLayer bridgePort let tl = HttpBridge.newTransactionLayer wallet <- newWalletLayer @_ @HttpBridge db nw tl - Warp.runSettings settings (serve (Proxy @("v2" :> Api)) (server wallet)) + Server.start settings wallet where settings = Warp.defaultSettings & Warp.setPort port diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 9aca6e45f13..cc4ea4892f3 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -64,6 +64,7 @@ library , transformers , vector , wai + , warp hs-source-dirs: src diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 77174e75023..8a87b6ceb62 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} -- | -- Copyright: © 2018-2019 IOHK @@ -12,8 +14,7 @@ -- endpoints reachable through HTTP. module Cardano.Wallet.Api.Server - ( server - , middlewares + ( start ) where import Prelude @@ -90,12 +91,12 @@ import Network.HTTP.Media.RenderHeader ( renderHeader ) import Network.HTTP.Types.Header ( hContentType ) -import Network.Wai - ( Middleware ) import Network.Wai.Middleware.ServantError ( handleRawError ) import Servant ( (:<|>) (..) + , (:>) + , Application , JSON , NoContent (..) , Server @@ -106,6 +107,7 @@ import Servant , err410 , err500 , err503 + , serve ) import Servant.Server ( Handler (..), ServantErr (..) ) @@ -116,16 +118,24 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Network.Wai.Handler.Warp as Warp + +-- | Start the application server +start + :: (TxId t, KeyToAddress t) + => Warp.Settings + -> WalletLayer (SeqState t) t + -> IO () +start settings wl = Warp.runSettings settings + $ handleRawError handler + application + where + -- | A Servant server for our wallet API + server :: Server Api + server = addresses wl :<|> wallets wl :<|> transactions wl --- | A Servant server for our wallet API -server :: (TxId t, KeyToAddress t) => WalletLayer (SeqState t) t -> Server Api -server w = - addresses w :<|> wallets w :<|> transactions w - --- | A list of additional middlewares running on top of our server -middlewares :: [Middleware] -middlewares = - [ handleRawError handler ] + application :: Application + application = serve (Proxy @("v2" :> Api)) server {------------------------------------------------------------------------------- Wallets diff --git a/lib/http-bridge/cardano-wallet-http-bridge.cabal b/lib/http-bridge/cardano-wallet-http-bridge.cabal index a49e13d4811..272d8724f7d 100644 --- a/lib/http-bridge/cardano-wallet-http-bridge.cabal +++ b/lib/http-bridge/cardano-wallet-http-bridge.cabal @@ -151,7 +151,6 @@ test-suite integration , http-types , memory , process - , servant-server , template-haskell , text , text-class diff --git a/lib/http-bridge/test/integration/Main.hs b/lib/http-bridge/test/integration/Main.hs index 67b1d873525..19438ad231d 100644 --- a/lib/http-bridge/test/integration/Main.hs +++ b/lib/http-bridge/test/integration/Main.hs @@ -13,10 +13,6 @@ import Cardano.Launcher ( Command (..), StdStream (..), launch ) import Cardano.Wallet ( newWalletLayer ) -import Cardano.Wallet.Api - ( Api ) -import Cardano.Wallet.Api.Server - ( server ) import Cardano.Wallet.Compatibility.HttpBridge ( HttpBridge ) import Control.Concurrent @@ -31,14 +27,10 @@ import Data.Aeson ( Value (..), (.:) ) import Data.Function ( (&) ) -import Data.Proxy - ( Proxy (..) ) import Data.Time ( addUTCTime, defaultTimeLocale, formatTime, getCurrentTime ) import Network.HTTP.Client ( defaultManagerSettings, newManager ) -import Servant - ( (:>), serve ) import System.Directory ( createDirectoryIfMissing, removePathForcibly ) import System.IO @@ -53,6 +45,7 @@ import Test.Integration.Framework.Request ( Headers (Default), Payload (Empty), request ) import qualified Cardano.LauncherSpec as Launcher +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.Network.HttpBridgeSpec as HttpBridge @@ -180,7 +173,7 @@ main = do let tl = HttpBridge.newTransactionLayer wallet <- newWalletLayer @_ @HttpBridge db nl tl let settings = Warp.defaultSettings & Warp.setPort serverPort - Warp.runSettings settings (serve (Proxy @("v2" :> Api)) (server wallet)) + Server.start settings wallet waitForCluster :: String -> IO () waitForCluster addr = do From 4c054e757c2523e7ddc6de21a8fc75b3665d2775 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Tue, 21 May 2019 17:28:45 +0200 Subject: [PATCH 4/4] convert double-quotes to single quotes in error message to prevent unfriendly escaping issues --- lib/core/src/Cardano/Wallet/Api/Server.hs | 2 +- .../integration/Test/Integration/Scenario/Wallets.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 8a87b6ceb62..34094851a6d 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -472,7 +472,7 @@ instance LiftHandler ServantErr where , "Here is a hint about what happened: ", utf8 body ] where - utf8 = T.decodeUtf8 . BL.toStrict + utf8 = T.replace "\"" "'" . T.decodeUtf8 . BL.toStrict err' = err { errHeaders = ( hContentType diff --git a/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs b/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs index b56eff05558..d81f00db1f9 100644 --- a/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs +++ b/lib/http-bridge/test/integration/Test/Integration/Scenario/Wallets.hs @@ -210,7 +210,7 @@ spec = do r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload verify r [ expectResponseCode @IO HTTP.status400 - , expectErrorMessage "key \"name\" not present" + , expectErrorMessage "key 'name' not present" ] describe "WALLETS_CREATE_05 - Mnemonics" $ do @@ -336,7 +336,7 @@ spec = do r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload verify r [ expectResponseCode @IO HTTP.status400 - , expectErrorMessage "key \"mnemonic_sentence\" not present" + , expectErrorMessage "key 'mnemonic_sentence' not present" ] describe "WALLETS_CREATE_06 - Mnemonics second factor" $ do @@ -525,7 +525,7 @@ spec = do r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload verify r [ expectResponseCode @IO HTTP.status400 - , expectErrorMessage "key \"passphrase\" not present" + , expectErrorMessage "key 'passphrase' not present" ] describe "WALLETS_CREATE_08 - address_pool_gap" $ do @@ -1212,14 +1212,14 @@ spec = do "new_passphrase": "Secure passphrase" } |] , [ expectResponseCode @IO HTTP.status400 - , expectErrorMessage "key \"old_passphrase\" not present" ] + , expectErrorMessage "key 'old_passphrase' not present" ] ) , ( "Missing new passphrase" , Json [json| { "old_passphrase": "Secure passphrase" } |] , [ expectResponseCode @IO HTTP.status400 - , expectErrorMessage "key \"new_passphrase\" not present" ] + , expectErrorMessage "key 'new_passphrase' not present" ] ) ] forM_ matrix $ \(title, payload, expectations) -> it title $ \ctx -> do