From afc76b8f6cf023840ce17ccb583e8e5cad7fabe4 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Thu, 8 Oct 2015 22:40:46 +0200 Subject: [PATCH] Remove MatrixParam. In servant, servant-server, and servant-client. --- servant-client/src/Servant/Client.hs | 128 ----------------- servant-client/src/Servant/Common/Req.hs | 7 - servant-client/test/Servant/ClientSpec.hs | 30 +--- servant-server/servant-server.cabal | 1 - servant-server/src/Servant/Server/Internal.hs | 132 ++---------------- .../src/Servant/Server/Internal/PathInfo.hs | 38 ----- .../src/Servant/Server/Internal/Router.hs | 5 +- servant-server/test/Servant/ServerSpec.hs | 98 +------------ servant/servant.cabal | 1 - servant/src/Servant/API.hs | 4 - servant/src/Servant/API/MatrixParam.hs | 51 ------- servant/src/Servant/Utils/Links.hs | 51 +------ servant/test/Servant/Utils/LinksSpec.hs | 23 +-- 13 files changed, 22 insertions(+), 547 deletions(-) delete mode 100644 servant-server/src/Servant/Server/Internal/PathInfo.hs delete mode 100644 servant/src/Servant/API/MatrixParam.hs diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 6a7b89c2..987a2bd4 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -477,134 +477,6 @@ instance (KnownSymbol sym, HasClient sublayout) where paramname = cs $ symbolVal (Proxy :: Proxy sym) --- | If you use a 'MatrixParam' in one of your endpoints in your API, --- the corresponding querying function will automatically take --- an additional argument of the type specified by your 'MatrixParam', --- enclosed in Maybe. --- --- If you give Nothing, nothing will be added to the query string. --- --- If you give a non-'Nothing' value, this function will take care --- of inserting a textual representation of this value in the query string. --- --- You can control how values for your type are turned into --- text by specifying a 'ToHttpApiData' instance for your type. --- --- Example: --- --- > type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book] --- > --- > myApi :: Proxy MyApi --- > myApi = Proxy --- > --- > getBooksBy :: Maybe Text -> ExceptT String IO [Book] --- > getBooksBy = client myApi host --- > where host = BaseUrl Http "localhost" 8080 --- > -- then you can just use "getBooksBy" to query that endpoint. --- > -- 'getBooksBy Nothing' for all books --- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) - => HasClient (MatrixParam sym a :> sublayout) where - - type Client (MatrixParam sym a :> sublayout) = - Maybe a -> Client sublayout - - -- if mparam = Nothing, we don't add it to the query string - clientWithRoute Proxy req baseurl manager mparam = - clientWithRoute (Proxy :: Proxy sublayout) - (maybe req - (flip (appendToMatrixParams pname . Just) req) - mparamText - ) - baseurl manager - - where pname = symbolVal (Proxy :: Proxy sym) - mparamText = fmap (cs . toQueryParam) mparam - --- | If you use a 'MatrixParams' in one of your endpoints in your API, --- the corresponding querying function will automatically take an --- additional argument, a list of values of the type specified by your --- 'MatrixParams'. --- --- If you give an empty list, nothing will be added to the query string. --- --- Otherwise, this function will take care of inserting a textual --- representation of your values in the path segment string, under the --- same matrix string parameter name. --- --- You can control how values for your type are turned into text by --- specifying a 'ToHttpApiData' instance for your type. --- --- Example: --- --- > type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book] --- > --- > myApi :: Proxy MyApi --- > myApi = Proxy --- > --- > getBooksBy :: [Text] -> ExceptT String IO [Book] --- > getBooksBy = client myApi host --- > where host = BaseUrl Http "localhost" 8080 --- > -- then you can just use "getBooksBy" to query that endpoint. --- > -- 'getBooksBy []' for all books --- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' --- > -- to get all books by Asimov and Heinlein -instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) - => HasClient (MatrixParams sym a :> sublayout) where - - type Client (MatrixParams sym a :> sublayout) = - [a] -> Client sublayout - - clientWithRoute Proxy req baseurl manager paramlist = - clientWithRoute (Proxy :: Proxy sublayout) - (foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value) - req - paramlist' - ) - baseurl manager - - where pname = cs pname' - pname' = symbolVal (Proxy :: Proxy sym) - paramlist' = map (Just . toQueryParam) paramlist - --- | If you use a 'MatrixFlag' in one of your endpoints in your API, --- the corresponding querying function will automatically take an --- additional 'Bool' argument. --- --- If you give 'False', nothing will be added to the path segment. --- --- Otherwise, this function will insert a value-less matrix parameter --- under the name associated to your 'MatrixFlag'. --- --- Example: --- --- > type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book] --- > --- > --- > myApi :: Proxy MyApi --- > myApi = Proxy --- > --- > getBooks :: Bool -> ExceptT String IO [Book] --- > getBooks = client myApi host --- > where host = BaseUrl Http "localhost" 8080 --- > -- then you can just use "getBooks" to query that endpoint. --- > -- 'getBooksBy False' for all books --- > -- 'getBooksBy True' to only get _already published_ books -instance (KnownSymbol sym, HasClient sublayout) - => HasClient (MatrixFlag sym :> sublayout) where - - type Client (MatrixFlag sym :> sublayout) = - Bool -> Client sublayout - - clientWithRoute Proxy req baseurl manager flag = - clientWithRoute (Proxy :: Proxy sublayout) - (if flag - then appendToMatrixParams paramname Nothing req - else req - ) - baseurl manager - - where paramname = cs $ symbolVal (Proxy :: Proxy sym) -- | Pick a 'Method' and specify where the server you want to query is. You get -- back the full `Response`. diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 4a7c1cba..38aa39b5 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -72,13 +72,6 @@ appendToPath :: String -> Req -> Req appendToPath p req = req { reqPath = reqPath req ++ "/" ++ p } -appendToMatrixParams :: String - -> Maybe String - -> Req - -> Req -appendToMatrixParams pname pvalue req = - req { reqPath = reqPath req ++ ";" ++ pname ++ maybe "" ("=" ++) pvalue } - appendToQueryString :: Text -- ^ param name -> Maybe Text -- ^ param value -> Req diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 04e69d31..7d41e8d9 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -96,9 +96,6 @@ type Api = :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person] :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool - :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person - :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person] - :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool :<|> "rawSuccess" :> Raw :<|> "rawFailure" :> Raw :<|> "multiple" :> @@ -124,12 +121,6 @@ server = serve api ( Nothing -> throwE $ ServantErr 400 "missing parameter" "" []) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return - :<|> (\ name -> case name of - Just "alice" -> return alice - Just name -> throwE $ ServantErr 400 (name ++ " not found") "" [] - Nothing -> throwE $ ServantErr 400 "missing parameter" "" []) - :<|> (\ names -> return (zipWith Person names [0..])) - :<|> return :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess") :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure") :<|> (\ a b c d -> return (a, b, c, d)) @@ -198,26 +189,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager (left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag - it "Servant.API.MatrixParam" $ \(_, baseUrl) -> do - let getMatrixParam = getNth (Proxy :: Proxy 7) $ client api baseUrl manager - left show <$> runExceptT (getMatrixParam (Just "alice")) `shouldReturn` Right alice - Left FailureResponse{..} <- runExceptT (getMatrixParam (Just "bob")) - responseStatus `shouldBe` Status 400 "bob not found" - - it "Servant.API.MatrixParam.MatrixParams" $ \(_, baseUrl) -> do - let getMatrixParams = getNth (Proxy :: Proxy 8) $ client api baseUrl manager - left show <$> runExceptT (getMatrixParams []) `shouldReturn` Right [] - left show <$> runExceptT (getMatrixParams ["alice", "bob"]) - `shouldReturn` Right [Person "alice" 0, Person "bob" 1] - - context "Servant.API.MatrixParam.MatrixFlag" $ - forM_ [False, True] $ \ flag -> - it (show flag) $ \(_, baseUrl) -> do - let getMatrixFlag = getNth (Proxy :: Proxy 9) $ client api baseUrl manager - left show <$> runExceptT (getMatrixFlag flag) `shouldReturn` Right flag - - it "Servant.API.Raw on success" $ \(_, baseUrl) -> do - let getRawSuccess = getNth (Proxy :: Proxy 10) $ client api baseUrl manager + it "Servant.API.Raw on success" $ do res <- runExceptT (getRawSuccess methodGet) case res of Left e -> assertFailure $ show e diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 8704a437..1a7335d3 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -37,7 +37,6 @@ library Servant.Server Servant.Server.Internal Servant.Server.Internal.Enter - Servant.Server.Internal.PathInfo Servant.Server.Internal.Router Servant.Server.Internal.RoutingApplication Servant.Server.Internal.ServantErr diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 2e6ade1a..c5e1cf70 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -14,7 +14,6 @@ module Servant.Server.Internal ( module Servant.Server.Internal - , module Servant.Server.Internal.PathInfo , module Servant.Server.Internal.Router , module Servant.Server.Internal.RoutingApplication , module Servant.Server.Internal.ServantErr @@ -31,8 +30,6 @@ import Data.Maybe (mapMaybe, fromMaybe) import Data.String (fromString) import Data.String.Conversions (cs, (<>), ConvertibleStrings) import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) import Data.Typeable import GHC.TypeLits (KnownSymbol, symbolVal) import Network.HTTP.Types hiding (Header, ResponseHeaders) @@ -41,11 +38,10 @@ import Network.Wai (Application, lazyRequestBody, rawQueryString, requestHeaders, requestMethod, responseLBS, remoteHost, isSecure, vault, httpVersion, Response, - Request) + Request, pathInfo) import Servant.API ((:<|>) (..), (:>), Capture, Delete, Get, Header, - IsSecure(..), MatrixFlag, MatrixParam, - MatrixParams, Patch, Post, Put, + IsSecure(..), Patch, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody, Vault) import Servant.API.ContentTypes (AcceptHeader (..), @@ -54,7 +50,6 @@ import Servant.API.ContentTypes (AcceptHeader (..), import Servant.API.ResponseHeaders (Headers, getResponse, GetHeaders, getHeaders) -import Servant.Server.Internal.PathInfo import Servant.Server.Internal.Router import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServantErr @@ -548,123 +543,6 @@ instance (KnownSymbol sym, HasServer sublayout) examine v | v == "true" || v == "1" || v == "" = True | otherwise = False -parseMatrixText :: B.ByteString -> QueryText -parseMatrixText = parseQueryText - --- | If you use @'MatrixParam' "author" Text@ in one of the endpoints for your API, --- this automatically requires your server-side handler to be a function --- that takes an argument of type @'Maybe' 'Text'@. --- --- This lets servant worry about looking it up in the query string --- and turning it into a value of the type you specify, enclosed --- in 'Maybe', because it may not be there and servant would then --- hand you 'Nothing'. --- --- You can control how it'll be converted from 'Text' to your type --- by simply providing an instance of 'FromHttpApiData' for your type. --- --- Example: --- --- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book] --- > --- > server :: Server MyApi --- > server = getBooksBy --- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book] --- > getBooksBy Nothing = ...return all books... --- > getBooksBy (Just author) = ...return books by the given author... -instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout) - => HasServer (MatrixParam sym a :> sublayout) where - - type ServerT (MatrixParam sym a :> sublayout) m = - Maybe a -> ServerT sublayout m - - route Proxy subserver = WithRequest $ \ request -> - case parsePathInfo request of - (first : _) - -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first - param = case lookup paramname querytext of - Nothing -> Nothing -- param absent from the query string - Just Nothing -> Nothing -- param present with no value -> Nothing - Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to - -- the right type - route (Proxy :: Proxy sublayout) (feedTo subserver param) - _ -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing) - - where paramname = cs $ symbolVal (Proxy :: Proxy sym) - --- | If you use @'MatrixParams' "authors" Text@ in one of the endpoints for your API, --- this automatically requires your server-side handler to be a function --- that takes an argument of type @['Text']@. --- --- This lets servant worry about looking up 0 or more values in the query string --- associated to @authors@ and turning each of them into a value of --- the type you specify. --- --- You can control how the individual values are converted from 'Text' to your type --- by simply providing an instance of 'FromHttpApiData' for your type. --- --- Example: --- --- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book] --- > --- > server :: Server MyApi --- > server = getBooksBy --- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book] --- > getBooksBy authors = ...return all books by these authors... -instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout) - => HasServer (MatrixParams sym a :> sublayout) where - - type ServerT (MatrixParams sym a :> sublayout) m = - [a] -> ServerT sublayout m - - route Proxy subserver = WithRequest $ \ request -> - case parsePathInfo request of - (first : _) - -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first - -- if sym is "foo", we look for matrix parameters - -- named "foo" or "foo[]" and call parseQueryParam on the - -- corresponding values - parameters = filter looksLikeParam matrixtext - values = mapMaybe (convert . snd) parameters - route (Proxy :: Proxy sublayout) (feedTo subserver values) - _ -> route (Proxy :: Proxy sublayout) (feedTo subserver []) - where paramname = cs $ symbolVal (Proxy :: Proxy sym) - looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") - convert Nothing = Nothing - convert (Just v) = parseQueryParamMaybe v - --- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API, --- this automatically requires your server-side handler to be a function --- that takes an argument of type 'Bool'. --- --- Example: --- --- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book] --- > --- > server :: Server MyApi --- > server = getBooks --- > where getBooks :: Bool -> ExceptT ServantErr IO [Book] --- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument... -instance (KnownSymbol sym, HasServer sublayout) - => HasServer (MatrixFlag sym :> sublayout) where - - type ServerT (MatrixFlag sym :> sublayout) m = - Bool -> ServerT sublayout m - - route Proxy subserver = WithRequest $ \ request -> - case parsePathInfo request of - (first : _) - -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first - param = case lookup paramname matrixtext of - Just Nothing -> True -- param is there, with no value - Just (Just v) -> examine v -- param with a value - Nothing -> False -- param not in the query string - route (Proxy :: Proxy sublayout) (feedTo subserver param) - _ -> route (Proxy :: Proxy sublayout) (feedTo subserver False) - where paramname = cs $ symbolVal (Proxy :: Proxy sym) - examine v | v == "true" || v == "1" || v == "" = True - | otherwise = False - -- | Just pass the request to the underlying application and serve its response. -- -- Example: @@ -762,5 +640,11 @@ instance HasServer api => HasServer (HttpVersion :> api) where route Proxy subserver = WithRequest $ \req -> route (Proxy :: Proxy api) (feedTo subserver $ httpVersion req) +pathIsEmpty :: Request -> Bool +pathIsEmpty = go . pathInfo + where go [] = True + go [""] = True + go _ = False + ct_wildcard :: B.ByteString ct_wildcard = "*" <> "/" <> "*" -- Because CPP diff --git a/servant-server/src/Servant/Server/Internal/PathInfo.hs b/servant-server/src/Servant/Server/Internal/PathInfo.hs deleted file mode 100644 index 454516f0..00000000 --- a/servant-server/src/Servant/Server/Internal/PathInfo.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Servant.Server.Internal.PathInfo where - -import Data.List (unfoldr) -import Data.Text (Text) -import qualified Data.Text as T -import Network.Wai (Request, pathInfo) - --- | Like `null . pathInfo`, but works with redundant trailing slashes. -pathIsEmpty :: Request -> Bool -pathIsEmpty = f . processedPathInfo - where - f [] = True - f [""] = True - f _ = False - - -splitMatrixParameters :: Text -> (Text, Text) -splitMatrixParameters = T.break (== ';') - -parsePathInfo :: Request -> [Text] -parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo - where mergePairs = concat . unfoldr pairToList - pairToList [] = Nothing - pairToList ((a, b):xs) = Just ([a, b], xs) - --- | Returns a processed pathInfo from the request. --- --- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be --- processed, so routing works as intended. Therefor this function should be used to access --- the pathInfo for routing purposes. -processedPathInfo :: Request -> [Text] -processedPathInfo r = - case pinfo of - (x:xs) | T.head x == ';' -> xs - _ -> pinfo - where pinfo = parsePathInfo r - diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs index 89f7c144..6d41d6cd 100644 --- a/servant-server/src/Servant/Server/Internal/Router.hs +++ b/servant-server/src/Servant/Server/Internal/Router.hs @@ -7,7 +7,6 @@ import qualified Data.Map as M import Data.Monoid ((<>)) import Data.Text (Text) import Network.Wai (Request, Response, pathInfo) -import Servant.Server.Internal.PathInfo import Servant.Server.Internal.RoutingApplication type Router = Router' RoutingApplication @@ -59,14 +58,14 @@ runRouter :: Router -> RoutingApplication runRouter (WithRequest router) request respond = runRouter (router request) request respond runRouter (StaticRouter table) request respond = - case processedPathInfo request of + case pathInfo request of first : rest | Just router <- M.lookup first table -> let request' = request { pathInfo = rest } in runRouter router request' respond _ -> respond $ failWith NotFound runRouter (DynamicRouter fun) request respond = - case processedPathInfo request of + case pathInfo request of first : rest -> let request' = request { pathInfo = rest } in runRouter (fun first) request' respond diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 9c7e85c3..9926dea5 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -38,13 +38,13 @@ import Test.Hspec (Spec, describe, it, shouldBe) import Test.Hspec.Wai (get, liftIO, matchHeaders, matchStatus, post, request, shouldRespondWith, with, (<:>)) -import Servant.API ((:<|>) (..), (:>), - addHeader, Capture, - Delete, Get, Header (..), Headers, - HttpVersion, IsSecure(..), JSON, MatrixFlag, - MatrixParam, MatrixParams, Patch, PlainText, - Post, Put, RemoteHost, QueryFlag, QueryParam, - QueryParams, Raw, ReqBody) +import Servant.API ((:<|>) (..), (:>), Capture, Delete, + Get, Header (..), Headers, + HttpVersion, IsSecure (..), JSON, + Patch, PlainText, Post, Put, + QueryFlag, QueryParam, QueryParams, + Raw, RemoteHost, ReqBody, + addHeader) import Servant.Server (Server, serve, ServantErr(..), err404) import Servant.Server.Internal.Router (tweakResponse, runRouter, @@ -95,7 +95,6 @@ spec = do putSpec patchSpec queryParamSpec - matrixParamSpec headerSpec rawSpec unionSpec @@ -275,89 +274,6 @@ queryParamSpec = do name = "Alice" } -type MatrixParamApi = "a" :> MatrixParam "name" String :> Get '[JSON] Person - :<|> "b" :> MatrixParams "names" String :> "bsub" :> MatrixParams "names" String :> Get '[JSON] Person - :<|> "c" :> MatrixFlag "capitalize" :> Get '[JSON] Person - :<|> "d" :> Capture "foo" Integer :> MatrixParam "name" String :> MatrixFlag "capitalize" :> "dsub" :> Get '[JSON] Person - -matrixParamApi :: Proxy MatrixParamApi -matrixParamApi = Proxy - -mpServer :: Server MatrixParamApi -mpServer = matrixParamServer :<|> mpNames :<|> mpCapitalize alice :<|> mpComplex - where mpNames (_:name2:_) _ = return alice { name = name2 } - mpNames _ _ = return alice - - mpCapitalize p False = return p - mpCapitalize p True = return p { name = map toUpper (name p) } - - matrixParamServer (Just name) = return alice{name = name} - matrixParamServer Nothing = return alice - - mpAge age p = return p { age = age } - mpComplex capture name cap = matrixParamServer name >>= flip mpCapitalize cap >>= mpAge capture - -matrixParamSpec :: Spec -matrixParamSpec = do - describe "Servant.API.MatrixParam" $ do - it "allows to retrieve simple matrix parameters" $ - (flip runSession) (serve matrixParamApi mpServer) $ do - response1 <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["a;name=bob"] - } - liftIO $ do - decode' (simpleBody response1) `shouldBe` Just alice{ - name = "bob" - } - - it "allows to retrieve lists in matrix parameters" $ - (flip runSession) (serve matrixParamApi mpServer) $ do - response2 <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["b;names=bob;names=john", "bsub;names=anna;names=sarah"] - } - liftIO $ - decode' (simpleBody response2) `shouldBe` Just alice{ - name = "john" - } - - it "allows to retrieve value-less matrix parameters" $ - (flip runSession) (serve matrixParamApi mpServer) $ do - response3 <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["c;capitalize"] - } - liftIO $ - decode' (simpleBody response3) `shouldBe` Just alice{ - name = "ALICE" - } - - response3' <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["c;capitalize="] - } - liftIO $ - decode' (simpleBody response3') `shouldBe` Just alice{ - name = "ALICE" - } - - it "allows to retrieve matrix parameters on captured segments" $ - (flip runSession) (serve matrixParamApi mpServer) $ do - response4 <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["d", "12;name=stephen;capitalize", "dsub"] - } - liftIO $ - decode' (simpleBody response4) `shouldBe` Just alice{ - name = "STEPHEN", - age = 12 - } - - response4' <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["d;ignored=1", "5", "dsub"] - } - liftIO $ - decode' (simpleBody response4') `shouldBe` Just alice{ - name = "Alice", - age = 5 - } - type PostApi = ReqBody '[JSON] Person :> Post '[JSON] Integer :<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer diff --git a/servant/servant.cabal b/servant/servant.cabal index 4e72b8af..854e499b 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -37,7 +37,6 @@ library Servant.API.Post Servant.API.Put Servant.API.QueryParam - Servant.API.MatrixParam Servant.API.Raw Servant.API.RemoteHost Servant.API.ReqBody diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index f17f2b67..2e6abb2a 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -17,8 +17,6 @@ module Servant.API ( -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@ module Servant.API.ReqBody, -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@ - module Servant.API.MatrixParam, - -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@ module Servant.API.RemoteHost, -- | Retrieving the IP of the client module Servant.API.IsSecure, @@ -71,8 +69,6 @@ import Servant.API.Get (Get) import Servant.API.Header (Header (..)) import Servant.API.HttpVersion (HttpVersion (..)) import Servant.API.IsSecure (IsSecure (..)) -import Servant.API.MatrixParam (MatrixFlag, MatrixParam, - MatrixParams) import Servant.API.Patch (Patch) import Servant.API.Post (Post) import Servant.API.Put (Put) diff --git a/servant/src/Servant/API/MatrixParam.hs b/servant/src/Servant/API/MatrixParam.hs deleted file mode 100644 index f91c4050..00000000 --- a/servant/src/Servant/API/MatrixParam.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE PolyKinds #-} -{-# OPTIONS_HADDOCK not-home #-} -module Servant.API.MatrixParam (MatrixFlag, MatrixParam, MatrixParams) where - -import Data.Typeable (Typeable) -import GHC.TypeLits (Symbol) --- | Lookup the value associated to the @sym@ matrix string parameter --- and try to extract it as a value of type @a@. --- --- Example: --- --- >>> -- /books;author= --- >>> type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book] -data MatrixParam (sym :: Symbol) a - deriving (Typeable) - --- | Lookup the values associated to the @sym@ matrix string parameter --- and try to extract it as a value of type @[a]@. This is typically --- meant to support matrix string parameters of the form --- @param[]=val1;param[]=val2@ and so on. Note that servant doesn't actually --- require the @[]@s and will fetch the values just fine with --- @param=val1;param=val2@, too. --- --- Example: --- --- >>> -- /books;authors[]=;authors[]=;... --- >>> type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book] -data MatrixParams (sym :: Symbol) a - deriving (Typeable) - --- | Lookup a potentially value-less matrix string parameter --- with boolean semantics. If the param @sym@ is there without any value, --- or if it's there with value "true" or "1", it's interpreted as 'True'. --- Otherwise, it's interpreted as 'False'. --- --- Example: --- --- >>> -- /books;published --- >>> type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book] -data MatrixFlag (sym :: Symbol) - deriving (Typeable) - - --- $setup --- >>> import Servant.API --- >>> import Data.Aeson --- >>> import Data.Text --- >>> data Book --- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index 0b660797..b83d1178 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -117,7 +117,6 @@ import Web.HttpApiData import Servant.API.Capture ( Capture ) import Servant.API.ReqBody ( ReqBody ) import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag ) -import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag ) import Servant.API.Header ( Header ) import Servant.API.Get ( Get ) import Servant.API.Post ( Post ) @@ -173,9 +172,6 @@ type family IsElem endpoint api :: Constraint where IsElem sa (QueryParam x y :> sb) = IsElem sa sb IsElem sa (QueryParams x y :> sb) = IsElem sa sb IsElem sa (QueryFlag x :> sb) = IsElem sa sb - IsElem sa (MatrixParam x y :> sb) = IsElem sa sb - IsElem sa (MatrixParams x y :> sb) = IsElem sa sb - IsElem sa (MatrixFlag x :> sb) = IsElem sa sb IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct' IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct' IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct' @@ -192,10 +188,9 @@ type family IsSubList a b :: Constraint where IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y -- Phantom types for Param -data Matrix data Query --- | Query/Matrix param +-- | Query param data Param a = SingleParam String Text | ArrayElemParam String Text @@ -209,21 +204,6 @@ addQueryParam :: Param Query -> Link -> Link addQueryParam qp l = l { _queryParams = _queryParams l <> [qp] } --- Not particularly efficient for many updates. Something to optimise if it's --- a problem. -addMatrixParam :: Param Matrix -> Link -> Link -addMatrixParam param l = l { _segments = f (_segments l) } - where - f [] = [] - f xs = init xs <> [g (last xs)] - -- Modify the segment at the "top" of the stack - g :: String -> String - g seg = - case param of - SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v) - ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v) - FlagParam k -> seg <> ";" <> k - linkURI :: Link -> URI linkURI (Link segments q_params) = URI mempty -- No scheme (relative) @@ -300,35 +280,6 @@ instance (KnownSymbol sym, HasLink sub) where k = symbolVal (Proxy :: Proxy sym) --- MatrixParam instances -instance (KnownSymbol sym, ToHttpApiData v, HasLink sub) - => HasLink (MatrixParam sym v :> sub) where - type MkLink (MatrixParam sym v :> sub) = Maybe v -> MkLink sub - toLink _ l mv = - toLink (Proxy :: Proxy sub) $ - maybe id (addMatrixParam . SingleParam k . toQueryParam) mv l - where - k = symbolVal (Proxy :: Proxy sym) - -instance (KnownSymbol sym, ToHttpApiData v, HasLink sub) - => HasLink (MatrixParams sym v :> sub) where - type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub - toLink _ l = - toLink (Proxy :: Proxy sub) . - foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toQueryParam v)) l') l - where - k = symbolVal (Proxy :: Proxy sym) - -instance (KnownSymbol sym, HasLink sub) - => HasLink (MatrixFlag sym :> sub) where - type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub - toLink _ l False = - toLink (Proxy :: Proxy sub) l - toLink _ l True = - toLink (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l - where - k = symbolVal (Proxy :: Proxy sym) - -- Misc instances instance HasLink sub => HasLink (ReqBody ct a :> sub) where type MkLink (ReqBody ct a :> sub) = MkLink sub diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs index 07aeb051..c25cccb9 100644 --- a/servant/test/Servant/Utils/LinksSpec.hs +++ b/servant/test/Servant/Utils/LinksSpec.hs @@ -11,14 +11,10 @@ import Data.Proxy ( Proxy(..) ) import Servant.API type TestApi = - -- Capture and query/matrix params + -- Capture and query params "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] () - :<|> "parent" :> MatrixParams "name" String :> "child" - :> MatrixParam "gender" String :> Get '[JSON] String - -- Flags - :<|> "ducks" :> MatrixFlag "yellow" :> MatrixFlag "loud" :> Delete '[JSON] () :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] () -- All of the verbs @@ -34,7 +30,6 @@ type TestLink3 = "parent" :> "child" :> Get '[JSON] String type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool type BadTestLink2 = "greet" :> Get '[PlainText] Bool -type BadTestLink3 = "parent" :> "child" :> MatrixFlag "male" :> Get '[JSON] String type BadTestLink' = "hello" :> "hi" :> Get '[OctetStream] Bool type BadTestLink'2 = "greet" :> Get '[OctetStream] Bool @@ -54,7 +49,7 @@ shouldBeURI link expected = spec :: Spec spec = describe "Servant.Utils.Links" $ do - it "Generates correct links for capture query and matrix params" $ do + it "Generates correct links for capture query params" $ do let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] ()) apiLink l1 "hi" `shouldBeURI` "hello/hi" @@ -63,25 +58,13 @@ spec = describe "Servant.Utils.Links" $ do :> Delete '[JSON] ()) apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true" - let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String - :> "child" - :> MatrixParam "gender" String - :> Get '[JSON] String) - apiLink l3 ["Hubert?x=;&", "Cumberdale"] (Just "Edward?") - `shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\ - \name[]=Cumberdale/child;gender=Edward%3F" - it "Generates correct links for query and matrix flags" $ do + it "Generates correct links for query flags" $ do let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] ()) apiLink l1 True True `shouldBeURI` "balls?bouncy&fast" apiLink l1 False True `shouldBeURI` "balls?fast" - let l2 = Proxy :: Proxy ("ducks" :> MatrixFlag "yellow" - :> MatrixFlag "loud" :> Delete '[JSON] ()) - apiLink l2 True True `shouldBeURI` "ducks;yellow;loud" - apiLink l2 False True `shouldBeURI` "ducks;loud" - it "Generates correct links for all of the verbs" $ do apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get" apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"