From 57f0b0b390cc2e799f46622950a349d7bff18ef0 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Sun, 14 Jun 2020 12:15:30 +0300 Subject: [PATCH 1/7] Make error messages from combinators configurable Currently there is no way for Servant users to customize formatting of error messages that arise when combinators can't parse URL or request body, apart from reimplementing those combinators for themselves or using middlewares. This commit adds a possibility to specify custom error formatters through Context. Fixes #685 --- servant-server/servant-server.cabal | 3 +- servant-server/src/Servant/Server.hs | 32 ++++- servant-server/src/Servant/Server/Generic.hs | 1 + servant-server/src/Servant/Server/Internal.hs | 114 +++++++++++------- .../src/Servant/Server/Internal/Context.hs | 31 +++-- .../Servant/Server/Internal/ErrorFormatter.hs | 79 ++++++++++++ .../src/Servant/Server/Internal/Router.hs | 37 +++--- .../test/Servant/Server/RouterSpec.hs | 4 +- servant/src/Servant/API/Header.hs | 2 +- 9 files changed, 228 insertions(+), 75 deletions(-) create mode 100644 servant-server/src/Servant/Server/Internal/ErrorFormatter.hs diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 5b0407df..374220ef 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -50,9 +50,10 @@ library Servant.Server.Internal.Context Servant.Server.Internal.Delayed Servant.Server.Internal.DelayedIO + Servant.Server.Internal.ErrorFormatter Servant.Server.Internal.Handler - Servant.Server.Internal.Router Servant.Server.Internal.RouteResult + Servant.Server.Internal.Router Servant.Server.Internal.RoutingApplication Servant.Server.Internal.ServerError Servant.Server.StaticFiles diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index e2d9f3c5..99c0b1e5 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | This module lets you implement 'Server's for defined APIs. You'll -- most likely just need 'serve'. @@ -35,6 +36,8 @@ module Servant.Server -- * Context , Context(..) , HasContextEntry(getContextEntry) + , type (.++) + , (.++) -- ** NamedContext , NamedContext(..) , descendIntoNamedContext @@ -86,6 +89,24 @@ module Servant.Server , err504 , err505 + -- * Formatting of errors from combinators + -- + -- | You can configure how Servant will render errors that occur while parsing the request. + + , ErrorFormatter + , NotFoundErrorFormatter + , ErrorFormatters + + , bodyParserErrorFormatter + , urlParseErrorFormatter + , headerParseErrorFormatter + , notFoundErrorFormatter + + , DefaultErrorFormatters + , defaultErrorFormatters + + , getAcceptHeader + -- * Re-exports , Application , Tagged (..) @@ -129,10 +150,17 @@ import Servant.Server.Internal serve :: (HasServer api '[]) => Proxy api -> Server api -> Application serve p = serveWithContext p EmptyContext -serveWithContext :: (HasServer api context) +-- | Like 'serve', but allows you to pass custom context. +-- +-- 'defaultErrorFormatters' will always be appended to the end of the passed context, +-- but if you pass your own formatter, it will override the default one. +serveWithContext :: ( HasServer api context + , HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters ) => Proxy api -> Context context -> Server api -> Application serveWithContext p context server = - toApplication (runRouter (route p context (emptyDelayed (Route server)))) + toApplication (runRouter format404 (route p context (emptyDelayed (Route server)))) + where + format404 = notFoundErrorFormatter . getContextEntry . mkContextWithErrorFormatter $ context -- | Hoist server implementation. -- diff --git a/servant-server/src/Servant/Server/Generic.hs b/servant-server/src/Servant/Server/Generic.hs index 88dbe331..c3db01c3 100644 --- a/servant-server/src/Servant/Server/Generic.hs +++ b/servant-server/src/Servant/Server/Generic.hs @@ -67,6 +67,7 @@ genericServeTWithContext ( GenericServant routes (AsServerT m) , GenericServant routes AsApi , HasServer (ToServantApi routes) ctx + , HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m) ) => (forall a. m a -> Handler a) -- ^ 'hoistServer' argument to come back to 'Handler' diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index b9597aa6..9fa0187b 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -24,6 +24,7 @@ module Servant.Server.Internal , module Servant.Server.Internal.Context , module Servant.Server.Internal.Delayed , module Servant.Server.Internal.DelayedIO + , module Servant.Server.Internal.ErrorFormatter , module Servant.Server.Internal.Handler , module Servant.Server.Internal.Router , module Servant.Server.Internal.RouteResult @@ -95,6 +96,7 @@ import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.Context import Servant.Server.Internal.Delayed import Servant.Server.Internal.DelayedIO +import Servant.Server.Internal.ErrorFormatter import Servant.Server.Internal.Handler import Servant.Server.Internal.Router import Servant.Server.Internal.RouteResult @@ -168,7 +170,10 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont -- > server = getBook -- > where getBook :: Text -> Handler Book -- > getBook isbn = ... -instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods)) +instance (KnownSymbol capture, FromHttpApiData a + , HasServer api context, SBoolI (FoldLenient mods) + , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters + ) => HasServer (Capture' mods capture a :> api) context where type ServerT (Capture' mods capture a :> api) m = @@ -180,12 +185,15 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI CaptureRouter $ route (Proxy :: Proxy api) context - (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods) - , parseUrlPiece txt :: Either T.Text a) of - (SFalse, Left e) -> delayedFail err400 { errBody = cs e } - (SFalse, Right v) -> return v - (STrue, piece) -> return $ (either (Left . cs) Right) piece - ) + (addCapture d $ \ txt -> withRequest $ \ request -> + case ( sbool :: SBool (FoldLenient mods) + , parseUrlPiece txt :: Either T.Text a) of + (SFalse, Left e) -> delayedFail $ formatError rep request $ cs e + (SFalse, Right v) -> return v + (STrue, piece) -> return $ (either (Left . cs) Right) piece) + where + rep = typeRep (Proxy :: Proxy Capture') + formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) -- | If you use 'CaptureAll' in one of the endpoints for your API, -- this automatically requires your server-side handler to be a @@ -204,7 +212,10 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI -- > server = getSourceFile -- > where getSourceFile :: [Text] -> Handler Book -- > getSourceFile pathSegments = ... -instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) +instance (KnownSymbol capture, FromHttpApiData a + , HasServer api context + , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters + ) => HasServer (CaptureAll capture a :> api) context where type ServerT (CaptureAll capture a :> api) m = @@ -216,11 +227,14 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) CaptureAllRouter $ route (Proxy :: Proxy api) context - (addCapture d $ \ txts -> case parseUrlPieces txts of - Left _ -> delayedFail err400 - Right v -> return v + (addCapture d $ \ txts -> withRequest $ \ request -> + case parseUrlPieces txts of + Left e -> delayedFail $ formatError rep request $ cs e + Right v -> return v ) - + where + rep = typeRep (Proxy :: Proxy CaptureAll) + formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) allowedMethodHead :: Method -> Request -> Bool allowedMethodHead method request = method == methodGet && requestMethod request == methodHead @@ -240,10 +254,10 @@ methodCheck method request -- body check is no longer an option. However, we now run the accept -- check before the body check and can therefore afford to make it -- recoverable. -acceptCheck :: (AllMime list) => Proxy list -> B.ByteString -> DelayedIO () +acceptCheck :: (AllMime list) => Proxy list -> AcceptHeader -> DelayedIO () acceptCheck proxy accH - | canHandleAcceptH proxy (AcceptHeader accH) = return () - | otherwise = delayedFail err406 + | canHandleAcceptH proxy accH = return () + | otherwise = delayedFail err406 methodRouter :: (AllCTRender ctypes a) => (b -> ([(HeaderName, B.ByteString)], a)) @@ -253,12 +267,12 @@ methodRouter :: (AllCTRender ctypes a) methodRouter splitHeaders method proxy status action = leafRouter route' where route' env request respond = - let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request + let accH = getAcceptHeader request in runAction (action `addMethodCheck` methodCheck method request `addAcceptCheck` acceptCheck proxy accH ) env request respond $ \ output -> do let (headers, b) = splitHeaders output - case handleAcceptH proxy (AcceptHeader accH) b of + case handleAcceptH proxy accH b of Nothing -> FailFatal err406 -- this should not happen (checked before), so we make it fatal if it does Just (contentT, body) -> let bdy = if allowedMethodHead method request then "" else body @@ -343,7 +357,7 @@ streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, Fra -> Delayed env (Handler c) -> Router env streamRouter splitHeaders method status framingproxy ctypeproxy action = leafRouter $ \env request respond -> - let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request + let AcceptHeader accH = getAcceptHeader request cmediatype = NHM.matchAccept [contentType ctypeproxy] accH accCheck = when (isNothing cmediatype) $ delayedFail err406 contentHeader = (hContentType, NHM.renderHeader . maybeToList $ cmediatype) @@ -388,6 +402,7 @@ streamRouter splitHeaders method status framingproxy ctypeproxy action = leafRou instance (KnownSymbol sym, FromHttpApiData a, HasServer api context , SBoolI (FoldRequired mods), SBoolI (FoldLenient mods) + , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer (Header' mods sym a :> api) context where ------ @@ -399,6 +414,9 @@ instance route Proxy context subserver = route (Proxy :: Proxy api) context $ subserver `addHeaderCheck` withRequest headerCheck where + rep = typeRep (Proxy :: Proxy Header') + formatError = headerParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) + headerName :: IsString n => n headerName = fromString $ symbolVal (Proxy :: Proxy sym) @@ -409,15 +427,13 @@ instance mev :: Maybe (Either T.Text a) mev = fmap parseHeader $ lookup headerName (requestHeaders req) - errReq = delayedFailFatal err400 - { errBody = "Header " <> headerName <> " is required" - } + errReq = delayedFailFatal $ formatError rep req + $ "Header " <> headerName <> " is required" - errSt e = delayedFailFatal err400 - { errBody = cs $ "Error parsing header " - <> headerName - <> " failed: " <> e - } + errSt e = delayedFailFatal $ formatError rep req + $ cs $ "Error parsing header " + <> headerName + <> " failed: " <> e -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API, -- this automatically requires your server-side handler to be a function @@ -443,6 +459,7 @@ instance instance ( KnownSymbol sym, FromHttpApiData a, HasServer api context , SBoolI (FoldRequired mods), SBoolI (FoldLenient mods) + , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer (QueryParam' mods sym a :> api) context where ------ @@ -455,6 +472,9 @@ instance let querytext = queryToQueryText . queryString paramname = cs $ symbolVal (Proxy :: Proxy sym) + rep = typeRep (Proxy :: Proxy QueryParam') + formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) + parseParam :: Request -> DelayedIO (RequestArgument mods a) parseParam req = unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev @@ -462,14 +482,12 @@ instance mev :: Maybe (Either T.Text a) mev = fmap parseQueryParam $ join $ lookup paramname $ querytext req - errReq = delayedFailFatal err400 - { errBody = cs $ "Query parameter " <> paramname <> " is required" - } + errReq = delayedFailFatal $ formatError rep req + $ cs $ "Query parameter " <> paramname <> " is required" - errSt e = delayedFailFatal err400 - { errBody = cs $ "Error parsing query parameter " - <> paramname <> " failed: " <> e - } + errSt e = delayedFailFatal $ formatError rep req + $ cs $ "Error parsing query parameter " + <> paramname <> " failed: " <> e delayed = addParameterCheck subserver . withRequest $ \req -> parseParam req @@ -495,7 +513,8 @@ instance -- > server = getBooksBy -- > where getBooksBy :: [Text] -> Handler [Book] -- > getBooksBy authors = ...return all books by these authors... -instance (KnownSymbol sym, FromHttpApiData a, HasServer api context) +instance (KnownSymbol sym, FromHttpApiData a, HasServer api context + , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters) => HasServer (QueryParams sym a :> api) context where type ServerT (QueryParams sym a :> api) m = @@ -506,21 +525,23 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context) route Proxy context subserver = route (Proxy :: Proxy api) context $ subserver `addParameterCheck` withRequest paramsCheck where + rep = typeRep (Proxy :: Proxy QueryParams) + formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) + paramname = cs $ symbolVal (Proxy :: Proxy sym) paramsCheck req = case partitionEithers $ fmap parseQueryParam params of ([], parsed) -> return parsed - (errs, _) -> delayedFailFatal err400 - { errBody = cs $ "Error parsing query parameter(s) " - <> paramname <> " failed: " - <> T.intercalate ", " errs - } + (errs, _) -> delayedFailFatal $ formatError rep req + $ cs $ "Error parsing query parameter(s) " + <> paramname <> " failed: " + <> T.intercalate ", " errs where params :: [T.Text] params = mapMaybe snd . filter (looksLikeParam . fst) - . queryToQueryText - . queryString + . queryToQueryText + . queryString $ req looksLikeParam name = name == paramname || name == (paramname <> "[]") @@ -588,7 +609,7 @@ instance HasServer Raw context where -- The @Content-Type@ header is inspected, and the list provided is used to -- attempt deserialization. If the request does not have a @Content-Type@ -- header, it is treated as @application/octet-stream@ (as specified in --- . +-- [RFC 7231 section 3.1.1.5](http://tools.ietf.org/html/rfc7231#section-3.1.1.5)). -- This lets servant worry about extracting it from the request and turning -- it into a value of the type you specify. -- @@ -604,6 +625,7 @@ instance HasServer Raw context where -- > where postBook :: Book -> Handler Book -- > postBook book = ...insert into your db... instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods) + , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer (ReqBody' mods list a :> api) context where type ServerT (ReqBody' mods list a :> api) m = @@ -615,6 +637,9 @@ instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods = route (Proxy :: Proxy api) context $ addBodyCheck subserver ctCheck bodyCheck where + rep = typeRep (Proxy :: Proxy ReqBody') + formatError = bodyParserErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) + -- Content-Type check, we only lookup we can try to parse the request body ctCheck = withRequest $ \ request -> do -- See HTTP RFC 2616, section 7.2.1 @@ -633,7 +658,7 @@ instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods case sbool :: SBool (FoldLenient mods) of STrue -> return mrqbody SFalse -> case mrqbody of - Left e -> delayedFailFatal err400 { errBody = cs e } + Left e -> delayedFailFatal $ formatError rep request e Right v -> return v instance @@ -761,6 +786,9 @@ instance ( KnownSymbol realm ct_wildcard :: B.ByteString ct_wildcard = "*" <> "/" <> "*" -- Because CPP +getAcceptHeader :: Request -> AcceptHeader +getAcceptHeader = AcceptHeader . fromMaybe ct_wildcard . lookup hAccept . requestHeaders + -- * General Authentication diff --git a/servant-server/src/Servant/Server/Internal/Context.hs b/servant-server/src/Servant/Server/Internal/Context.hs index 9472cbba..cb4c23be 100644 --- a/servant-server/src/Servant/Server/Internal/Context.hs +++ b/servant-server/src/Servant/Server/Internal/Context.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Servant.Server.Internal.Context where @@ -45,6 +46,20 @@ instance Eq (Context '[]) where instance (Eq a, Eq (Context as)) => Eq (Context (a ': as)) where x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2 +-- | Append two type-level lists. +-- +-- Hint: import it as +-- +-- > import Servant.Server (type (.++)) +type family (.++) (l1 :: [*]) (l2 :: [*]) where + '[] .++ a = a + (a ': as) .++ b = a ': (as .++ b) + +-- | Append two contexts. +(.++) :: Context l1 -> Context l2 -> Context (l1 .++ l2) +EmptyContext .++ a = a +(a :. as) .++ b = a :. (as .++ b) + -- | This class is used to access context entries in 'Context's. 'getContextEntry' -- returns the first value where the type matches: -- diff --git a/servant-server/src/Servant/Server/Internal/ErrorFormatter.hs b/servant-server/src/Servant/Server/Internal/ErrorFormatter.hs new file mode 100644 index 00000000..c5a7b221 --- /dev/null +++ b/servant-server/src/Servant/Server/Internal/ErrorFormatter.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} + +module Servant.Server.Internal.ErrorFormatter + 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 = undefined +_C :: Proxy Capture +_C = undefined +_CT :: Proxy Context +_CT = undefined diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs index d6735c9e..ecee5901 100644 --- a/servant-server/src/Servant/Server/Internal/Router.hs +++ b/servant-server/src/Servant/Server/Internal/Router.hs @@ -17,8 +17,9 @@ import Data.Text import qualified Data.Text as T import Network.Wai (Response, pathInfo) -import Servant.Server.Internal.RoutingApplication +import Servant.Server.Internal.ErrorFormatter import Servant.Server.Internal.RouteResult +import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServerError type Router env = Router' env RoutingApplication @@ -153,52 +154,52 @@ tweakResponse :: (RouteResult Response -> RouteResult Response) -> Router env -> tweakResponse f = fmap (\a -> \req cont -> a req (cont . f)) -- | Interpret a router as an application. -runRouter :: Router () -> RoutingApplication -runRouter r = runRouterEnv r () +runRouter :: NotFoundErrorFormatter -> Router () -> RoutingApplication +runRouter fmt r = runRouterEnv fmt r () -runRouterEnv :: Router env -> env -> RoutingApplication -runRouterEnv router env request respond = +runRouterEnv :: NotFoundErrorFormatter -> Router env -> env -> RoutingApplication +runRouterEnv fmt router env request respond = case router of StaticRouter table ls -> case pathInfo request of - [] -> runChoice ls env request respond + [] -> runChoice fmt ls env request respond -- This case is to handle trailing slashes. - [""] -> runChoice ls env request respond + [""] -> runChoice fmt ls env request respond first : rest | Just router' <- M.lookup first table -> let request' = request { pathInfo = rest } - in runRouterEnv router' env request' respond - _ -> respond $ Fail err404 + in runRouterEnv fmt router' env request' respond + _ -> respond $ Fail $ fmt request CaptureRouter router' -> case pathInfo request of - [] -> respond $ Fail err404 + [] -> respond $ Fail $ fmt request -- This case is to handle trailing slashes. - [""] -> respond $ Fail err404 + [""] -> respond $ Fail $ fmt request first : rest -> let request' = request { pathInfo = rest } - in runRouterEnv router' (first, env) request' respond + in runRouterEnv fmt router' (first, env) request' respond CaptureAllRouter router' -> let segments = pathInfo request request' = request { pathInfo = [] } - in runRouterEnv router' (segments, env) request' respond + in runRouterEnv fmt router' (segments, env) request' respond RawRouter app -> app env request respond Choice r1 r2 -> - runChoice [runRouterEnv r1, runRouterEnv r2] env request respond + runChoice fmt [runRouterEnv fmt r1, runRouterEnv fmt r2] env request respond -- | Try a list of routing applications in order. -- We stop as soon as one fails fatally or succeeds. -- If all fail normally, we pick the "best" error. -- -runChoice :: [env -> RoutingApplication] -> env -> RoutingApplication -runChoice ls = +runChoice :: NotFoundErrorFormatter -> [env -> RoutingApplication] -> env -> RoutingApplication +runChoice fmt ls = case ls of - [] -> \ _ _ respond -> respond (Fail err404) + [] -> \ _ request respond -> respond (Fail $ fmt request) [r] -> r (r : rs) -> \ env request respond -> r env request $ \ response1 -> case response1 of - Fail _ -> runChoice rs env request $ \ response2 -> + Fail _ -> runChoice fmt rs env request $ \ response2 -> respond $ highestPri response1 response2 _ -> respond response1 where diff --git a/servant-server/test/Servant/Server/RouterSpec.hs b/servant-server/test/Servant/Server/RouterSpec.hs index 472dfecc..9b69a2e7 100644 --- a/servant-server/test/Servant/Server/RouterSpec.hs +++ b/servant-server/test/Servant/Server/RouterSpec.hs @@ -32,7 +32,7 @@ routerSpec :: Spec routerSpec = do describe "tweakResponse" $ do let app' :: Application - app' = toApplication $ runRouter router' + app' = toApplication $ runRouter (const err404) router' router', router :: Router () router' = tweakResponse (fmap twk) router @@ -48,7 +48,7 @@ routerSpec = do describe "runRouter" $ do let toApp :: Router () -> Application - toApp = toApplication . runRouter + toApp = toApplication . runRouter (const err404) cap :: Router () cap = CaptureRouter $ diff --git a/servant/src/Servant/API/Header.hs b/servant/src/Servant/API/Header.hs index 14562dfc..e5ea1e00 100644 --- a/servant/src/Servant/API/Header.hs +++ b/servant/src/Servant/API/Header.hs @@ -23,7 +23,7 @@ import Servant.API.Modifiers -- >>> type MyApi = "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer type Header = Header' '[Optional, Strict] -data Header' (mods :: [*]) (sym :: Symbol) a +data Header' (mods :: [*]) (sym :: Symbol) (a :: *) deriving Typeable -- $setup From cb80fa626347dc48560e86c7fac0910da84d6c89 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 17 Jul 2020 15:51:11 +0300 Subject: [PATCH 2/7] Add tests for custom error formatters --- .../test/Servant/Server/ErrorSpec.hs | 58 +++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/servant-server/test/Servant/Server/ErrorSpec.hs b/servant-server/test/Servant/Server/ErrorSpec.hs index 8da38bff..72251b21 100644 --- a/servant-server/test/Servant/Server/ErrorSpec.hs +++ b/servant-server/test/Servant/Server/ErrorSpec.hs @@ -15,6 +15,8 @@ import qualified Data.ByteString.Lazy.Char8 as BCL import Data.Monoid ((<>)) import Data.Proxy +import Data.String.Conversions + (cs) import Network.HTTP.Types (hAccept, hAuthorization, hContentType, methodGet, methodPost, methodPut) @@ -31,6 +33,7 @@ spec = describe "HTTP Errors" $ do prioErrorsSpec errorRetrySpec errorChoiceSpec + customFormattersSpec -- * Auth machinery (reused throughout) @@ -293,6 +296,61 @@ errorChoiceSpec = describe "Multiple handlers return errors" `shouldRespondWith` 415 +-- }}} +------------------------------------------------------------------------------ +-- * Custom errors {{{ + +customFormatter :: ErrorFormatter +customFormatter _ _ err = err400 { errBody = "CUSTOM! " <> cs err } + +customFormatters :: ErrorFormatters +customFormatters = defaultErrorFormatters + { bodyParserErrorFormatter = customFormatter + , urlParseErrorFormatter = customFormatter + , notFoundErrorFormatter = const $ err404 { errBody = "CUSTOM! Not Found" } + } + +type CustomFormatterAPI + = "query" :> QueryParam' '[Required, Strict] "param" Int :> Get '[PlainText] String + :<|> "capture" :> Capture "cap" Bool :> Get '[PlainText] String + :<|> "body" :> ReqBody '[JSON] Int :> Post '[PlainText] String + +customFormatterAPI :: Proxy CustomFormatterAPI +customFormatterAPI = Proxy + +customFormatterServer :: Server CustomFormatterAPI +customFormatterServer = (\_ -> return "query") + :<|> (\_ -> return "capture") + :<|> (\_ -> return "body") + +customFormattersSpec :: Spec +customFormattersSpec = describe "Custom errors from combinators" + $ with (return $ serveWithContext customFormatterAPI (customFormatters :. EmptyContext) customFormatterServer) $ do + + let startsWithCustom = ResponseMatcher + { matchStatus = 400 + , matchHeaders = [] + , matchBody = MatchBody $ \_ body -> if "CUSTOM!" `BCL.isPrefixOf` body + then Nothing + else Just $ show body <> " does not start with \"CUSTOM!\"" + } + + it "formats query parse error" $ do + request methodGet "query?param=false" [] "" + `shouldRespondWith` startsWithCustom + + it "formats query parse error with missing param" $ do + request methodGet "query" [] "" + `shouldRespondWith` startsWithCustom + + it "formats capture parse error" $ do + request methodGet "capture/42" [] "" + `shouldRespondWith` startsWithCustom + + it "formats body parse error" $ do + request methodPost "body" [(hContentType, "application/json")] "foo" + `shouldRespondWith` startsWithCustom + -- }}} ------------------------------------------------------------------------------ -- * Instances {{{ From 1a09b1d3a4904f94944359f75381efca24e47a58 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 17 Jul 2020 16:01:00 +0300 Subject: [PATCH 3/7] Update GHC 8.8.x versions to 8.8.3 --- doc/cookbook/basic-auth/basic-auth.cabal | 2 +- doc/cookbook/basic-streaming/basic-streaming.cabal | 2 +- doc/cookbook/curl-mock/curl-mock.cabal | 2 +- doc/cookbook/db-postgres-pool/db-postgres-pool.cabal | 2 +- doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal | 2 +- doc/cookbook/file-upload/file-upload.cabal | 2 +- doc/cookbook/generic/generic.cabal | 2 +- .../hoist-server-with-context/hoist-server-with-context.cabal | 2 +- doc/cookbook/https/https.cabal | 2 +- doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal | 2 +- doc/cookbook/pagination/pagination.cabal | 2 +- doc/cookbook/sentry/sentry.cabal | 2 +- doc/cookbook/structuring-apis/structuring-apis.cabal | 2 +- doc/cookbook/testing/testing.cabal | 2 +- doc/cookbook/using-custom-monad/using-custom-monad.cabal | 2 +- doc/cookbook/using-free-client/using-free-client.cabal | 2 +- doc/tutorial/tutorial.cabal | 2 +- servant-client-core/servant-client-core.cabal | 2 +- servant-client/servant-client.cabal | 2 +- servant-conduit/servant-conduit.cabal | 2 +- servant-docs/servant-docs.cabal | 2 +- servant-foreign/servant-foreign.cabal | 2 +- servant-http-streams/servant-http-streams.cabal | 2 +- servant-machines/servant-machines.cabal | 2 +- servant-pipes/servant-pipes.cabal | 2 +- servant-server/servant-server.cabal | 2 +- servant/servant.cabal | 2 +- 27 files changed, 27 insertions(+), 27 deletions(-) diff --git a/doc/cookbook/basic-auth/basic-auth.cabal b/doc/cookbook/basic-auth/basic-auth.cabal index 1df7d086..4b3a2feb 100644 --- a/doc/cookbook/basic-auth/basic-auth.cabal +++ b/doc/cookbook/basic-auth/basic-auth.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-basic-auth main-is: BasicAuth.lhs diff --git a/doc/cookbook/basic-streaming/basic-streaming.cabal b/doc/cookbook/basic-streaming/basic-streaming.cabal index 714989b5..0f8858b3 100644 --- a/doc/cookbook/basic-streaming/basic-streaming.cabal +++ b/doc/cookbook/basic-streaming/basic-streaming.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-basic-streaming main-is: Streaming.lhs diff --git a/doc/cookbook/curl-mock/curl-mock.cabal b/doc/cookbook/curl-mock/curl-mock.cabal index 7fabc1cc..91918f38 100644 --- a/doc/cookbook/curl-mock/curl-mock.cabal +++ b/doc/cookbook/curl-mock/curl-mock.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbock-curl-mock main-is: CurlMock.lhs diff --git a/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal b/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal index 41013fd1..a4cb25a9 100644 --- a/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal +++ b/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-db-postgres-pool main-is: PostgresPool.lhs diff --git a/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal b/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal index cd0cb002..06710b40 100644 --- a/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal +++ b/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-db-sqlite-simple main-is: DBConnection.lhs diff --git a/doc/cookbook/file-upload/file-upload.cabal b/doc/cookbook/file-upload/file-upload.cabal index b9953bff..72a511c3 100644 --- a/doc/cookbook/file-upload/file-upload.cabal +++ b/doc/cookbook/file-upload/file-upload.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-file-upload main-is: FileUpload.lhs diff --git a/doc/cookbook/generic/generic.cabal b/doc/cookbook/generic/generic.cabal index 3a94c0ac..73188fc6 100644 --- a/doc/cookbook/generic/generic.cabal +++ b/doc/cookbook/generic/generic.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-using-custom-monad main-is: Generic.lhs diff --git a/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal b/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal index b2aeef30..54991be1 100644 --- a/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal +++ b/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal @@ -11,7 +11,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-hoist-server-with-context main-is: HoistServerWithContext.lhs diff --git a/doc/cookbook/https/https.cabal b/doc/cookbook/https/https.cabal index 080a9407..c1cec643 100644 --- a/doc/cookbook/https/https.cabal +++ b/doc/cookbook/https/https.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-https main-is: Https.lhs diff --git a/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal b/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal index 51724347..aa0cb728 100644 --- a/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal +++ b/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal @@ -11,7 +11,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-jwt-and-basic-auth main-is: JWTAndBasicAuth.lhs diff --git a/doc/cookbook/pagination/pagination.cabal b/doc/cookbook/pagination/pagination.cabal index 74a47d7b..0c20e0d2 100644 --- a/doc/cookbook/pagination/pagination.cabal +++ b/doc/cookbook/pagination/pagination.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-pagination main-is: Pagination.lhs diff --git a/doc/cookbook/sentry/sentry.cabal b/doc/cookbook/sentry/sentry.cabal index 03d0acc4..2ac54383 100644 --- a/doc/cookbook/sentry/sentry.cabal +++ b/doc/cookbook/sentry/sentry.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-sentry main-is: Sentry.lhs diff --git a/doc/cookbook/structuring-apis/structuring-apis.cabal b/doc/cookbook/structuring-apis/structuring-apis.cabal index 810a69ad..6355d507 100644 --- a/doc/cookbook/structuring-apis/structuring-apis.cabal +++ b/doc/cookbook/structuring-apis/structuring-apis.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-structuring-apis main-is: StructuringApis.lhs diff --git a/doc/cookbook/testing/testing.cabal b/doc/cookbook/testing/testing.cabal index 6ba8f785..9e13ce60 100644 --- a/doc/cookbook/testing/testing.cabal +++ b/doc/cookbook/testing/testing.cabal @@ -10,7 +10,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-testing main-is: Testing.lhs diff --git a/doc/cookbook/using-custom-monad/using-custom-monad.cabal b/doc/cookbook/using-custom-monad/using-custom-monad.cabal index 232c8d8b..244ab5ed 100644 --- a/doc/cookbook/using-custom-monad/using-custom-monad.cabal +++ b/doc/cookbook/using-custom-monad/using-custom-monad.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-using-custom-monad main-is: UsingCustomMonad.lhs diff --git a/doc/cookbook/using-free-client/using-free-client.cabal b/doc/cookbook/using-free-client/using-free-client.cabal index c8a07f53..e079cd7c 100644 --- a/doc/cookbook/using-free-client/using-free-client.cabal +++ b/doc/cookbook/using-free-client/using-free-client.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.2 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 executable cookbook-using-free-client main-is: UsingFreeClient.lhs diff --git a/doc/tutorial/tutorial.cabal b/doc/tutorial/tutorial.cabal index b338180d..dcbae743 100644 --- a/doc/tutorial/tutorial.cabal +++ b/doc/tutorial/tutorial.cabal @@ -17,7 +17,7 @@ tested-with: GHC==8.2.2 GHC==8.4.4 GHC==8.6.5 - GHC==8.8.2 + GHC==8.8.3 extra-source-files: static/index.html static/ui.js diff --git a/servant-client-core/servant-client-core.cabal b/servant-client-core/servant-client-core.cabal index a3b44dca..0d123e61 100644 --- a/servant-client-core/servant-client-core.cabal +++ b/servant-client-core/servant-client-core.cabal @@ -21,7 +21,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 , GHCJS == 8.4 extra-source-files: diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index d920577b..28003268 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -25,7 +25,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-conduit/servant-conduit.cabal b/servant-conduit/servant-conduit.cabal index df07ace7..829873b6 100644 --- a/servant-conduit/servant-conduit.cabal +++ b/servant-conduit/servant-conduit.cabal @@ -22,7 +22,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index b54c9c3e..0697b20d 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -24,7 +24,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index 5ab34718..640b6994 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/servant-foreign/servant-foreign.cabal @@ -26,7 +26,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-http-streams/servant-http-streams.cabal b/servant-http-streams/servant-http-streams.cabal index f21dcc73..8d49ef18 100644 --- a/servant-http-streams/servant-http-streams.cabal +++ b/servant-http-streams/servant-http-streams.cabal @@ -25,7 +25,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-machines/servant-machines.cabal b/servant-machines/servant-machines.cabal index 0603ff58..5b376429 100644 --- a/servant-machines/servant-machines.cabal +++ b/servant-machines/servant-machines.cabal @@ -22,7 +22,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-pipes/servant-pipes.cabal b/servant-pipes/servant-pipes.cabal index 79ca52f4..16ba7c72 100644 --- a/servant-pipes/servant-pipes.cabal +++ b/servant-pipes/servant-pipes.cabal @@ -22,7 +22,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 374220ef..06708d72 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -29,7 +29,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 extra-source-files: CHANGELOG.md diff --git a/servant/servant.cabal b/servant/servant.cabal index b0c92303..20dbc931 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -25,7 +25,7 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.2 + || ==8.8.3 , GHCJS == 8.4 extra-source-files: From 7218c66fd004774668a903a298e0303484cae02c Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 17 Jul 2020 16:01:16 +0300 Subject: [PATCH 4/7] haskell-ci regenerate --- .travis.yml | 117 +++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 103 insertions(+), 14 deletions(-) diff --git a/.travis.yml b/.travis.yml index 1ef279d7..6ffea7d4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,9 +2,13 @@ # # haskell-ci '--config=cabal.haskell-ci' '--output=.travis.yml' 'cabal.project' # +# To regenerate the script (for example after adjusting tested-with) run +# +# haskell-ci regenerate +# # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.9.20200121 +# version: 0.10.1 # version: ~> 1.0 language: c @@ -37,23 +41,20 @@ jobs: - compiler: ghcjs-8.4 addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"},{"sourceline":"deb http://ppa.launchpad.net/hvr/ghcjs/ubuntu bionic main"},{"sourceline":"deb https://deb.nodesource.com/node_10.x bionic main","key_url":"https://deb.nodesource.com/gpgkey/nodesource.gpg.key"}],"packages":["ghcjs-8.4","cabal-install-3.0","ghc-8.4.4","nodejs"]}} os: linux - - compiler: ghc-8.10.1 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.8.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.2","cabal-install-3.0"]}} + - compiler: ghc-8.8.3 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}} os: linux - compiler: ghc-8.6.5 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}} os: linux - compiler: ghc-8.4.4 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}} os: linux - compiler: ghc-8.2.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}} os: linux - compiler: ghc-8.0.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}} os: linux before_install: - | @@ -110,9 +111,9 @@ install: - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v - - if ! $GHCJS ; then (cd /tmp && ${CABAL} v2-install $WITHCOMPILER -j2 doctest --constraint='doctest ==0.16.3.*') ; fi - - if $GHCJS ; then (cd /tmp && ${CABAL} v2-install -w ghc-8.4.4 cabal-plan --constraint='cabal-plan ^>=0.6.0.0' --constraint='cabal-plan +exe') ; fi - - if $GHCJS ; then (cd /tmp && ${CABAL} v2-install -w ghc-8.4.4 hspec-discover) ; fi + - if ! $GHCJS ; then ${CABAL} v2-install $WITHCOMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.16.3' ; fi + - if $GHCJS ; then ${CABAL} v2-install -w ghc-8.4.4 --ignore-project cabal-plan --constraint='cabal-plan ^>=0.6.0.0' --constraint='cabal-plan +exe' ; fi + - if $GHCJS ; then ${CABAL} v2-install -w ghc-8.4.4 --ignore-project hspec-discover ; fi # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project @@ -139,6 +140,50 @@ install: if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/structuring-apis" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/using-custom-monad" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/using-free-client" >> cabal.project ; fi + - if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant' >> cabal.project ; fi + - "if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-client' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-client-core' >> cabal.project ; fi + - "if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-http-streams' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-docs' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-foreign' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-server' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package tutorial' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-machines' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-conduit' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-pipes' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-basic-auth' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-curl-mock' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-basic-streaming' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-db-postgres-pool' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-file-upload' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-generic' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-pagination' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-testing' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-structuring-apis' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-using-custom-monad' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-using-free-client' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - | echo "constraints: foundation >=0.0.14" >> cabal.project echo "constraints: memory <0.14.12 || >0.14.12" >> cabal.project @@ -236,6 +281,50 @@ script: if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_structuring_apis}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_using_custom_monad}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_using_free_client}" >> cabal.project ; fi + - if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant' >> cabal.project ; fi + - "if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-client' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-client-core' >> cabal.project ; fi + - "if $GHCJS || ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-http-streams' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-docs' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-foreign' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-server' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package tutorial' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-machines' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-conduit' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-pipes' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-basic-auth' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-curl-mock' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-basic-streaming' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-db-postgres-pool' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-file-upload' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-generic' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-pagination' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-testing' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-structuring-apis' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-using-custom-monad' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-using-free-client' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - | echo "constraints: foundation >=0.0.14" >> cabal.project echo "constraints: memory <0.14.12 || >0.14.12" >> cabal.project @@ -303,5 +392,5 @@ script: - if ! $GHCJS ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi - echo -en 'travis_fold:end:haddock\\r' -# REGENDATA ("0.9.20200121",["--config=cabal.haskell-ci","--output=.travis.yml","cabal.project"]) +# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","--output=.travis.yml","cabal.project"]) # EOF From bd2a813c1a1c7a83341c9d0e9cc2dd1007c0e1eb Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 17 Jul 2020 16:09:56 +0300 Subject: [PATCH 5/7] TEMP disable cookbook/testing --- .travis.yml | 13 ++----------- cabal.project | 2 +- 2 files changed, 3 insertions(+), 12 deletions(-) diff --git a/.travis.yml b/.travis.yml index 6ffea7d4..3a2cae4a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -136,7 +136,6 @@ install: if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/file-upload" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/generic" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/pagination" >> cabal.project ; fi - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/testing" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/structuring-apis" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/using-custom-monad" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/using-free-client" >> cabal.project ; fi @@ -176,8 +175,6 @@ install: - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-pagination' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-testing' >> cabal.project ; fi - - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-structuring-apis' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-using-custom-monad' >> cabal.project ; fi @@ -193,7 +190,7 @@ install: echo "allow-newer: servant-pagination-2.2.2:servant" >> cabal.project echo "allow-newer: servant-pagination-2.2.2:servant-server" >> cabal.project echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "servant/configure.ac" ]; then (cd "servant" && autoreconf -i); fi @@ -214,7 +211,6 @@ install: - if [ -f "doc/cookbook/file-upload/configure.ac" ]; then (cd "doc/cookbook/file-upload" && autoreconf -i); fi - if [ -f "doc/cookbook/generic/configure.ac" ]; then (cd "doc/cookbook/generic" && autoreconf -i); fi - if [ -f "doc/cookbook/pagination/configure.ac" ]; then (cd "doc/cookbook/pagination" && autoreconf -i); fi - - if [ -f "doc/cookbook/testing/configure.ac" ]; then (cd "doc/cookbook/testing" && autoreconf -i); fi - if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then (cd "doc/cookbook/structuring-apis" && autoreconf -i); fi - if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then (cd "doc/cookbook/using-custom-monad" && autoreconf -i); fi - if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then (cd "doc/cookbook/using-free-client" && autoreconf -i); fi @@ -251,7 +247,6 @@ script: - PKGDIR_cookbook_file_upload="$(find . -maxdepth 1 -type d -regex '.*/cookbook-file-upload-[0-9.]*')" - PKGDIR_cookbook_generic="$(find . -maxdepth 1 -type d -regex '.*/cookbook-generic-[0-9.]*')" - PKGDIR_cookbook_pagination="$(find . -maxdepth 1 -type d -regex '.*/cookbook-pagination-[0-9.]*')" - - PKGDIR_cookbook_testing="$(find . -maxdepth 1 -type d -regex '.*/cookbook-testing-[0-9.]*')" - PKGDIR_cookbook_structuring_apis="$(find . -maxdepth 1 -type d -regex '.*/cookbook-structuring-apis-[0-9.]*')" - PKGDIR_cookbook_using_custom_monad="$(find . -maxdepth 1 -type d -regex '.*/cookbook-using-custom-monad-[0-9.]*')" - PKGDIR_cookbook_using_free_client="$(find . -maxdepth 1 -type d -regex '.*/cookbook-using-free-client-[0-9.]*')" @@ -277,7 +272,6 @@ script: if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_file_upload}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_generic}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_pagination}" >> cabal.project ; fi - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_testing}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_structuring_apis}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_using_custom_monad}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_using_free_client}" >> cabal.project ; fi @@ -317,8 +311,6 @@ script: - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-pagination' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-testing' >> cabal.project ; fi - - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-structuring-apis' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-using-custom-monad' >> cabal.project ; fi @@ -334,7 +326,7 @@ script: echo "allow-newer: servant-pagination-2.2.2:servant" >> cabal.project echo "allow-newer: servant-pagination-2.2.2:servant-server" >> cabal.project echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - | @@ -358,7 +350,6 @@ script: cookbook-file-upload) echo ${PKGDIR_cookbook_file_upload} ;; cookbook-generic) echo ${PKGDIR_cookbook_generic} ;; cookbook-pagination) echo ${PKGDIR_cookbook_pagination} ;; - cookbook-testing) echo ${PKGDIR_cookbook_testing} ;; cookbook-structuring-apis) echo ${PKGDIR_cookbook_structuring_apis} ;; cookbook-using-custom-monad) echo ${PKGDIR_cookbook_using_custom_monad} ;; cookbook-using-free-client) echo ${PKGDIR_cookbook_using_free_client} ;; diff --git a/cabal.project b/cabal.project index 295938f1..72c28f93 100644 --- a/cabal.project +++ b/cabal.project @@ -32,7 +32,7 @@ packages: -- doc/cookbook/jwt-and-basic-auth/ doc/cookbook/pagination -- doc/cookbook/sentry - doc/cookbook/testing +-- doc/cookbook/testing doc/cookbook/structuring-apis doc/cookbook/using-custom-monad doc/cookbook/using-free-client From d94ad9df9bf8cea68a6a8e585801229dc5eac458 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 17 Jul 2020 17:06:13 +0300 Subject: [PATCH 6/7] Add cookbook entry for custom error formatters --- .travis.yml | 13 +- cabal.project | 1 + doc/cookbook/custom-errors/CustomErrors.lhs | 189 ++++++++++++++++++ .../custom-errors/custom-errors.cabal | 25 +++ doc/cookbook/index.rst | 1 + 5 files changed, 227 insertions(+), 2 deletions(-) create mode 100644 doc/cookbook/custom-errors/CustomErrors.lhs create mode 100644 doc/cookbook/custom-errors/custom-errors.cabal diff --git a/.travis.yml b/.travis.yml index 3a2cae4a..f4bcbd1f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -131,6 +131,7 @@ install: if ! $GHCJS ; then echo "packages: servant-pipes" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/basic-auth" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/curl-mock" >> cabal.project ; fi + if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/custom-errors" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/basic-streaming" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/db-postgres-pool" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/file-upload" >> cabal.project ; fi @@ -165,6 +166,8 @@ install: - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-curl-mock' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-custom-errors' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-basic-streaming' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-db-postgres-pool' >> cabal.project ; fi @@ -190,7 +193,7 @@ install: echo "allow-newer: servant-pagination-2.2.2:servant" >> cabal.project echo "allow-newer: servant-pagination-2.2.2:servant-server" >> cabal.project echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-custom-errors|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "servant/configure.ac" ]; then (cd "servant" && autoreconf -i); fi @@ -206,6 +209,7 @@ install: - if [ -f "servant-pipes/configure.ac" ]; then (cd "servant-pipes" && autoreconf -i); fi - if [ -f "doc/cookbook/basic-auth/configure.ac" ]; then (cd "doc/cookbook/basic-auth" && autoreconf -i); fi - if [ -f "doc/cookbook/curl-mock/configure.ac" ]; then (cd "doc/cookbook/curl-mock" && autoreconf -i); fi + - if [ -f "doc/cookbook/custom-errors/configure.ac" ]; then (cd "doc/cookbook/custom-errors" && autoreconf -i); fi - if [ -f "doc/cookbook/basic-streaming/configure.ac" ]; then (cd "doc/cookbook/basic-streaming" && autoreconf -i); fi - if [ -f "doc/cookbook/db-postgres-pool/configure.ac" ]; then (cd "doc/cookbook/db-postgres-pool" && autoreconf -i); fi - if [ -f "doc/cookbook/file-upload/configure.ac" ]; then (cd "doc/cookbook/file-upload" && autoreconf -i); fi @@ -242,6 +246,7 @@ script: - PKGDIR_servant_pipes="$(find . -maxdepth 1 -type d -regex '.*/servant-pipes-[0-9.]*')" - PKGDIR_cookbook_basic_auth="$(find . -maxdepth 1 -type d -regex '.*/cookbook-basic-auth-[0-9.]*')" - PKGDIR_cookbook_curl_mock="$(find . -maxdepth 1 -type d -regex '.*/cookbook-curl-mock-[0-9.]*')" + - PKGDIR_cookbook_custom_errors="$(find . -maxdepth 1 -type d -regex '.*/cookbook-custom-errors-[0-9.]*')" - PKGDIR_cookbook_basic_streaming="$(find . -maxdepth 1 -type d -regex '.*/cookbook-basic-streaming-[0-9.]*')" - PKGDIR_cookbook_db_postgres_pool="$(find . -maxdepth 1 -type d -regex '.*/cookbook-db-postgres-pool-[0-9.]*')" - PKGDIR_cookbook_file_upload="$(find . -maxdepth 1 -type d -regex '.*/cookbook-file-upload-[0-9.]*')" @@ -267,6 +272,7 @@ script: if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_pipes}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_basic_auth}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_curl_mock}" >> cabal.project ; fi + if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_custom_errors}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_basic_streaming}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_db_postgres_pool}" >> cabal.project ; fi if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_file_upload}" >> cabal.project ; fi @@ -301,6 +307,8 @@ script: - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-curl-mock' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-custom-errors' >> cabal.project ; fi + - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-basic-streaming' >> cabal.project ; fi - "if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo 'package cookbook-db-postgres-pool' >> cabal.project ; fi @@ -326,7 +334,7 @@ script: echo "allow-newer: servant-pagination-2.2.2:servant" >> cabal.project echo "allow-newer: servant-pagination-2.2.2:servant-server" >> cabal.project echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-custom-errors|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - | @@ -345,6 +353,7 @@ script: servant-pipes) echo ${PKGDIR_servant_pipes} ;; cookbook-basic-auth) echo ${PKGDIR_cookbook_basic_auth} ;; cookbook-curl-mock) echo ${PKGDIR_cookbook_curl_mock} ;; + cookbook-custom-errors) echo ${PKGDIR_cookbook_custom_errors} ;; cookbook-basic-streaming) echo ${PKGDIR_cookbook_basic_streaming} ;; cookbook-db-postgres-pool) echo ${PKGDIR_cookbook_db_postgres_pool} ;; cookbook-file-upload) echo ${PKGDIR_cookbook_file_upload} ;; diff --git a/cabal.project b/cabal.project index 72c28f93..fcc8c291 100644 --- a/cabal.project +++ b/cabal.project @@ -22,6 +22,7 @@ packages: packages: doc/cookbook/basic-auth doc/cookbook/curl-mock + doc/cookbook/custom-errors doc/cookbook/basic-streaming doc/cookbook/db-postgres-pool -- doc/cookbook/db-sqlite-simple diff --git a/doc/cookbook/custom-errors/CustomErrors.lhs b/doc/cookbook/custom-errors/CustomErrors.lhs new file mode 100644 index 00000000..4e8b773c --- /dev/null +++ b/doc/cookbook/custom-errors/CustomErrors.lhs @@ -0,0 +1,189 @@ +# Customizing errors from Servant + +Servant handles a lot of parsing and validation of the input request. When it can't parse something: query +parameters, URL parts or request body, it will return appropriate HTTP codes like 400 Bad Request. + +These responses will contain the error message in their body without any formatting. However, it is often +desirable to be able to provide custom formatting for these error messages, for example, to wrap them in JSON. + +Recently Servant got a way to add such formatting. This Cookbook chapter demonstrates how to use it. + +Extensions and imports: +```haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +import Data.Aeson +import Data.Proxy +import Data.Text +import GHC.Generics +import Network.Wai +import Network.Wai.Handler.Warp + +import Servant + +import Data.String.Conversions + (cs) +import Servant.API.ContentTypes +``` + +The API (from `greet.hs` example in Servant sources): + +```haskell +-- | A greet message data type +newtype Greet = Greet { _msg :: Text } + deriving (Generic, Show) + +instance FromJSON Greet +instance ToJSON Greet + +-- API specification +type TestApi = + -- GET /hello/:name?capital={true, false} returns a Greet as JSON + "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet + + -- POST /greet with a Greet as JSON in the request body, + -- returns a Greet as JSON + :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet + + -- DELETE /greet/:greetid + :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent + +testApi :: Proxy TestApi +testApi = Proxy + +-- Server-side handlers. +-- +-- There's one handler per endpoint, which, just like in the type +-- that represents the API, are glued together using :<|>. +-- +-- Each handler runs in the 'Handler' monad. +server :: Server TestApi +server = helloH :<|> postGreetH :<|> deleteGreetH + + where helloH name Nothing = helloH name (Just False) + helloH name (Just False) = return . Greet $ "Hello, " <> name + helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name + + postGreetH greet = return greet + + deleteGreetH _ = return NoContent +``` + +## Error formatters + +`servant-server` provides an `ErrorFormatter` type to specify how the error message will be +formatted. A formatter is just a function accepting three parameters: + +- `TypeRep` from `Data.Typeable`: this is a runtime representation of the type of the combinator + (like `Capture` or `ReqBody`) that generated the error. It can be used to display its name (with + `show`) or even dynamically dispatch on the combinator type. See the docs for `Data.Typeable` and + `Type.Reflection` modules. +- `Request`: full information for the request that led to the error. +- `String`: specific error message from the combinator. + +The formatter is expected to produce a `ServerError` which will be returned from the handler. + +Additionally, there is `NotFoundErrorFormatter`, which accepts only `Request` and can customize the +error in case when no route can be matched (HTTP 404). + +Let's make two formatters. First one will wrap our error in a JSON: + +```json +{ + "error": "ERROR MESSAGE", + "combinator": "NAME OF THE COMBINATOR" +} +``` + +Additionally, this formatter will examine the `Accept` header of the request and generate JSON +message only if client can accept it. + +```haskell +customFormatter :: ErrorFormatter +customFormatter tr req err = + let + -- aeson Value which will be sent to the client + value = object ["combinator" .= show tr, "error" .= err] + -- Accept header of the request + accH = getAcceptHeader req + in + -- handleAcceptH is Servant's function that checks whether the client can accept a + -- certain message type. + -- In this case we call it with "Proxy '[JSON]" argument, meaning that we want to return a JSON. + case handleAcceptH (Proxy :: Proxy '[JSON]) accH value of + -- If client can't handle JSON, we just return the body the old way + Nothing -> err400 { errBody = cs err } + -- Otherwise, we return the JSON formatted body and set the "Content-Type" header. + Just (ctypeH, body) -> err400 + { errBody = body + , errHeaders = [("Content-Type", cs ctypeH)] + } + +notFoundFormatter :: NotFoundErrorFormatter +notFoundFormatter req = + err404 { errBody = cs $ "Not found path: " <> rawPathInfo req } +``` + +If you don't need to react to the `Accept` header, you can just unconditionally return the JSON like +this (with `encode` from `Data.Aeson`): + +``` +err400 + { errBody = encode body + , errHeaders = [("Content-Type", "application/json")] + } +``` + +## Passing formatters to Servant + +Servant uses the Context to configure formatters. You only need to add a value of type +`ErrorFormatters` to your context. This is a record with the following fields: + +- `bodyParserErrorFormatter :: ErrorFormatter` +- `urlParseErrorFormatter :: ErrorFormatter` +- `headerParseErrorFormatter :: ErrorFormatter` +- `notFoundErrorFormatter :: NotFoundErrorFormatter` + +Default formatters are exported as `defaultErrorFormatters`, so you can use record update syntax to +set the only ones you need: + +```haskell +customFormatters :: ErrorFormatters +customFormatters = defaultErrorFormatters + { bodyParserErrorFormatter = customFormatter + , notFoundErrorFormatter = notFoundFormatter + } +``` + +And at last, use `serveWithContext` to run your server as usual: + +```haskell +app :: Application +app = serveWithContext testApi (customFormatters :. EmptyContext) server + +main :: IO () +main = run 8000 app +``` + +Now if we try to request something with a wrong body, we will get a nice error: + +``` +$ http -j POST localhost:8000/greet 'foo=bar' +HTTP/1.1 400 Bad Request +Content-Type: application/json;charset=utf-8 +Date: Fri, 17 Jul 2020 13:34:18 GMT +Server: Warp/3.3.12 +Transfer-Encoding: chunked + +{ + "combinator": "ReqBody'", + "error": "Error in $: parsing Main.Greet(Greet) failed, key \"_msg\" not found" +} +``` + +Notice the `Content-Type` header set by our combinator. diff --git a/doc/cookbook/custom-errors/custom-errors.cabal b/doc/cookbook/custom-errors/custom-errors.cabal new file mode 100644 index 00000000..1190c1a6 --- /dev/null +++ b/doc/cookbook/custom-errors/custom-errors.cabal @@ -0,0 +1,25 @@ +name: cookbook-custom-errors +version: 0.1 +synopsis: Return custom error messages from combinators +homepage: http://docs.servant.dev +license: BSD3 +license-file: ../../../servant/LICENSE +author: Servant Contributors +maintainer: haskell-servant-maintainers@googlegroups.com +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 + +executable cookbook-custom-errors + main-is: CustomErrors.lhs + build-depends: base == 4.* + , aeson + , servant + , servant-server + , string-conversions + , text + , wai + , warp + default-language: Haskell2010 + ghc-options: -Wall -pgmL markdown-unlit + build-tool-depends: markdown-unlit:markdown-unlit diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst index ac0ed5cf..acd9efe3 100644 --- a/doc/cookbook/index.rst +++ b/doc/cookbook/index.rst @@ -25,6 +25,7 @@ you name it! db-postgres-pool/PostgresPool.lhs using-custom-monad/UsingCustomMonad.lhs using-free-client/UsingFreeClient.lhs + custom-errors/CustomErrors.lhs basic-auth/BasicAuth.lhs basic-streaming/Streaming.lhs jwt-and-basic-auth/JWTAndBasicAuth.lhs From cb0224d06396731955f8c0c81d298d378079e6fc Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 17 Jul 2020 17:17:45 +0300 Subject: [PATCH 7/7] Add 8.10.1 to tested-with, haskell-ci regenerate --- .travis.yml | 3 +++ doc/cookbook/basic-auth/basic-auth.cabal | 2 +- doc/cookbook/basic-streaming/basic-streaming.cabal | 2 +- doc/cookbook/curl-mock/curl-mock.cabal | 2 +- doc/cookbook/custom-errors/custom-errors.cabal | 2 +- doc/cookbook/db-postgres-pool/db-postgres-pool.cabal | 2 +- doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal | 2 +- doc/cookbook/file-upload/file-upload.cabal | 2 +- doc/cookbook/generic/generic.cabal | 2 +- .../hoist-server-with-context/hoist-server-with-context.cabal | 2 +- doc/cookbook/https/https.cabal | 2 +- doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal | 2 +- doc/cookbook/pagination/pagination.cabal | 2 +- doc/cookbook/sentry/sentry.cabal | 2 +- doc/cookbook/structuring-apis/structuring-apis.cabal | 2 +- doc/cookbook/testing/testing.cabal | 2 +- doc/cookbook/using-custom-monad/using-custom-monad.cabal | 2 +- doc/cookbook/using-free-client/using-free-client.cabal | 2 +- doc/tutorial/tutorial.cabal | 2 +- servant-client-core/servant-client-core.cabal | 1 + servant-client/servant-client.cabal | 1 + servant-conduit/servant-conduit.cabal | 1 + servant-docs/servant-docs.cabal | 1 + servant-foreign/servant-foreign.cabal | 1 + servant-http-streams/servant-http-streams.cabal | 1 + servant-machines/servant-machines.cabal | 1 + servant-pipes/servant-pipes.cabal | 1 + servant-server/servant-server.cabal | 1 + servant/servant.cabal | 1 + 29 files changed, 31 insertions(+), 18 deletions(-) diff --git a/.travis.yml b/.travis.yml index f4bcbd1f..0944531f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -41,6 +41,9 @@ jobs: - compiler: ghcjs-8.4 addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"},{"sourceline":"deb http://ppa.launchpad.net/hvr/ghcjs/ubuntu bionic main"},{"sourceline":"deb https://deb.nodesource.com/node_10.x bionic main","key_url":"https://deb.nodesource.com/gpgkey/nodesource.gpg.key"}],"packages":["ghcjs-8.4","cabal-install-3.0","ghc-8.4.4","nodejs"]}} os: linux + - compiler: ghc-8.10.1 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.8.3 addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}} os: linux diff --git a/doc/cookbook/basic-auth/basic-auth.cabal b/doc/cookbook/basic-auth/basic-auth.cabal index 4b3a2feb..d3f41059 100644 --- a/doc/cookbook/basic-auth/basic-auth.cabal +++ b/doc/cookbook/basic-auth/basic-auth.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-basic-auth main-is: BasicAuth.lhs diff --git a/doc/cookbook/basic-streaming/basic-streaming.cabal b/doc/cookbook/basic-streaming/basic-streaming.cabal index 0f8858b3..bfbf5331 100644 --- a/doc/cookbook/basic-streaming/basic-streaming.cabal +++ b/doc/cookbook/basic-streaming/basic-streaming.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-basic-streaming main-is: Streaming.lhs diff --git a/doc/cookbook/curl-mock/curl-mock.cabal b/doc/cookbook/curl-mock/curl-mock.cabal index 91918f38..c0322413 100644 --- a/doc/cookbook/curl-mock/curl-mock.cabal +++ b/doc/cookbook/curl-mock/curl-mock.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbock-curl-mock main-is: CurlMock.lhs diff --git a/doc/cookbook/custom-errors/custom-errors.cabal b/doc/cookbook/custom-errors/custom-errors.cabal index 1190c1a6..d43b5102 100644 --- a/doc/cookbook/custom-errors/custom-errors.cabal +++ b/doc/cookbook/custom-errors/custom-errors.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-custom-errors main-is: CustomErrors.lhs diff --git a/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal b/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal index a4cb25a9..8d0a6eb0 100644 --- a/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal +++ b/doc/cookbook/db-postgres-pool/db-postgres-pool.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-db-postgres-pool main-is: PostgresPool.lhs diff --git a/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal b/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal index 06710b40..e8e1588f 100644 --- a/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal +++ b/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-db-sqlite-simple main-is: DBConnection.lhs diff --git a/doc/cookbook/file-upload/file-upload.cabal b/doc/cookbook/file-upload/file-upload.cabal index 72a511c3..d589912c 100644 --- a/doc/cookbook/file-upload/file-upload.cabal +++ b/doc/cookbook/file-upload/file-upload.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-file-upload main-is: FileUpload.lhs diff --git a/doc/cookbook/generic/generic.cabal b/doc/cookbook/generic/generic.cabal index 73188fc6..5081a981 100644 --- a/doc/cookbook/generic/generic.cabal +++ b/doc/cookbook/generic/generic.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-using-custom-monad main-is: Generic.lhs diff --git a/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal b/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal index 54991be1..06bdc5c8 100644 --- a/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal +++ b/doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal @@ -11,7 +11,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-hoist-server-with-context main-is: HoistServerWithContext.lhs diff --git a/doc/cookbook/https/https.cabal b/doc/cookbook/https/https.cabal index c1cec643..ec778b1b 100644 --- a/doc/cookbook/https/https.cabal +++ b/doc/cookbook/https/https.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-https main-is: Https.lhs diff --git a/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal b/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal index aa0cb728..dcbb95ba 100644 --- a/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal +++ b/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal @@ -11,7 +11,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-jwt-and-basic-auth main-is: JWTAndBasicAuth.lhs diff --git a/doc/cookbook/pagination/pagination.cabal b/doc/cookbook/pagination/pagination.cabal index 0c20e0d2..2e021dc0 100644 --- a/doc/cookbook/pagination/pagination.cabal +++ b/doc/cookbook/pagination/pagination.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-pagination main-is: Pagination.lhs diff --git a/doc/cookbook/sentry/sentry.cabal b/doc/cookbook/sentry/sentry.cabal index 2ac54383..41750a45 100644 --- a/doc/cookbook/sentry/sentry.cabal +++ b/doc/cookbook/sentry/sentry.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-sentry main-is: Sentry.lhs diff --git a/doc/cookbook/structuring-apis/structuring-apis.cabal b/doc/cookbook/structuring-apis/structuring-apis.cabal index 6355d507..431950f1 100644 --- a/doc/cookbook/structuring-apis/structuring-apis.cabal +++ b/doc/cookbook/structuring-apis/structuring-apis.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-structuring-apis main-is: StructuringApis.lhs diff --git a/doc/cookbook/testing/testing.cabal b/doc/cookbook/testing/testing.cabal index 9e13ce60..b69aeae1 100644 --- a/doc/cookbook/testing/testing.cabal +++ b/doc/cookbook/testing/testing.cabal @@ -10,7 +10,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com category: Servant build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-testing main-is: Testing.lhs diff --git a/doc/cookbook/using-custom-monad/using-custom-monad.cabal b/doc/cookbook/using-custom-monad/using-custom-monad.cabal index 244ab5ed..022a1ad8 100644 --- a/doc/cookbook/using-custom-monad/using-custom-monad.cabal +++ b/doc/cookbook/using-custom-monad/using-custom-monad.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-using-custom-monad main-is: UsingCustomMonad.lhs diff --git a/doc/cookbook/using-free-client/using-free-client.cabal b/doc/cookbook/using-free-client/using-free-client.cabal index e079cd7c..51ac1fc0 100644 --- a/doc/cookbook/using-free-client/using-free-client.cabal +++ b/doc/cookbook/using-free-client/using-free-client.cabal @@ -8,7 +8,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com build-type: Simple cabal-version: >=1.10 -tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1 executable cookbook-using-free-client main-is: UsingFreeClient.lhs diff --git a/doc/tutorial/tutorial.cabal b/doc/tutorial/tutorial.cabal index dcbae743..82162ffd 100644 --- a/doc/tutorial/tutorial.cabal +++ b/doc/tutorial/tutorial.cabal @@ -17,7 +17,7 @@ tested-with: GHC==8.2.2 GHC==8.4.4 GHC==8.6.5 - GHC==8.8.3 + GHC==8.8.3, GHC ==8.10.1 extra-source-files: static/index.html static/ui.js diff --git a/servant-client-core/servant-client-core.cabal b/servant-client-core/servant-client-core.cabal index 0d123e61..1d1618ce 100644 --- a/servant-client-core/servant-client-core.cabal +++ b/servant-client-core/servant-client-core.cabal @@ -22,6 +22,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 , GHCJS == 8.4 extra-source-files: diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 28003268..20c7e522 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -26,6 +26,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-conduit/servant-conduit.cabal b/servant-conduit/servant-conduit.cabal index 829873b6..d6bdf0a0 100644 --- a/servant-conduit/servant-conduit.cabal +++ b/servant-conduit/servant-conduit.cabal @@ -23,6 +23,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index 0697b20d..c061cc8e 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -25,6 +25,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index 640b6994..a0531c38 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/servant-foreign/servant-foreign.cabal @@ -27,6 +27,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-http-streams/servant-http-streams.cabal b/servant-http-streams/servant-http-streams.cabal index 8d49ef18..041919e2 100644 --- a/servant-http-streams/servant-http-streams.cabal +++ b/servant-http-streams/servant-http-streams.cabal @@ -26,6 +26,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-machines/servant-machines.cabal b/servant-machines/servant-machines.cabal index 5b376429..a4103947 100644 --- a/servant-machines/servant-machines.cabal +++ b/servant-machines/servant-machines.cabal @@ -23,6 +23,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-pipes/servant-pipes.cabal b/servant-pipes/servant-pipes.cabal index 16ba7c72..d0c82340 100644 --- a/servant-pipes/servant-pipes.cabal +++ b/servant-pipes/servant-pipes.cabal @@ -23,6 +23,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 06708d72..c0a42da4 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -30,6 +30,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 extra-source-files: CHANGELOG.md diff --git a/servant/servant.cabal b/servant/servant.cabal index 20dbc931..c2f5c090 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -26,6 +26,7 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.3 + || ==8.10.1 , GHCJS == 8.4 extra-source-files: