7

使用servant时，我想以JSON 形式返回所有错误。目前，如果请求无法解析，我会看到这样的错误消息，以纯文本形式返回

Failed reading: not a valid json value

相反，我想将其返回为application/json

{"error":"Failed reading: not a valid json value"}

我怎样才能做到这一点？文档说ServantErr是默认错误类型，我当然可以在处理程序中使用自定义错误进行响应，但是如果解析失败，我看不到如何返回自定义错误。

4

3 回答 3

6

一、一些语言扩展

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}

接着

不幸的是，这比它应该的要困难得多。Servant 虽然经过精心设计并由小逻辑部分组成，但对 HTTP 服务应该如何操作非常有意见。您可能正在使用的默认实现ReqBody是硬编码以输出文本字符串。

但是，我们可以切换出ReqBody我们自己的数据类型：

module Body where

import Control.Monad.Trans (liftIO)
import Data.Proxy (Proxy(..))
import Network.Wai (lazyRequestBody)

import Data.Aeson
import Servant.API
import Servant.Server
import Servant.Server.Internal

data Body a
instance (FromJSON a, HasServer api context) => HasServer (Body a :> api) context where
  type ServerT (Body a :> api) m = a -> ServerT api m

  route Proxy context subserver =
    route (Proxy :: Proxy api) context (addBodyCheck subserver (withRequest bodyCheck))
    where
      bodyCheck request = do
        body <- liftIO (lazyRequestBody request)
        case eitherDecode body of
          Left (BodyError -> e) ->
            delayedFailFatal err400 { errBody = encode e }
          Right v ->
            return v

在这段非常简短的代码中，发生了很多事情：

  • 我们正在教servant-server包如何处理我们的新数据类型，当它出现在serve (Proxy :: Proxy (Body foo :> bar)) server.

  • 我们已经从v0.8.1 版本中删除了ReqBody大部分代码。

  • 我们正在向处理请求主体的管道添加一个函数。

  • 在其中，我们尝试解码为 的a参数Body。失败时，我们会输出一个 JSON blob 和一个 HTTP 400。

  • 为简洁起见，我们在这里完全忽略了内容类型标头。

这是 JSON blob 的类型：

newtype BodyError = BodyError String
instance ToJSON BodyError where
  toJSON (BodyError b) = object ["error" .= b]

这种机器大部分是内部的servant-server，没有充分记录，而且相当脆弱。例如，我已经看到代码在master分支上出现了分歧，并且我的 arity 发生了addBodyCheck变化。

尽管 Servant 项目还很年轻，而且雄心勃勃，但我不得不说，这个解决方案的美观性和健壮性确实令人印象深刻。

为了测试这个

我们需要一个主模块：

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE TypeOperators         #-}
module Main where
import Data.Proxy (Proxy(..))
import Network.Wai.Handler.Warp (run)
import Servant.API
import Servant.Server

import Body

type API = Body [Int] :> Post '[JSON] [Int]

server :: Server API
server = pure

main :: IO ()
main = do
  putStrLn "running on port 8000"
  run 8000 (serve (Proxy :: Proxy API) server)

还有一个外壳：

~ ❯❯❯ curl -i -XPOST 'http://localhost:8000/'
HTTP/1.1 400 Bad Request
Transfer-Encoding: chunked
Date: Fri, 20 Jan 2017 01:18:57 GMT
Server: Warp/3.2.9

{"error":"Error in $: not enough input"}%

~ ❯❯❯ curl -id 'hey' -XPOST 'http://localhost:8000/'
HTTP/1.1 400 Bad Request
Transfer-Encoding: chunked
Date: Fri, 20 Jan 2017 01:19:02 GMT
Server: Warp/3.2.9

{"error":"Error in $: Failed reading: not a valid json value"}%

~ ❯❯❯ curl -id '[1,2,3]' -XPOST 'http://localhost:8000/'
HTTP/1.1 200 OK
Transfer-Encoding: chunked
Date: Fri, 20 Jan 2017 01:19:07 GMT
Server: Warp/3.2.9
Content-Type: application/json

[1,2,3]%

达达！

您应该能够在 LTS-7.16 上运行所有这些代码。

我们学到了什么

(1) 仆人和 Haskell 很有趣。

(2) 当涉及到您在 API 中指定的类型时，Servant 的类型类机制允许一种即插即用的方式。我们可以拿出来ReqBody换成自己的；在我在工作中做的一个项目中，我们甚至用我们自己的动词替换了仆人动词 ( GET, POST, ...)。我们编写了新的内容类型，甚至做了与ReqBody您在这里看到的类似的事情。

(3) GHC 编译器的非凡能力是我们可以在编译时解构类型，以安全且逻辑合理的方式影响运行时行为。我们可以在类型级别表达 API 路由树，然后使用类型类实例遍历它们，使用类型族累积服务器类型，这是构建类型良好的 Web 服务的一种非常优雅的方式。

于 2017-01-20T01:28:26.237 回答
3

目前我只是在中间件中处理这个。我执行以下操作：

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Lib.ErrorResponse where

import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.ByteString.Lazy (toStrict)
import Blaze.ByteString.Builder (toLazyByteString)
import Blaze.ByteString.Builder.ByteString (fromByteString)
import Network.Wai
import Network.Wai.Internal
import Network.HTTP.Types
import Data.Text
import Data.Aeson
import qualified Data.Text.Lazy as TL

customError :: Application -> Application
customError = modifyResponse responseModifier

responseModifier :: Response -> Response
responseModifier r
  | responseStatus r == status400 && not (isCustomMessage r "Bad Request") =
    buildResponse status400 "Bad Request" (customErrorBody r "BadRequest") 400
  | responseStatus r == status403 =
    buildResponse status403 "Forbidden" "Forbidden" 400
  | responseStatus r == status404 =
    buildResponse status404 "Not Found" "Not Found" 404
  | responseStatus r == status405 =
    buildResponse status405 "Method Not Allowed" "Method Not Allowed" 405
  | otherwise = r

customErrorBody :: Response -> Text -> Text
customErrorBody (ResponseBuilder _ _ b) _ = TL.toStrict $ decodeUtf8 $ toLazyByteString b
customErrorBody (ResponseRaw _ res) e = customErrorBody res e
customErrorBody _ e = e

isCustomMessage :: Response -> Text -> Bool
isCustomMessage r m = "{\"error\":" `isInfixOf` customErrorBody r m

buildResponse :: Status -> Text -> Text -> Int -> Response
buildResponse st err msg cde = responseBuilder st
  [("Content-Type", "application/json")]
  (fromByteString . toStrict . encode $ object
    [ "error" .= err
    , "message" .= msg
    , "statusCode" .= cde
    ]
  )

然后我可以像使用任何其他中间件一样使用：

run 8000 . customError $ serve api server
于 2017-01-21T16:51:13.127 回答
0

从@codedmart 获得灵感，我也使用了一个中间件，但它不构造json，它只是在出现错误时更改响应的内容类型，并保留原始错误消息。

startApp :: IO ()
startApp = run 8081 . (modifyResponse errorHeadersToJson) $ serve api server

errorHeadersToJson :: Response -> Response
errorHeadersToJson r
  | responseStatus r == status200 = r
  | otherwise = mapResponseHeaders text2json r

text2json :: ResponseHeaders -> ResponseHeaders
text2json h = Map.assocs (Map.fromList [("Content-Type", "application/json")] `Map.union` Map.fromList h)

json 是使用覆盖 Servant throwError 函数的函数预先构建的。

data ServerError = ServerError
  { statusCode        :: Int
  , error :: String
  , message  :: String
  } deriving (Eq, Show)

$(deriveJSON defaultOptions ''ServerError)

throwJsonError :: ServantErr -> String -> Servant.Handler b
throwJsonError err "" = throwError $ err { errBody = encode $ ServerError (errHTTPCode err) ("Server error"::String) (show $ errBody err) }
throwJsonError err message = throwError $ err { errBody = encode $ ServerError (errHTTPCode err) ("Server error"::String) message }

然后我可以使用自定义消息抛出任何错误，它将作为具有正确内容类型的 json 提供：

throwJsonError err500 "Oh no !"
于 2017-10-22T15:49:16.943 回答