Merge pull request #937 from potomak/subserver-content-types

Update request content-type handling
This commit is contained in:
Oleg Grenrus 2018-04-05 16:00:02 +03:00 committed by GitHub
commit a8cd6e3895
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
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" 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.

View file

@ -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
-- }}} -- }}}