Custom JSON Errors for the Servant Server

Question

When using servant, I would like to return all errors as JSON. Currently, if the request cannot parse, I see an error message like this returned as plain text

Failed reading: not a valid json value

Instead, I would like to return it as application/json

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

How can i do this? The docs say that ServantErrthis is the default error type, and I can of course respond to user errors inside my handlers, but if the parsing fails, I don’t see how I can return a user error.

Answer 1

-,

{-# 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. blob JSON HTTP 400.

• .

JSON blob:

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

servant-server . , , master, arity addBodyCheck .

, "" - , , , , .

:

{-# 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) - .

(2) Servant , , API. ReqBody ; , , (GET, POST,...) . , - ReqBody, .

(3) GHC, , . API , typeclass, , -.

Answer 2

. - :

{-# 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

Answer 3

Inspiring @codedmart, I also use middleware, but it does not create json, it only changes the type of response content when an error occurs and saves the original error message.

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 is created in advance using a function that overrides the Servant throwError function.

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 }

then I can send any error using a special message, it will be used as json with the correct content type:

throwJsonError err500 "Oh no !"