@@ -104,6 +104,14 @@ isMismatch :: RouteResult a -> Bool
104isMismatch (RR (Left _)) = True
104isMismatch (RR (Left _)) = True
105isMismatch _ = False
105isMismatch _ = False
107+-- | Like `null . pathInfo`, but works with redundant trailing slashes.
108+pathIsEmpty :: Request -> Bool
109+pathIsEmpty = f . pathInfo
107-- | If we get a `Right`, it has precedence over everything else.
115-- | If we get a `Right`, it has precedence over everything else.
109-- This in particular means that if we could get several 'Right's,
117-- This in particular means that if we could get several 'Right's,
@@ -199,14 +207,14 @@ instance HasServer Delete where
199 type Server Delete = EitherT (Int, String) IO ()
207 type Server Delete = EitherT (Int, String) IO ()
201 route Proxy action request respond
209 route Proxy action request respond
202− | null (pathInfo request) && requestMethod request == methodDelete = do
210+ | pathIsEmpty request && requestMethod request == methodDelete = do
203 e <- runEitherT action
211 e <- runEitherT action
204 respond $ succeedWith $ case e of
212 respond $ succeedWith $ case e of
205 Right () ->
213 Right () ->
206 responseLBS status204 [] ""
214 responseLBS status204 [] ""
207 Left (status, message) ->
215 Left (status, message) ->
208 responseLBS (mkStatus status (cs message)) [] (cs message)
216 responseLBS (mkStatus status (cs message)) [] (cs message)
209− | null (pathInfo request) && requestMethod request /= methodDelete =
217+ | pathIsEmpty request && requestMethod request /= methodDelete =
210 respond $ failWith WrongMethod
218 respond $ failWith WrongMethod
211 | otherwise = respond $ failWith NotFound
219 | otherwise = respond $ failWith NotFound
@@ -224,14 +232,14 @@ instance HasServer Delete where
224instance ToJSON result => HasServer (Get result) where
232instance ToJSON result => HasServer (Get result) where
225 type Server (Get result) = EitherT (Int, String) IO result
233 type Server (Get result) = EitherT (Int, String) IO result
226 route Proxy action request respond
234 route Proxy action request respond
227− | null (pathInfo request) && requestMethod request == methodGet = do
235+ | pathIsEmpty request && requestMethod request == methodGet = do
228 e <- runEitherT action
236 e <- runEitherT action
229 respond . succeedWith $ case e of
237 respond . succeedWith $ case e of
230 Right output ->
238 Right output ->
231 responseLBS ok200 [("Content-Type", "application/json")] (encode output)
239 responseLBS ok200 [("Content-Type", "application/json")] (encode output)
232 Left (status, message) ->
240 Left (status, message) ->
233 responseLBS (mkStatus status (cs message)) [] (cs message)
241 responseLBS (mkStatus status (cs message)) [] (cs message)
234− | null (pathInfo request) && requestMethod request /= methodGet =
242+ | pathIsEmpty request && requestMethod request /= methodGet =
235 respond $ failWith WrongMethod
243 respond $ failWith WrongMethod
236 | otherwise = respond $ failWith NotFound
244 | otherwise = respond $ failWith NotFound
@@ -282,14 +290,14 @@ instance ToJSON a => HasServer (Post a) where
282 type Server (Post a) = EitherT (Int, String) IO a
290 type Server (Post a) = EitherT (Int, String) IO a
284 route Proxy action request respond
292 route Proxy action request respond
285− | null (pathInfo request) && requestMethod request == methodPost = do
293+ | pathIsEmpty request && requestMethod request == methodPost = do
286 e <- runEitherT action
294 e <- runEitherT action
287 respond . succeedWith $ case e of
295 respond . succeedWith $ case e of
288 Right out ->
296 Right out ->
289 responseLBS status201 [("Content-Type", "application/json")] (encode out)
297 responseLBS status201 [("Content-Type", "application/json")] (encode out)
290 Left (status, message) ->
298 Left (status, message) ->
291 responseLBS (mkStatus status (cs message)) [] (cs message)
299 responseLBS (mkStatus status (cs message)) [] (cs message)
292− | null (pathInfo request) && requestMethod request /= methodPost =
300+ | pathIsEmpty request && requestMethod request /= methodPost =
293 respond $ failWith WrongMethod
301 respond $ failWith WrongMethod
294 | otherwise = respond $ failWith NotFound
302 | otherwise = respond $ failWith NotFound
@@ -308,14 +316,14 @@ instance ToJSON a => HasServer (Put a) where
308 type Server (Put a) = EitherT (Int, String) IO a
316 type Server (Put a) = EitherT (Int, String) IO a
310 route Proxy action request respond
318 route Proxy action request respond
311− | null (pathInfo request) && requestMethod request == methodPut = do
319+ | pathIsEmpty request && requestMethod request == methodPut = do
312 e <- runEitherT action
320 e <- runEitherT action
313 respond . succeedWith $ case e of
321 respond . succeedWith $ case e of
314 Right out ->
322 Right out ->
315 responseLBS ok200 [("Content-Type", "application/json")] (encode out)
323 responseLBS ok200 [("Content-Type", "application/json")] (encode out)
316 Left (status, message) ->
324 Left (status, message) ->
317 responseLBS (mkStatus status (cs message)) [] (cs message)
325 responseLBS (mkStatus status (cs message)) [] (cs message)
318− | null (pathInfo request) && requestMethod request /= methodPut =
326+ | pathIsEmpty request && requestMethod request /= methodPut =
319 respond $ failWith WrongMethod
327 respond $ failWith WrongMethod
321 | otherwise = respond $ failWith NotFound
329 | otherwise = respond $ failWith NotFound