Fix runRouterEnv for CaptureAllRouter

  * Trailing slashes will no longer affect the captures for "rooted"
    CaptureAll apis (test included).

Author: guygastineau

servant-server/src/Servant/Server/Internal/Router.hs

@@ -179,12 +179,8 @@ runRouterEnv fmt router env request respond  =
              in  runRouterEnv fmt router' (first, env) request' respond
     CaptureAllRouter router' ->
       let segments = case pathInfo request of
-            -- This case handles empty capture alls in a sub route like:
-            -- /legs/ => [] instead of [""]
-            -- But will this break a rooted capture all? like:
-            -- // => [] instead of [""]
-            -- Maybe we should fix it in Wai first.
-            [""] -> []
+            -- this case is to handle trailing slashes.
+            ("":xs) -> xs
             xs -> xs
           request' = request { pathInfo = [] }
       in runRouterEnv fmt router' (segments, env) request' respond

servant-server/test/Servant/ServerSpec.hs

@@ -281,8 +281,12 @@ captureAllServer = handleLegs :<|> return
       2 -> return tweety
       _ -> throwError err404
 
+type RootedCaptureAllApi = CaptureAll "xs" String :> Get '[JSON] [String]
+
 captureAllSpec :: Spec
 captureAllSpec = do
+  let getStringList = decode' @[String] . simpleBody
+
   describe "Servant.API.CaptureAll" $ do
     with (return (serve captureAllApi captureAllServer)) $ do
 
@@ -311,8 +315,6 @@ captureAllSpec = do
       it "returns 400 if the decoding fails, even when it's multiple elements" $ do
         get "/legs/1/0/0/notAnInt/3/orange/" `shouldRespondWith` 400
 
-      let getStringList = decode' @[String] . simpleBody
-
       it "can capture single String" $ do
         response <- get "/arms/jerry"
         liftIO $ getStringList response `shouldBe` Just ["jerry"]
@@ -321,6 +323,19 @@ captureAllSpec = do
         response <- get "/arms/"
         liftIO $ getStringList response `shouldBe` Just []
 
+      it "can capture empty string from captureall" $ do
+        response <- get "/arms//"
+        liftIO $ getStringList response `shouldBe` Just [""]
+
+    with (return (serve (Proxy :: Proxy RootedCaptureAllApi) return)) $ do
+      it "can capture empty rooted capture all" $ do
+        response <- get "/"
+        liftIO $ getStringList response `shouldBe` Just []
+
+      it "can capture empty string from rooted capture all" $ do
+        response <- get "//"
+        liftIO $ getStringList response `shouldBe` Just [""]
+
     with (return (serve
         (Proxy :: Proxy (CaptureAll "segments" String :> Raw))
         (\ _captured -> Tagged $ \request_ sendResponse ->