88 lines
2.9 KiB
Haskell
88 lines
2.9 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE PolyKinds #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Servant.Server.Internal.ErrorFormatter
|
|
( ErrorFormatters(..)
|
|
, ErrorFormatter
|
|
, NotFoundErrorFormatter
|
|
|
|
, DefaultErrorFormatters
|
|
, defaultErrorFormatters
|
|
|
|
, MkContextWithErrorFormatter
|
|
, mkContextWithErrorFormatter
|
|
) where
|
|
|
|
import Data.String.Conversions
|
|
(cs)
|
|
import Data.Typeable
|
|
import Network.Wai.Internal
|
|
(Request)
|
|
|
|
import Servant.API
|
|
(Capture, ReqBody)
|
|
import Servant.Server.Internal.Context
|
|
import Servant.Server.Internal.ServerError
|
|
|
|
-- | 'Context' that contains default error formatters.
|
|
type DefaultErrorFormatters = '[ErrorFormatters]
|
|
|
|
-- | A collection of error formatters for different situations.
|
|
--
|
|
-- If you need to override one of them, use 'defaultErrorFormatters' with record update syntax.
|
|
data ErrorFormatters = ErrorFormatters
|
|
{ -- | Format error from parsing the request body.
|
|
bodyParserErrorFormatter :: ErrorFormatter
|
|
-- | Format error from parsing url parts or query parameters.
|
|
, urlParseErrorFormatter :: ErrorFormatter
|
|
-- | Format error from parsing request headers.
|
|
, headerParseErrorFormatter :: ErrorFormatter
|
|
-- | Format error for not found URLs.
|
|
, notFoundErrorFormatter :: NotFoundErrorFormatter
|
|
}
|
|
|
|
-- | Default formatters will just return HTTP 400 status code with error
|
|
-- message as response body.
|
|
defaultErrorFormatters :: ErrorFormatters
|
|
defaultErrorFormatters = ErrorFormatters
|
|
{ bodyParserErrorFormatter = err400Formatter
|
|
, urlParseErrorFormatter = err400Formatter
|
|
, headerParseErrorFormatter = err400Formatter
|
|
, notFoundErrorFormatter = const err404
|
|
}
|
|
|
|
-- | A custom formatter for errors produced by parsing combinators like
|
|
-- 'ReqBody' or 'Capture'.
|
|
--
|
|
-- A 'TypeRep' argument described the concrete combinator that raised
|
|
-- the error, allowing formatter to customize the message for different
|
|
-- combinators.
|
|
--
|
|
-- A full 'Request' is also passed so that the formatter can react to @Accept@ header,
|
|
-- for example.
|
|
type ErrorFormatter = TypeRep -> Request -> String -> ServerError
|
|
|
|
-- | This formatter does not get neither 'TypeRep' nor error message.
|
|
type NotFoundErrorFormatter = Request -> ServerError
|
|
|
|
type MkContextWithErrorFormatter (ctx :: [*]) = ctx .++ DefaultErrorFormatters
|
|
|
|
mkContextWithErrorFormatter :: forall (ctx :: [*]). Context ctx -> Context (MkContextWithErrorFormatter ctx)
|
|
mkContextWithErrorFormatter ctx = ctx .++ (defaultErrorFormatters :. EmptyContext)
|
|
|
|
-- Internal
|
|
|
|
err400Formatter :: ErrorFormatter
|
|
err400Formatter _ _ e = err400 { errBody = cs e }
|
|
|
|
-- These definitions suppress "unused import" warning.
|
|
-- The imorts are needed for Haddock to correctly link to them.
|
|
_RB :: Proxy ReqBody
|
|
_RB = Proxy
|
|
_C :: Proxy Capture
|
|
_C = Proxy
|
|
_CT :: Proxy Context
|
|
_CT = Proxy
|