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:
parent
3750f22e01
commit
92f8d2314e
2 changed files with 12 additions and 3 deletions
|
@ -603,7 +603,7 @@ instance ( AllCTUnrender list a, HasServer api context, SBoolI (FoldLenient mods
|
||||||
let contentTypeH = fromMaybe "application/octet-stream"
|
let contentTypeH = fromMaybe "application/octet-stream"
|
||||||
$ lookup hContentType $ requestHeaders request
|
$ lookup hContentType $ requestHeaders request
|
||||||
case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of
|
case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of
|
||||||
Nothing -> delayedFailFatal err415
|
Nothing -> delayedFail err415
|
||||||
Just f -> return f
|
Just f -> return f
|
||||||
|
|
||||||
-- Body check, we get a body parsing functions as the first argument.
|
-- Body check, we get a body parsing functions as the first argument.
|
||||||
|
|
|
@ -247,6 +247,8 @@ type ErrorChoiceApi
|
||||||
:<|> "path3" :> ReqBody '[JSON] Int :> Post '[PlainText] Int -- 3
|
:<|> "path3" :> ReqBody '[JSON] Int :> Post '[PlainText] Int -- 3
|
||||||
:<|> "path4" :> (ReqBody '[PlainText] Int :> Post '[PlainText] Int -- 4
|
:<|> "path4" :> (ReqBody '[PlainText] Int :> Post '[PlainText] Int -- 4
|
||||||
:<|> ReqBody '[PlainText] Int :> Post '[JSON] Int) -- 5
|
:<|> 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 ErrorChoiceApi
|
||||||
errorChoiceApi = Proxy
|
errorChoiceApi = Proxy
|
||||||
|
@ -256,8 +258,8 @@ errorChoiceServer = return 0
|
||||||
:<|> return 1
|
:<|> return 1
|
||||||
:<|> return 2
|
:<|> return 2
|
||||||
:<|> (\_ -> return 3)
|
:<|> (\_ -> return 3)
|
||||||
:<|> (\_ -> return 4)
|
:<|> ((\_ -> return 4) :<|> (\_ -> return 5))
|
||||||
:<|> (\_ -> return 5)
|
:<|> ((\_ -> return 6) :<|> (\_ -> return 7))
|
||||||
|
|
||||||
|
|
||||||
errorChoiceSpec :: Spec
|
errorChoiceSpec :: Spec
|
||||||
|
@ -278,6 +280,13 @@ errorChoiceSpec = describe "Multiple handlers return errors"
|
||||||
request methodPost "path4" [(hContentType, "text/plain;charset=utf-8"),
|
request methodPost "path4" [(hContentType, "text/plain;charset=utf-8"),
|
||||||
(hAccept, "blah")] "5"
|
(hAccept, "blah")] "5"
|
||||||
`shouldRespondWith` 406
|
`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
|
||||||
|
|
||||||
|
|
||||||
-- }}}
|
-- }}}
|
||||||
|
|
Loading…
Reference in a new issue