git.iko.soy/typeable/servant
on master help sign in
Merge pull request #461 from kosmikus/accept-check

Do the accept check before the body check.

commitd876031e7b002dcae2767f16ca3db425c5354b76 authorAndres Löh <ksgithub@andres-loeh.de> dateFri 15 Apr 2016, 11:20 (11 years ago) parentcaf0209a551eb6
5 files changed+57−13
compare with master
unifiedsplit
servant-server/CHANGELOG.md+4 servant-server/src/Servant/Server/Internal.hs+8−1 servant-server/src/Servant/Server/Internal/RoutingApplication.hs+11−5 servant-server/test/Servant/Server/ErrorSpec.hs+24−7 servant-server/test/Servant/ServerSpec.hs+10
servant-server/CHANGELOG.md+4
@@ -7,6 +7,10 @@
77 efficiently. Functions `layout` and `layoutWithContext` have been
88 added to visualize the router layout for debugging purposes. Test
99 cases for expected router layouts have been added.
10+* If an endpoint is discovered to have a non-matching "accept header",
11+ this is now a recoverable rather than a fatal failure, allowing
12+ different endpoints for the same route, but with different content
13+ types to be specified modularly.
1014* Export `throwError` from module `Servant`
1115* Add `Handler` type synonym
1216
servant-server/src/Servant/Server/Internal.hs+8−1
@@ -154,10 +154,17 @@ methodCheck method request
154154 | allowedMethod method request = return ()
155155 | otherwise = delayedFail err405
156156
157+-- This has switched between using 'Fail' and 'FailFatal' a number of
158+-- times. If the 'acceptCheck' is run after the body check (which would
159+-- be morally right), then we have to set this to 'FailFatal', because
160+-- the body check is not reversible, and therefore backtracking after the
161+-- body check is no longer an option. However, we now run the accept
162+-- check before the body check and can therefore afford to make it
163+-- recoverable.
157164acceptCheck :: (AllMime list) => Proxy list -> B.ByteString -> DelayedIO ()
158165acceptCheck proxy accH
159166 | canHandleAcceptH proxy (AcceptHeader accH) = return ()
160− | otherwise = delayedFailFatal err406
167+ | otherwise = delayedFail err406
161168
162169methodRouter :: (AllCTRender ctypes a)
163170 => Method -> Proxy ctypes -> Status
servant-server/src/Servant/Server/Internal/RoutingApplication.hs+11−5
@@ -203,16 +203,22 @@ addBodyCheck Delayed{..} new =
203203 } -- Note [Existential Record Update]
204204
205205
206−-- | Add an accept header check to the end of the body block.
207−-- The accept header check should occur after the body check,
208−-- but this will be the case, because the accept header check
209−-- is only scheduled by the method combinators.
206+-- | Add an accept header check to the beginning of the body
207+-- block. There is a tradeoff here. In principle, we'd like
208+-- to take a bad body (400) response take precedence over a
209+-- failed accept check (406). BUT to allow streaming the body,
210+-- we cannot run the body check and then still backtrack.
211+-- We therefore do the accept check before the body check,
212+-- when we can still backtrack. There are other solutions to
213+-- this, but they'd be more complicated (such as delaying the
214+-- body check further so that it can still be run in a situation
215+-- where we'd otherwise report 406).
210216addAcceptCheck :: Delayed env a
211217 -> DelayedIO ()
212218 -> Delayed env a
213219addAcceptCheck Delayed{..} new =
214220 Delayed
215− { bodyD = bodyD <* new
221+ { bodyD = new *> bodyD
216222 , ..
217223 } -- Note [Existential Record Update]
218224
servant-server/test/Servant/Server/ErrorSpec.hs+24−7
@@ -53,6 +53,23 @@ errorOrderApi = Proxy
5353errorOrderServer :: Server ErrorOrderApi
5454errorOrderServer = \_ _ _ -> throwE err402
5555
56+-- On error priorities:
57+--
58+-- We originally had
59+--
60+-- 404, 405, 401, 415, 400, 406, 402
61+--
62+-- but we changed this to
63+--
64+-- 404, 405, 401, 406, 415, 400, 402
65+--
66+-- for servant-0.7.
67+--
68+-- This change is due to the body check being irreversible (to support
69+-- streaming). Any check done after the body check has to be made fatal,
70+-- breaking modularity. We've therefore moved the accept check before
71+-- the body check, to allow it being recoverable and modular, and this
72+-- goes along with promoting the error priority of 406.
5673errorOrderSpec :: Spec
5774errorOrderSpec =
5875 describe "HTTP error order" $
@@ -86,18 +103,18 @@ errorOrderSpec =
86103 request goodMethod goodUrl [badAuth, badContentType, badAccept] badBody
87104 `shouldRespondWith` 401
88105
89− it "has 415 as its fourth highest priority error" $ do
106+ it "has 406 as its fourth highest priority error" $ do
90107 request goodMethod goodUrl [goodAuth, badContentType, badAccept] badBody
108+ `shouldRespondWith` 406
109+
110+ it "has 415 as its fifth highest priority error" $ do
111+ request goodMethod goodUrl [goodAuth, badContentType, goodAccept] badBody
91112 `shouldRespondWith` 415
92113
93− it "has 400 as its fifth highest priority error" $ do
94− request goodMethod goodUrl [goodAuth, goodContentType, badAccept] badBody
114+ it "has 400 as its sixth highest priority error" $ do
115+ request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] badBody
95116 `shouldRespondWith` 400
96117
97− it "has 406 as its sixth highest priority error" $ do
98− request goodMethod goodUrl [goodAuth, goodContentType, badAccept] goodBody
99− `shouldRespondWith` 406
100−
101118 it "has handler-level errors as last priority" $ do
102119 request goodMethod goodUrl [goodAuth, goodContentType, goodAccept] goodBody
103120 `shouldRespondWith` 402
servant-server/test/Servant/ServerSpec.hs+10
@@ -99,6 +99,9 @@ type VerbApi method status
9999 :<|> "noContent" :> Verb method status '[JSON] NoContent
100100 :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)
101101 :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)
102+ :<|> "accept" :> ( Verb method status '[JSON] Person
103+ :<|> Verb method status '[PlainText] String
104+ )
102105
103106verbSpec :: Spec
104107verbSpec = describe "Servant.API.Verb" $ do
@@ -107,6 +110,7 @@ verbSpec = describe "Servant.API.Verb" $ do
107110 :<|> return NoContent
108111 :<|> return (addHeader 5 alice)
109112 :<|> return (addHeader 10 NoContent)
113+ :<|> (return alice :<|> return "B")
110114 get200 = Proxy :: Proxy (VerbApi 'GET 200)
111115 post210 = Proxy :: Proxy (VerbApi 'POST 210)
112116 put203 = Proxy :: Proxy (VerbApi 'PUT 203)
@@ -161,6 +165,12 @@ verbSpec = describe "Servant.API.Verb" $ do
161165 [(hAccept, "application/json")] ""
162166 liftIO $ statusCode (simpleStatus response) `shouldBe` status
163167
168+ unless (status `elem` [214, 215] || method == methodHead) $
169+ it "allows modular specification of supported content types" $ do
170+ response <- THW.request method "/accept" [(hAccept, "text/plain")] ""
171+ liftIO $ statusCode (simpleStatus response) `shouldBe` status
172+ liftIO $ simpleBody response `shouldBe` "B"
173+
164174 it "sets the Content-Type header" $ do
165175 response <- THW.request method "" [] ""
166176 liftIO $ simpleHeaders response `shouldContain`