@@ -15,6 +15,8 @@ import qualified Data.ByteString.Lazy.Char8 as BCL
1515import Data.Monoid
1616 ((<>))
1717import Data.Proxy
18+import Data.String.Conversions
19+ (cs)
1820import Network.HTTP.Types
1921 (hAccept, hAuthorization, hContentType, methodGet, methodPost,
2022 methodPut)
@@ -31,6 +33,7 @@ spec = describe "HTTP Errors" $ do
3133 prioErrorsSpec
3234 errorRetrySpec
3335 errorChoiceSpec
36+ customFormattersSpec
3437
3538-- * Auth machinery (reused throughout)
3639
@@ -293,6 +296,61 @@ errorChoiceSpec = describe "Multiple handlers return errors"
293296 `shouldRespondWith` 415
294297
295298
299+-- }}}
300+------------------------------------------------------------------------------
301+-- * Custom errors {{{
302+
303+customFormatter :: ErrorFormatter
304+customFormatter _ _ err = err400 { errBody = "CUSTOM! " <> cs err }
305+
306+customFormatters :: ErrorFormatters
307+customFormatters = defaultErrorFormatters
308+ { bodyParserErrorFormatter = customFormatter
309+ , urlParseErrorFormatter = customFormatter
310+ , notFoundErrorFormatter = const $ err404 { errBody = "CUSTOM! Not Found" }
311+ }
312+
313+type CustomFormatterAPI
314+ = "query" :> QueryParam' '[Required, Strict] "param" Int :> Get '[PlainText] String
315+ :<|> "capture" :> Capture "cap" Bool :> Get '[PlainText] String
316+ :<|> "body" :> ReqBody '[JSON] Int :> Post '[PlainText] String
317+
318+customFormatterAPI :: Proxy CustomFormatterAPI
319+customFormatterAPI = Proxy
320+
321+customFormatterServer :: Server CustomFormatterAPI
322+customFormatterServer = (\_ -> return "query")
323+ :<|> (\_ -> return "capture")
324+ :<|> (\_ -> return "body")
325+
326+customFormattersSpec :: Spec
327+customFormattersSpec = describe "Custom errors from combinators"
328+ $ with (return $ serveWithContext customFormatterAPI (customFormatters :. EmptyContext) customFormatterServer) $ do
329+
330+ let startsWithCustom = ResponseMatcher
331+ { matchStatus = 400
332+ , matchHeaders = []
333+ , matchBody = MatchBody $ \_ body -> if "CUSTOM!" `BCL.isPrefixOf` body
334+ then Nothing
335+ else Just $ show body <> " does not start with \"CUSTOM!\""
336+ }
337+
338+ it "formats query parse error" $ do
339+ request methodGet "query?param=false" [] ""
340+ `shouldRespondWith` startsWithCustom
341+
342+ it "formats query parse error with missing param" $ do
343+ request methodGet "query" [] ""
344+ `shouldRespondWith` startsWithCustom
345+
346+ it "formats capture parse error" $ do
347+ request methodGet "capture/42" [] ""
348+ `shouldRespondWith` startsWithCustom
349+
350+ it "formats body parse error" $ do
351+ request methodPost "body" [(hContentType, "application/json")] "foo"
352+ `shouldRespondWith` startsWithCustom
353+
296354-- }}}
297355------------------------------------------------------------------------------
298356-- * Instances {{{