Servant-server的自定义JSON错误

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

Failed reading: not a valid json value

相反,我想把它作为回报 application/json

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

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

首先,一些语言扩展

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

接着

不幸的是,这比应该更难.虽然服务设计精良,逻辑部分组成很小,但对于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)

还有一个shell:

~ ??? 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服务的一种非常优雅的方式.