@@ -104,6 +104,14 @@ isMismatch :: RouteResult a -> Bool
104104isMismatch (RR (Left _)) = True
105105isMismatch _ = False
106106
107+-- | Like `null . pathInfo`, but works with redundant trailing slashes.
108+pathIsEmpty :: Request -> Bool
109+pathIsEmpty = f . pathInfo
110+ where
111+ f [] = True
112+ f [""] = True
113+ f _ = False
114+
107115-- | If we get a `Right`, it has precedence over everything else.
108116--
109117-- This in particular means that if we could get several 'Right's,
@@ -199,14 +207,14 @@ instance HasServer Delete where
199207 type Server Delete = EitherT (Int, String) IO ()
200208
201209 route Proxy action request respond
202− | null (pathInfo request) && requestMethod request == methodDelete = do
210+ | pathIsEmpty request && requestMethod request == methodDelete = do
203211 e <- runEitherT action
204212 respond $ succeedWith $ case e of
205213 Right () ->
206214 responseLBS status204 [] ""
207215 Left (status, message) ->
208216 responseLBS (mkStatus status (cs message)) [] (cs message)
209− | null (pathInfo request) && requestMethod request /= methodDelete =
217+ | pathIsEmpty request && requestMethod request /= methodDelete =
210218 respond $ failWith WrongMethod
211219 | otherwise = respond $ failWith NotFound
212220
@@ -224,14 +232,14 @@ instance HasServer Delete where
224232instance ToJSON result => HasServer (Get result) where
225233 type Server (Get result) = EitherT (Int, String) IO result
226234 route Proxy action request respond
227− | null (pathInfo request) && requestMethod request == methodGet = do
235+ | pathIsEmpty request && requestMethod request == methodGet = do
228236 e <- runEitherT action
229237 respond . succeedWith $ case e of
230238 Right output ->
231239 responseLBS ok200 [("Content-Type", "application/json")] (encode output)
232240 Left (status, message) ->
233241 responseLBS (mkStatus status (cs message)) [] (cs message)
234− | null (pathInfo request) && requestMethod request /= methodGet =
242+ | pathIsEmpty request && requestMethod request /= methodGet =
235243 respond $ failWith WrongMethod
236244 | otherwise = respond $ failWith NotFound
237245
@@ -282,14 +290,14 @@ instance ToJSON a => HasServer (Post a) where
282290 type Server (Post a) = EitherT (Int, String) IO a
283291
284292 route Proxy action request respond
285− | null (pathInfo request) && requestMethod request == methodPost = do
293+ | pathIsEmpty request && requestMethod request == methodPost = do
286294 e <- runEitherT action
287295 respond . succeedWith $ case e of
288296 Right out ->
289297 responseLBS status201 [("Content-Type", "application/json")] (encode out)
290298 Left (status, message) ->
291299 responseLBS (mkStatus status (cs message)) [] (cs message)
292− | null (pathInfo request) && requestMethod request /= methodPost =
300+ | pathIsEmpty request && requestMethod request /= methodPost =
293301 respond $ failWith WrongMethod
294302 | otherwise = respond $ failWith NotFound
295303
@@ -308,14 +316,14 @@ instance ToJSON a => HasServer (Put a) where
308316 type Server (Put a) = EitherT (Int, String) IO a
309317
310318 route Proxy action request respond
311− | null (pathInfo request) && requestMethod request == methodPut = do
319+ | pathIsEmpty request && requestMethod request == methodPut = do
312320 e <- runEitherT action
313321 respond . succeedWith $ case e of
314322 Right out ->
315323 responseLBS ok200 [("Content-Type", "application/json")] (encode out)
316324 Left (status, message) ->
317325 responseLBS (mkStatus status (cs message)) [] (cs message)
318− | null (pathInfo request) && requestMethod request /= methodPut =
326+ | pathIsEmpty request && requestMethod request /= methodPut =
319327 respond $ failWith WrongMethod
320328
321329 | otherwise = respond $ failWith NotFound