From b18f27df7a90d3e7caceef9eedb590b19ea730f4 Mon Sep 17 00:00:00 2001 From: Daniel Larsson Date: Sun, 28 Dec 2014 23:07:14 +0100 Subject: [PATCH] Added support for Matrix parameters --- .gitignore | 17 ++++ servant-server.cabal | 4 +- src/Servant/Server/Internal.hs | 156 +++++++++++++++++++++++++++++++-- test/Servant/ServerSpec.hs | 96 ++++++++++++++++++++ 4 files changed, 265 insertions(+), 8 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..0855a79b --- /dev/null +++ b/.gitignore @@ -0,0 +1,17 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.virtualenv +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +cabal.config +*.prof +*.aux +*.hp diff --git a/servant-server.cabal b/servant-server.cabal index 5cb01ef0..fdc59103 100644 --- a/servant-server.cabal +++ b/servant-server.cabal @@ -1,5 +1,5 @@ name: servant-server -version: 0.2.3 +version: 0.2.4 synopsis: A family of combinators for defining webservices APIs and serving them description: A family of combinators for defining webservices APIs and serving them @@ -42,7 +42,7 @@ library , http-types , network-uri >= 2.6 , safe - , servant >= 0.2 + , servant >= 0.2.2 , split , string-conversions , system-filepath diff --git a/src/Servant/Server/Internal.hs b/src/Servant/Server/Internal.hs index 02d81bf9..621a2be8 100644 --- a/src/Servant/Server/Internal.hs +++ b/src/Servant/Server/Internal.hs @@ -13,19 +13,21 @@ import Data.Aeson (ToJSON, FromJSON, encode, decode') import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.IORef (newIORef, readIORef, writeIORef) +import Data.List (unfoldr) import Data.Maybe (catMaybes) import Data.Monoid (Monoid, mempty, mappend) import Data.Proxy (Proxy(Proxy)) import Data.String (fromString) import Data.String.Conversions (cs, (<>)) -import Data.Text.Encoding (decodeUtf8) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text (Text) +import qualified Data.Text as T import GHC.TypeLits (KnownSymbol, symbolVal) import Network.HTTP.Types hiding (Header) import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody, strictRequestBody, lazyRequestBody, requestHeaders, requestMethod, rawQueryString, responseLBS) -import Servant.API (QueryParams, QueryParam, QueryFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..)) +import Servant.API (QueryParams, QueryParam, QueryFlag, MatrixParams, MatrixParam, MatrixFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..)) import Servant.Common.Text (FromText, fromText) data ReqBodyState = Uncalled @@ -108,7 +110,7 @@ isMismatch _ = False -- | Like `null . pathInfo`, but works with redundant trailing slashes. pathIsEmpty :: Request -> Bool -pathIsEmpty = f . pathInfo +pathIsEmpty = f . processedPathInfo where f [] = True f [""] = True @@ -129,13 +131,36 @@ type RoutingApplication = Request -- ^ the request, the field 'pathInfo' may be modified by url routing -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived +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 + class HasServer layout where type Server layout :: * route :: Proxy layout -> Server layout -> RoutingApplication + + -- * Instances --- | A server for @a ':<|>' b@ first tries to match the request again the route +-- | A server for @a ':<|>' b@ first tries to match the request against the route -- represented by @a@ and if it fails tries @b@. You must provide a request -- handler for each route. -- @@ -183,7 +208,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout) type Server (Capture capture a :> sublayout) = a -> Server sublayout - route Proxy subserver request respond = case pathInfo request of + route Proxy subserver request respond = case processedPathInfo request of (first : rest) -> case captured captureProxy first of Nothing -> respond $ failWith NotFound @@ -193,6 +218,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout) _ -> respond $ failWith NotFound where captureProxy = Proxy :: Proxy (Capture capture a) + -- | If you have a 'Delete' endpoint in your API, -- the handler for this endpoint is meant to delete @@ -441,6 +467,124 @@ 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 'FromText' for your type. +-- +-- Example: +-- +-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book] +-- > +-- > server :: Server MyApi +-- > server = getBooksBy +-- > where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book] +-- > getBooksBy Nothing = ...return all books... +-- > getBooksBy (Just author) = ...return books by the given author... +instance (KnownSymbol sym, FromText a, HasServer sublayout) + => HasServer (MatrixParam sym a :> sublayout) where + + type Server (MatrixParam sym a :> sublayout) = + Maybe a -> Server sublayout + + route Proxy subserver request respond = 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) -> fromText v -- if present, we try to convert to + -- the right type + route (Proxy :: Proxy sublayout) (subserver param) request respond + _ -> route (Proxy :: Proxy sublayout) (subserver Nothing) request respond + + 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 'FromText' for your type. +-- +-- Example: +-- +-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book] +-- > +-- > server :: Server MyApi +-- > server = getBooksBy +-- > where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book] +-- > getBooksBy authors = ...return all books by these authors... +instance (KnownSymbol sym, FromText a, HasServer sublayout) + => HasServer (MatrixParams sym a :> sublayout) where + + type Server (MatrixParams sym a :> sublayout) = + [a] -> Server sublayout + + route Proxy subserver request respond = 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 fromText on the + -- corresponding values + parameters = filter looksLikeParam matrixtext + values = catMaybes $ map (convert . snd) parameters + route (Proxy :: Proxy sublayout) (subserver values) request respond + _ -> route (Proxy :: Proxy sublayout) (subserver []) request respond + + where paramname = cs $ symbolVal (Proxy :: Proxy sym) + looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") + convert Nothing = Nothing + convert (Just v) = fromText 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 -> EitherT (Int, String) 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 Server (MatrixFlag sym :> sublayout) = + Bool -> Server sublayout + + route Proxy subserver request respond = 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) (subserver param) request respond + + _ -> route (Proxy :: Proxy sublayout) (subserver False) request respond + + 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: @@ -486,7 +630,7 @@ instance (FromJSON a, HasServer sublayout) -- pass the rest of the request path to @sublayout@. instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where type Server (path :> sublayout) = Server sublayout - route Proxy subserver request respond = case pathInfo request of + route Proxy subserver request respond = case processedPathInfo request of (first : rest) | first == cs (symbolVal proxyPath) -> route (Proxy :: Proxy sublayout) subserver request{ diff --git a/test/Servant/ServerSpec.hs b/test/Servant/ServerSpec.hs index c907cd26..56e98d94 100644 --- a/test/Servant/ServerSpec.hs +++ b/test/Servant/ServerSpec.hs @@ -26,6 +26,7 @@ import Servant.API.Get (Get) import Servant.API.ReqBody (ReqBody) import Servant.API.Post (Post) import Servant.API.QueryParam (QueryParam, QueryParams, QueryFlag) +import Servant.API.MatrixParam (MatrixParam, MatrixParams, MatrixFlag) import Servant.API.Raw (Raw) import Servant.API.Sub ((:>)) import Servant.API.Alternative ((:<|>)((:<|>))) @@ -69,6 +70,7 @@ spec = do captureSpec getSpec queryParamSpec + matrixParamSpec postSpec rawSpec unionSpec @@ -189,6 +191,100 @@ queryParamSpec = do name = "ALICE" } + let params3'' = "?unknown=" + response3' <- Network.Wai.Test.request defaultRequest{ + rawQueryString = params3'', + queryString = parseQuery params3'', + pathInfo = ["b"] + } + liftIO $ + decode' (simpleBody response3') `shouldBe` Just alice{ + name = "Alice" + } + +type MatrixParamApi = "a" :> MatrixParam "name" String :> Get Person + :<|> "b" :> MatrixParams "names" String :> "bsub" :> MatrixParams "names" String :> Get Person + :<|> "c" :> MatrixFlag "capitalize" :> Get Person + :<|> "d" :> Capture "foo" Integer :> MatrixParam "name" String :> MatrixFlag "capitalize" :> "dsub" :> Get 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 Person :> Post Integer :<|> "bla" :> ReqBody Person :> Post Integer