Merge pull request #461 from kosmikus/accept-check

Do the accept check before the body check.
This commit is contained in:
Andres Löh 2016-04-15 11:20:13 +02:00
commit d876031e7b
5 changed files with 57 additions and 13 deletions

View file

@ -7,6 +7,10 @@
efficiently. Functions `layout` and `layoutWithContext` have been efficiently. Functions `layout` and `layoutWithContext` have been
added to visualize the router layout for debugging purposes. Test added to visualize the router layout for debugging purposes. Test
cases for expected router layouts have been added. cases for expected router layouts have been added.
* If an endpoint is discovered to have a non-matching "accept header",
this is now a recoverable rather than a fatal failure, allowing
different endpoints for the same route, but with different content
types to be specified modularly.
* Export `throwError` from module `Servant` * Export `throwError` from module `Servant`
* Add `Handler` type synonym * Add `Handler` type synonym

View file

@ -154,10 +154,17 @@ methodCheck method request
| allowedMethod method request = return () | allowedMethod method request = return ()
| otherwise = delayedFail err405 | otherwise = delayedFail err405
-- This has switched between using 'Fail' and 'FailFatal' a number of
-- times. If the 'acceptCheck' is run after the body check (which would
-- be morally right), then we have to set this to 'FailFatal', because
-- the body check is not reversible, and therefore backtracking after the
-- 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 -> B.ByteString -> DelayedIO ()
acceptCheck proxy accH acceptCheck proxy accH
| canHandleAcceptH proxy (AcceptHeader accH) = return () | canHandleAcceptH proxy (AcceptHeader accH) = return ()
| otherwise = delayedFailFatal err406 | otherwise = delayedFail err406
methodRouter :: (AllCTRender ctypes a) methodRouter :: (AllCTRender ctypes a)
=> Method -> Proxy ctypes -> Status => Method -> Proxy ctypes -> Status

View file

@ -203,16 +203,22 @@ addBodyCheck Delayed{..} new =
} -- Note [Existential Record Update] } -- Note [Existential Record Update]
-- | Add an accept header check to the end of the body block. -- | Add an accept header check to the beginning of the body
-- The accept header check should occur after the body check, -- block. There is a tradeoff here. In principle, we'd like
-- but this will be the case, because the accept header check -- to take a bad body (400) response take precedence over a
-- is only scheduled by the method combinators. -- failed accept check (406). BUT to allow streaming the body,
-- we cannot run the body check and then still backtrack.
-- We therefore do the accept check before the body check,
-- when we can still backtrack. There are other solutions to
-- this, but they'd be more complicated (such as delaying the
-- body check further so that it can still be run in a situation
-- where we'd otherwise report 406).
addAcceptCheck :: Delayed env a addAcceptCheck :: Delayed env a
-> DelayedIO () -> DelayedIO ()
-> Delayed env a -> Delayed env a
addAcceptCheck Delayed{..} new = addAcceptCheck Delayed{..} new =
Delayed Delayed
{ bodyD = bodyD <* new { bodyD = new *> bodyD
, .. , ..
} -- Note [Existential Record Update] } -- Note [Existential Record Update]

View file

@ -53,6 +53,23 @@ errorOrderApi = Proxy
errorOrderServer :: Server ErrorOrderApi errorOrderServer :: Server ErrorOrderApi
errorOrderServer = \_ _ _ -> throwE err402 errorOrderServer = \_ _ _ -> throwE err402
-- On error priorities:
--
-- We originally had
--
-- 404, 405, 401, 415, 400, 406, 402
--
-- but we changed this to
--
-- 404, 405, 401, 406, 415, 400, 402
--
-- for servant-0.7.
--
-- This change is due to the body check being irreversible (to support
-- streaming). Any check done after the body check has to be made fatal,
-- breaking modularity. We've therefore moved the accept check before
-- the body check, to allow it being recoverable and modular, and this
-- goes along with promoting the error priority of 406.
errorOrderSpec :: Spec errorOrderSpec :: Spec
errorOrderSpec = errorOrderSpec =
describe "HTTP error order" $ describe "HTTP error order" $
@ -86,18 +103,18 @@ errorOrderSpec =
request goodMethod goodUrl [badAuth, badContentType, badAccept] badBody request goodMethod goodUrl [badAuth, badContentType, badAccept] badBody
`shouldRespondWith` 401 `shouldRespondWith` 401
it "has 415 as its fourth highest priority error" $ do it "has 406 as its fourth highest priority error" $ do
request goodMethod goodUrl [goodAuth, badContentType, badAccept] badBody request goodMethod goodUrl [goodAuth, badContentType, badAccept] badBody
`shouldRespondWith` 406
it "has 415 as its fifth highest priority error" $ do
request goodMethod goodUrl [goodAuth, badContentType, goodAccept] badBody
`shouldRespondWith` 415 `shouldRespondWith` 415
it "has 400 as its fifth highest priority error" $ do it "has 400 as its sixth highest priority error" $ do
request goodMethod goodUrl [goodAuth, goodContentType, badAccept] badBody request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] badBody
`shouldRespondWith` 400 `shouldRespondWith` 400
it "has 406 as its sixth highest priority error" $ do
request goodMethod goodUrl [goodAuth, goodContentType, badAccept] goodBody
`shouldRespondWith` 406
it "has handler-level errors as last priority" $ do it "has handler-level errors as last priority" $ do
request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] goodBody request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] goodBody
`shouldRespondWith` 402 `shouldRespondWith` 402

View file

@ -99,6 +99,9 @@ type VerbApi method status
:<|> "noContent" :> Verb method status '[JSON] NoContent :<|> "noContent" :> Verb method status '[JSON] NoContent
:<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person) :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)
:<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent) :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)
:<|> "accept" :> ( Verb method status '[JSON] Person
:<|> Verb method status '[PlainText] String
)
verbSpec :: Spec verbSpec :: Spec
verbSpec = describe "Servant.API.Verb" $ do verbSpec = describe "Servant.API.Verb" $ do
@ -107,6 +110,7 @@ verbSpec = describe "Servant.API.Verb" $ do
:<|> return NoContent :<|> return NoContent
:<|> return (addHeader 5 alice) :<|> return (addHeader 5 alice)
:<|> return (addHeader 10 NoContent) :<|> return (addHeader 10 NoContent)
:<|> (return alice :<|> return "B")
get200 = Proxy :: Proxy (VerbApi 'GET 200) get200 = Proxy :: Proxy (VerbApi 'GET 200)
post210 = Proxy :: Proxy (VerbApi 'POST 210) post210 = Proxy :: Proxy (VerbApi 'POST 210)
put203 = Proxy :: Proxy (VerbApi 'PUT 203) put203 = Proxy :: Proxy (VerbApi 'PUT 203)
@ -161,6 +165,12 @@ verbSpec = describe "Servant.API.Verb" $ do
[(hAccept, "application/json")] "" [(hAccept, "application/json")] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status liftIO $ statusCode (simpleStatus response) `shouldBe` status
unless (status `elem` [214, 215] || method == methodHead) $
it "allows modular specification of supported content types" $ do
response <- THW.request method "/accept" [(hAccept, "text/plain")] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status
liftIO $ simpleBody response `shouldBe` "B"
it "sets the Content-Type header" $ do it "sets the Content-Type header" $ do
response <- THW.request method "" [] "" response <- THW.request method "" [] ""
liftIO $ simpleHeaders response `shouldContain` liftIO $ simpleHeaders response `shouldContain`