@@ -139,7 +139,7 @@ toApplication ra request respond = ra request routingRespond
139-- Therefore, while routing, we delay most checks so that they
139-- Therefore, while routing, we delay most checks so that they
140-- will ultimately occur in the right order.
140-- will ultimately occur in the right order.
142−-- A 'Delayed' contains three delayed blocks of tests, and
142+-- A 'Delayed' contains four delayed blocks of tests, and
143-- the actual handler:
143-- the actual handler:
145-- 1. Delayed captures. These can actually cause 404, and
145-- 1. Delayed captures. These can actually cause 404, and
@@ -148,27 +148,36 @@ toApplication ra request respond = ra request routingRespond
148-- check order from the error reporting, see above). Delayed
148-- check order from the error reporting, see above). Delayed
149-- captures can provide inputs to the actual handler.
149-- captures can provide inputs to the actual handler.
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
151−-- 2. Method check(s). This can cause a 405. On success,
154+-- 3. Method check(s). This can cause a 405. On success,
152-- it does not provide an input for the handler. Method checks
155-- it does not provide an input for the handler. Method checks
153-- are comparatively cheap.
156-- are comparatively cheap.
155−-- 3. Body and accept header checks. The request body check can
158+-- 4. Body and accept header checks. The request body check can
156-- cause both 400 and 415. This provides an input to the handler.
159-- cause both 400 and 415. This provides an input to the handler.
157-- The accept header check can be performed as the final
160-- The accept header check can be performed as the final
158-- computation in this block. It can cause a 406.
161-- computation in this block. It can cause a 406.
160data Delayed env c where
163data Delayed env c where
161 Delayed :: { capturesD :: env -> DelayedIO captures
164 Delayed :: { capturesD :: env -> DelayedIO captures
165+ , paramsD :: DelayedIO params
162 , methodD :: DelayedIO ()
166 , methodD :: DelayedIO ()
163 , authD :: DelayedIO auth
167 , authD :: DelayedIO auth
164 , bodyD :: DelayedIO body
168 , bodyD :: DelayedIO body
165− , serverD :: captures -> auth -> body -> Request -> RouteResult c
169+ , serverD :: captures
166 } -> Delayed env c
175 } -> Delayed env c
168instance Functor (Delayed env) where
177instance Functor (Delayed env) where
169 fmap f Delayed{..} =
178 fmap f Delayed{..} =
171− { serverD = \ c a b req -> f <$> serverD c a b req
180+ { serverD = \ c p a b req -> f <$> serverD c p a b req
173 } -- Note [Existential Record Update]
182 } -- Note [Existential Record Update]
@@ -200,7 +209,7 @@ runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO'
200-- | A 'Delayed' without any stored checks.
209-- | A 'Delayed' without any stored checks.
201emptyDelayed :: RouteResult a -> Delayed env a
210emptyDelayed :: RouteResult a -> Delayed env a
202emptyDelayed result =
211emptyDelayed result =
203− Delayed (const r) r r r (\ _ _ _ _ -> result)
212+ Delayed (const r) r r r r (\ _ _ _ _ _ -> result)
205 r = return ()
214 r = return ()
@@ -225,10 +234,21 @@ addCapture :: Delayed env (a -> b)
225addCapture Delayed{..} new =
234addCapture Delayed{..} new =
227 { capturesD = \ (txt, env) -> (,) <$> capturesD env <*> new txt
236 { capturesD = \ (txt, env) -> (,) <$> capturesD env <*> new txt
228− , serverD = \ (x, v) a b req -> ($ v) <$> serverD x a b req
237+ , serverD = \ (x, v) p a b req -> ($ v) <$> serverD x p a b req
230 } -- Note [Existential Record Update]
239 } -- Note [Existential Record Update]
241+-- | Add a parameter check to the end of the params block
242+addParameterCheck :: Delayed env (a -> b)
245+addParameterCheck Delayed {..} new =
247+ { paramsD = (,) <$> paramsD <*> new
248+ , serverD = \c (p, pNew) a b req -> ($ pNew) <$> serverD c p a b req
232-- | Add a method check to the end of the method block.
252-- | Add a method check to the end of the method block.
233addMethodCheck :: Delayed env a
253addMethodCheck :: Delayed env a
234 -> DelayedIO ()
254 -> DelayedIO ()
@@ -246,7 +266,7 @@ addAuthCheck :: Delayed env (a -> b)
246addAuthCheck Delayed{..} new =
266addAuthCheck Delayed{..} new =
248 { authD = (,) <$> authD <*> new
268 { authD = (,) <$> authD <*> new
249− , serverD = \ c (y, v) b req -> ($ v) <$> serverD c y b req
269+ , serverD = \ c p (y, v) b req -> ($ v) <$> serverD c p y b req
251 } -- Note [Existential Record Update]
271 } -- Note [Existential Record Update]
@@ -257,7 +277,7 @@ addBodyCheck :: Delayed env (a -> b)
257addBodyCheck Delayed{..} new =
277addBodyCheck Delayed{..} new =
259 { bodyD = (,) <$> bodyD <*> new
279 { bodyD = (,) <$> bodyD <*> new
260− , serverD = \ c a (z, v) req -> ($ v) <$> serverD c a z req
280+ , serverD = \ c p a (z, v) req -> ($ v) <$> serverD c p a z req
262 } -- Note [Existential Record Update]
282 } -- Note [Existential Record Update]
@@ -287,7 +307,7 @@ addAcceptCheck Delayed{..} new =
287passToServer :: Delayed env (a -> b) -> (Request -> a) -> Delayed env b
307passToServer :: Delayed env (a -> b) -> (Request -> a) -> Delayed env b
288passToServer Delayed{..} x =
308passToServer Delayed{..} x =
290− { serverD = \ c a b req -> ($ x req) <$> serverD c a b req
310+ { serverD = \ c p a b req -> ($ x req) <$> serverD c p a b req
292 } -- Note [Existential Record Update]
312 } -- Note [Existential Record Update]
@@ -301,16 +321,14 @@ runDelayed :: Delayed env a
302 -> Request
322 -> Request
303 -> ResourceT IO (RouteResult a)
323 -> ResourceT IO (RouteResult a)
304−runDelayed Delayed{..} env req =
324+runDelayed Delayed{..} env = runDelayedIO $ do
306− (do c <- capturesD env
325+ c <- capturesD env
308− a <- authD
327+ a <- authD
309− b <- bodyD
328+ b <- bodyD
310− r <- ask
329+ r <- ask
330+ p <- paramsD -- Has to be after body to respect the relative error order
311− liftRouteResult (serverD c a b r)
331+ liftRouteResult (serverD c p a b r)
315-- | Runs a delayed server and the resulting action.
333-- | Runs a delayed server and the resulting action.
316-- Takes a continuation that lets us send a response.
334-- Takes a continuation that lets us send a response.