Update request content-type handling

In case that a sub-server doesn't support the content-type specified
in the request invoke `delayedFail` instead of `delayedFailFatal` in
order to give the chance to other sub-servers to handle the request.
This commit is contained in:
Giovanni Cappellotto 2018-04-04 18:53:40 -04:00
parent 3750f22e01
commit 92f8d2314e
2 changed files with 12 additions and 3 deletions

View File

@ -603,7 +603,7 @@ instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods
let contentTypeH = fromMaybe "application/octet-stream"
$ lookup hContentType $ requestHeaders request
case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of
Nothing -> delayedFailFatal err415
Nothing -> delayedFail err415
Just f -> return f
-- Body check, we get a body parsing functions as the first argument.

View File

@ -247,6 +247,8 @@ type ErrorChoiceApi
:<|> "path3" :> ReqBody '[JSON] Int :> Post '[PlainText] Int -- 3
:<|> "path4" :> (ReqBody '[PlainText] Int :> Post '[PlainText] Int -- 4
:<|> ReqBody '[PlainText] Int :> Post '[JSON] Int) -- 5
:<|> "path5" :> (ReqBody '[JSON] Int :> Post '[PlainText] Int -- 6
:<|> ReqBody '[PlainText] Int :> Post '[PlainText] Int) -- 7
errorChoiceApi :: Proxy ErrorChoiceApi
errorChoiceApi = Proxy
@ -256,8 +258,8 @@ errorChoiceServer = return 0
:<|> return 1
:<|> return 2
:<|> (\_ -> return 3)
:<|> (\_ -> return 4)
:<|> (\_ -> return 5)
:<|> ((\_ -> return 4) :<|> (\_ -> return 5))
:<|> ((\_ -> return 6) :<|> (\_ -> return 7))
errorChoiceSpec :: Spec
@ -278,6 +280,13 @@ errorChoiceSpec = describe "Multiple handlers return errors"
request methodPost "path4" [(hContentType, "text/plain;charset=utf-8"),
(hAccept, "blah")] "5"
`shouldRespondWith` 406
it "should respond with 415 only if none of the subservers supports the request's content type" $ do
request methodPost "path5" [(hContentType, "text/plain;charset=utf-8")] "1"
`shouldRespondWith` 200
request methodPost "path5" [(hContentType, "application/json")] "1"
`shouldRespondWith` 200
request methodPost "path5" [(hContentType, "application/not-supported")] ""
`shouldRespondWith` 415
-- }}}