diff --git a/src/Servant/API/Capture.hs b/src/Servant/API/Capture.hs index 36c5e3ec..ed28ccb4 100644 --- a/src/Servant/API/Capture.hs +++ b/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 diff --git a/src/Servant/API/Delete.hs b/src/Servant/API/Delete.hs index aaa80b14..5dcc0bf1 100644 --- a/src/Servant/API/Delete.hs +++ b/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 diff --git a/src/Servant/API/Get.hs b/src/Servant/API/Get.hs index f1a2a116..7e21e44e 100644 --- a/src/Servant/API/Get.hs +++ b/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 diff --git a/src/Servant/API/GetParam.hs b/src/Servant/API/GetParam.hs index 93587c53..82a10f35 100644 --- a/src/Servant/API/GetParam.hs +++ b/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) diff --git a/src/Servant/API/Post.hs b/src/Servant/API/Post.hs index 98a8a3c1..cfb0f10c 100644 --- a/src/Servant/API/Post.hs +++ b/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 diff --git a/src/Servant/API/Put.hs b/src/Servant/API/Put.hs index 7148504a..86f8b87f 100644 --- a/src/Servant/API/Put.hs +++ b/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 diff --git a/src/Servant/API/RQBody.hs b/src/Servant/API/RQBody.hs index c05bdc25..5696dbdc 100644 --- a/src/Servant/API/RQBody.hs +++ b/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 diff --git a/src/Servant/API/Raw.hs b/src/Servant/API/Raw.hs index 103864b8..c530da20 100644 --- a/src/Servant/API/Raw.hs +++ b/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 = - rawApplication request{pathInfo = globalPathInfo} (respond . Just) + route Proxy rawApplication request respond = + rawApplication request (respond . Just) diff --git a/src/Servant/API/Sub.hs b/src/Servant/API/Sub.hs index 7a9958b1..9abc8da8 100644 --- a/src/Servant/API/Sub.hs +++ b/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 diff --git a/src/Servant/API/Union.hs b/src/Servant/API/Union.hs index d92451ca..8d2b710a 100644 --- a/src/Servant/API/Union.hs +++ b/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 :: Proxy a) a globalPathInfo request $ \ mResponse -> + route Proxy (a :<|> b) request respond = do + 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 diff --git a/src/Servant/Server.hs b/src/Servant/Server.hs index 193df093..1ca83e74 100644 --- a/src/Servant/Server.hs +++ b/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 diff --git a/test/Servant/ServerSpec.hs b/test/Servant/ServerSpec.hs index 6306a3a6..770bc6c6 100644 --- a/test/Servant/ServerSpec.hs +++ b/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 =