@@ -132,14 +132,14 @@ toApplication ra request respond = ra request routingRespond
132132-- 405 (bad method)
133133-- 401 (unauthorized)
134134-- 415 (unsupported media type)
135−-- 400 (bad request)
136135-- 406 (not acceptable)
136+-- 400 (bad request)
137137-- @
138138--
139139-- Therefore, while routing, we delay most checks so that they
140140-- will ultimately occur in the right order.
141141--
142−-- A 'Delayed' contains four delayed blocks of tests, and
142+-- A 'Delayed' contains many delayed blocks of tests, and
143143-- the actual handler:
144144--
145145-- 1. Delayed captures. These can actually cause 404, and
@@ -148,24 +148,28 @@ toApplication ra request respond = ra request routingRespond
148148-- check order from the error reporting, see above). Delayed
149149-- captures can provide inputs to the actual handler.
150150--
151−-- 2. Query parameter checks. They require parsing and can cause 400 if the
152−-- parsing fails. Query parameter checks provide inputs to the handler
153−--
154−-- 3. Method check(s). This can cause a 405. On success,
151+-- 2. Method check(s). This can cause a 405. On success,
155152-- it does not provide an input for the handler. Method checks
156153-- are comparatively cheap.
157154--
158−-- 4. Body and accept header checks. The request body check can
159−-- cause both 400 and 415. This provides an input to the handler.
160−-- The accept header check can be performed as the final
161−-- computation in this block. It can cause a 406.
155+-- 3. Authentication checks. This can cause 401.
156+--
157+-- 4. Accept and content type header checks. These checks
158+-- can cause 415 and 406 errors.
159+--
160+-- 5. Query parameter checks. They require parsing and can cause 400 if the
161+-- parsing fails. Query parameter checks provide inputs to the handler
162+--
163+-- 6. Body check. The request body check can cause 400.
162164--
163165data Delayed env c where
164166 Delayed :: { capturesD :: env -> DelayedIO captures
165− , paramsD :: DelayedIO params
166167 , methodD :: DelayedIO ()
167168 , authD :: DelayedIO auth
168− , bodyD :: DelayedIO body
169+ , acceptD :: DelayedIO ()
170+ , contentD :: DelayedIO contentType
171+ , paramsD :: DelayedIO params
172+ , bodyD :: contentType -> DelayedIO body
169173 , serverD :: captures
170174 -> params
171175 -> auth
@@ -209,7 +213,7 @@ runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO'
209213-- | A 'Delayed' without any stored checks.
210214emptyDelayed :: RouteResult a -> Delayed env a
211215emptyDelayed result =
212− Delayed (const r) r r r r (\ _ _ _ _ _ -> result)
216+ Delayed (const r) r r r r r (const r) (\ _ _ _ _ _ -> result)
213217 where
214218 r = return ()
215219
@@ -270,20 +274,25 @@ addAuthCheck Delayed{..} new =
270274 , ..
271275 } -- Note [Existential Record Update]
272276
273−-- | Add a body check to the end of the body block.
277+-- | Add a content type and body checks around parameter checks.
278+--
279+-- We'll report failed content type check (415), before trying to parse
280+-- query parameters (400). Which, in turn, happens before request body parsing.
274281addBodyCheck :: Delayed env (a -> b)
275− -> DelayedIO a
282+ -> DelayedIO c -- ^ content type check
283+ -> (c -> DelayedIO a) -- ^ body check
276284 -> Delayed env b
277−addBodyCheck Delayed{..} new =
285+addBodyCheck Delayed{..} newContentD newBodyD =
278286 Delayed
279− { bodyD = (,) <$> bodyD <*> new
287+ { contentD = (,) <$> contentD <*> newContentD
288+ , bodyD = \(content, c) -> (,) <$> bodyD content <*> newBodyD c
280289 , serverD = \ c p a (z, v) req -> ($ v) <$> serverD c p a z req
281290 , ..
282291 } -- Note [Existential Record Update]
283292
284293
285−-- | Add an accept header check to the beginning of the body
286−-- block. There is a tradeoff here. In principle, we'd like
294+-- | Add an accept header check before handling parameters.
295+-- In principle, we'd like
287296-- to take a bad body (400) response take precedence over a
288297-- failed accept check (406). BUT to allow streaming the body,
289298-- we cannot run the body check and then still backtrack.
@@ -297,7 +306,7 @@ addAcceptCheck :: Delayed env a
297306 -> Delayed env a
298307addAcceptCheck Delayed{..} new =
299308 Delayed
300− { bodyD = new *> bodyD
309+ { acceptD = acceptD *> new
301310 , ..
302311 } -- Note [Existential Record Update]
303312
@@ -322,12 +331,14 @@ runDelayed :: Delayed env a
322331 -> Request
323332 -> ResourceT IO (RouteResult a)
324333runDelayed Delayed{..} env = runDelayedIO $ do
334+ r <- ask
325335 c <- capturesD env
326336 methodD
327337 a <- authD
328− b <- bodyD
329− r <- ask
330− p <- paramsD -- Has to be after body to respect the relative error order
338+ acceptD
339+ content <- contentD
340+ p <- paramsD -- Has to be before body parsing, but after content-type checks
341+ b <- bodyD content
331342 liftRouteResult (serverD c p a b r)
332343
333344-- | Runs a delayed server and the resulting action.