json - Servant-server 的自定义 JSON 错误

Question

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

Failed reading: not a valid json value

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

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

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

Answer 1

一、一些语言扩展

{-# 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 的类型解析中时如何处理它的包.

我们已经从 the v0.8.1 release of ReqBody 中删除了大部分代码.

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

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

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

这是 JSON blob 的类型:

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

大多数这种机器是 servant-server 内部的。并且记录不足且相当脆弱。例如，我已经看到代码在 master 上存在分歧。分支和我的 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 服务的一种非常优雅的方式。