Routing strips path snippets (and Raw receives modified Requests)

src/Servant/API/Capture.hs

@@ -28,11 +28,11 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
   type Server (Capture capture a :> sublayout) =
      a -> Server sublayout
 
-  route Proxy subserver globalPathInfo request respond = case pathInfo request of
+  route Proxy subserver request respond = case pathInfo request of
     (first : rest)
       -> case captured captureProxy first of
            Nothing  -> respond Nothing
-           Just v   -> route (Proxy :: Proxy sublayout) (subserver v) globalPathInfo request{
+           Just v   -> route (Proxy :: Proxy sublayout) (subserver v) request{
                          pathInfo = rest
                        } respond
     _ -> respond Nothing

src/Servant/API/Delete.hs

@@ -23,7 +23,7 @@ data Delete
 instance HasServer Delete where
   type Server Delete = EitherT (Int, String) IO ()
 
-  route Proxy action _globalPathInfo request respond
+  route Proxy action request respond
     | null (pathInfo request) && requestMethod request == methodDelete = do
         e <- runEitherT action
         respond $ Just $ case e of

src/Servant/API/Get.hs

@@ -24,7 +24,7 @@ data Get a
 
 instance ToJSON result => HasServer (Get result) where
   type Server (Get result) = EitherT (Int, String) IO result
-  route Proxy action _globalPathInfo request respond
+  route Proxy action request respond
     | null (pathInfo request) && requestMethod request == methodGet = do
         e <- runEitherT action
         respond $ Just $ case e of

src/Servant/API/GetParam.hs

@@ -27,7 +27,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
   type Server (GetParam sym a :> sublayout) =
     Maybe a -> Server sublayout
 
-  route Proxy subserver globalPathInfo request respond = do
+  route Proxy subserver request respond = do
     let querytext = parseQueryText $ rawQueryString request
         param =
           case lookup paramname querytext of
@@ -36,7 +36,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
             Just (Just v) -> fromText v -- if present, we try to convert to
                                         -- the right type
 
-    route (Proxy :: Proxy sublayout) (subserver param) globalPathInfo request respond
+    route (Proxy :: Proxy sublayout) (subserver param) request respond
 
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
 

src/Servant/API/Post.hs

@@ -26,7 +26,7 @@ data Post a
 instance ToJSON a => HasServer (Post a) where
   type Server (Post a) = EitherT (Int, String) IO a
 
-  route Proxy action _globalPathInfo request respond
+  route Proxy action request respond
     | null (pathInfo request) && requestMethod request == methodPost = do
         e <- runEitherT action
         respond $ Just $ case e of

src/Servant/API/Put.hs

@@ -24,7 +24,7 @@ data Put a
 instance ToJSON a => HasServer (Put a) where
   type Server (Put a) = EitherT (Int, String) IO a
 
-  route Proxy action _globalPathInfo request respond
+  route Proxy action request respond
     | null (pathInfo request) && requestMethod request == methodPut = do
         e <- runEitherT action
         respond $ Just $ case e of

src/Servant/API/RQBody.hs

@@ -23,11 +23,11 @@ instance (FromJSON a, HasServer sublayout)
   type Server (RQBody a :> sublayout) =
     a -> Server sublayout
 
-  route Proxy subserver globalPathInfo request respond = do
+  route Proxy subserver request respond = do
     mrqbody <- decode' <$> lazyRequestBody request
     case mrqbody of
       Nothing -> respond Nothing
-      Just v  -> route (Proxy :: Proxy sublayout) (subserver v) globalPathInfo request respond
+      Just v  -> route (Proxy :: Proxy sublayout) (subserver v) request respond
 
 instance (ToJSON a, HasClient sublayout)
       => HasClient (RQBody a :> sublayout) where

src/Servant/API/Raw.hs

@@ -7,11 +7,12 @@ import Network.Wai
 import Servant.Server
 
 -- | Endpoint for plugging in your own Wai 'Application's.
--- The given Application will get the original request received by the server
+--
--- (i.e. with unmodified 'pathInfo', etc.)
+-- The given 'Application' will get the request as received by the server, potentially with
+-- a modified (stripped) 'pathInfo' if the 'Application' is being routed with 'Servant.API.Sub.:>'.
 data Raw
 
 instance HasServer Raw where
   type Server Raw = Application
-  route Proxy rawApplication globalPathInfo request respond =
+  route Proxy rawApplication request respond =
-    rawApplication request{pathInfo = globalPathInfo} (respond . Just)
+    rawApplication request (respond . Just)

src/Servant/API/Sub.hs

@@ -19,10 +19,10 @@ infixr 9 :>
 
 instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
   type Server (path :> sublayout) = Server sublayout
-  route Proxy subserver globalPathInfo request respond = case pathInfo request of
+  route Proxy subserver request respond = case pathInfo request of
     (first : rest)
       | first == cs (symbolVal proxyPath)
-      -> route (Proxy :: Proxy sublayout) subserver globalPathInfo request{
+      -> route (Proxy :: Proxy sublayout) subserver request{
            pathInfo = rest
          } respond
     _ -> respond Nothing

src/Servant/API/Union.hs

@@ -14,10 +14,10 @@ infixr 8 :<|>
 
 instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
   type Server (a :<|> b) = Server a :<|> Server b
-  route Proxy (a :<|> b) globalPathInfo request respond = do
+  route Proxy (a :<|> b) request respond = do
-    route (Proxy :: Proxy a) a globalPathInfo request $ \ mResponse ->
+    route (Proxy :: Proxy a) a request $ \ mResponse ->
       case mResponse of
-        Nothing -> route (Proxy :: Proxy b) b globalPathInfo request respond
+        Nothing -> route (Proxy :: Proxy b) b request respond
         Just resp -> respond $ Just resp
 
 instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

src/Servant/Server.hs

@@ -8,7 +8,6 @@
 module Servant.Server where
 
 import Data.Proxy
-import Data.Text
 import Network.HTTP.Types
 import Network.Wai
 
@@ -20,7 +19,7 @@ serve p server = toApplication (route p server)
 
 toApplication :: RoutingApplication -> Application
 toApplication ra request respond = do
-  ra (pathInfo request) request routingRespond
+  ra request routingRespond
  where
   routingRespond :: Maybe Response -> IO ResponseReceived
   routingRespond Nothing =
@@ -29,8 +28,7 @@ toApplication ra request respond = do
     respond response
 
 type RoutingApplication =
-     [Text] -- ^ the unmodified 'pathInfo'
+     Request -- ^ the request, the field 'pathInfo' may be modified by url routing
-  -> Request -- ^ the request, the field 'pathInfo' may be modified by url routing
   -> (Maybe Response -> IO ResponseReceived) -> IO ResponseReceived
 
 class HasServer layout where

test/Servant/ServerSpec.hs

@@ -164,13 +164,13 @@ rawSpec = do
         liftIO $ do
           simpleBody response `shouldBe` "42"
 
-    it "gets the pathInfo unmodified" $ do
+    it "gets the pathInfo modified" $ do
       (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
         response <- Network.Wai.Test.request defaultRequest{
-          pathInfo = ["foo"]
+          pathInfo = ["foo", "bar"]
          }
         liftIO $ do
-          simpleBody response `shouldBe` cs (show ["foo" :: String])
+          simpleBody response `shouldBe` cs (show ["bar" :: String])
 
 
 type UnionApi =