Added support for Matrix parameters

This commit is contained in:
Daniel Larsson 2014-12-28 23:07:14 +01:00
parent 9ef336b50f
commit b18f27df7a
4 changed files with 265 additions and 8 deletions

17
.gitignore vendored Normal file
View file

@ -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

View file

@ -1,5 +1,5 @@
name: servant-server name: servant-server
version: 0.2.3 version: 0.2.4
synopsis: A family of combinators for defining webservices APIs and serving them synopsis: A family of combinators for defining webservices APIs and serving them
description: description:
A family of combinators for defining webservices APIs and serving them A family of combinators for defining webservices APIs and serving them
@ -42,7 +42,7 @@ library
, http-types , http-types
, network-uri >= 2.6 , network-uri >= 2.6
, safe , safe
, servant >= 0.2 , servant >= 0.2.2
, split , split
, string-conversions , string-conversions
, system-filepath , system-filepath

View file

@ -13,19 +13,21 @@ import Data.Aeson (ToJSON, FromJSON, encode, decode')
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, writeIORef) import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (unfoldr)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Monoid (Monoid, mempty, mappend) import Data.Monoid (Monoid, mempty, mappend)
import Data.Proxy (Proxy(Proxy)) import Data.Proxy (Proxy(Proxy))
import Data.String (fromString) import Data.String (fromString)
import Data.String.Conversions (cs, (<>)) import Data.String.Conversions (cs, (<>))
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T
import GHC.TypeLits (KnownSymbol, symbolVal) import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types hiding (Header) import Network.HTTP.Types hiding (Header)
import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody, import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody,
strictRequestBody, lazyRequestBody, requestHeaders, requestMethod, strictRequestBody, lazyRequestBody, requestHeaders, requestMethod,
rawQueryString, responseLBS) 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) import Servant.Common.Text (FromText, fromText)
data ReqBodyState = Uncalled data ReqBodyState = Uncalled
@ -108,7 +110,7 @@ isMismatch _ = False
-- | Like `null . pathInfo`, but works with redundant trailing slashes. -- | Like `null . pathInfo`, but works with redundant trailing slashes.
pathIsEmpty :: Request -> Bool pathIsEmpty :: Request -> Bool
pathIsEmpty = f . pathInfo pathIsEmpty = f . processedPathInfo
where where
f [] = True f [] = True
f [""] = True f [""] = True
@ -129,13 +131,36 @@ type RoutingApplication =
Request -- ^ the request, the field 'pathInfo' may be modified by url routing Request -- ^ the request, the field 'pathInfo' may be modified by url routing
-> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived -> (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 class HasServer layout where
type Server layout :: * type Server layout :: *
route :: Proxy layout -> Server layout -> RoutingApplication route :: Proxy layout -> Server layout -> RoutingApplication
-- * Instances -- * 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 -- represented by @a@ and if it fails tries @b@. You must provide a request
-- handler for each route. -- handler for each route.
-- --
@ -183,7 +208,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
type Server (Capture capture a :> sublayout) = type Server (Capture capture a :> sublayout) =
a -> Server sublayout a -> Server sublayout
route Proxy subserver request respond = case pathInfo request of route Proxy subserver request respond = case processedPathInfo request of
(first : rest) (first : rest)
-> case captured captureProxy first of -> case captured captureProxy first of
Nothing -> respond $ failWith NotFound Nothing -> respond $ failWith NotFound
@ -194,6 +219,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
where captureProxy = Proxy :: Proxy (Capture capture a) where captureProxy = Proxy :: Proxy (Capture capture a)
-- | If you have a 'Delete' endpoint in your API, -- | If you have a 'Delete' endpoint in your API,
-- the handler for this endpoint is meant to delete -- the handler for this endpoint is meant to delete
-- a resource. -- a resource.
@ -441,6 +467,124 @@ instance (KnownSymbol sym, HasServer sublayout)
examine v | v == "true" || v == "1" || v == "" = True examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False | 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. -- | Just pass the request to the underlying application and serve its response.
-- --
-- Example: -- Example:
@ -486,7 +630,7 @@ instance (FromJSON a, HasServer sublayout)
-- pass the rest of the request path to @sublayout@. -- pass the rest of the request path to @sublayout@.
instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
type Server (path :> sublayout) = Server sublayout 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 : rest)
| first == cs (symbolVal proxyPath) | first == cs (symbolVal proxyPath)
-> route (Proxy :: Proxy sublayout) subserver request{ -> route (Proxy :: Proxy sublayout) subserver request{

View file

@ -26,6 +26,7 @@ import Servant.API.Get (Get)
import Servant.API.ReqBody (ReqBody) import Servant.API.ReqBody (ReqBody)
import Servant.API.Post (Post) import Servant.API.Post (Post)
import Servant.API.QueryParam (QueryParam, QueryParams, QueryFlag) import Servant.API.QueryParam (QueryParam, QueryParams, QueryFlag)
import Servant.API.MatrixParam (MatrixParam, MatrixParams, MatrixFlag)
import Servant.API.Raw (Raw) import Servant.API.Raw (Raw)
import Servant.API.Sub ((:>)) import Servant.API.Sub ((:>))
import Servant.API.Alternative ((:<|>)((:<|>))) import Servant.API.Alternative ((:<|>)((:<|>)))
@ -69,6 +70,7 @@ spec = do
captureSpec captureSpec
getSpec getSpec
queryParamSpec queryParamSpec
matrixParamSpec
postSpec postSpec
rawSpec rawSpec
unionSpec unionSpec
@ -189,6 +191,100 @@ queryParamSpec = do
name = "ALICE" 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 = type PostApi =
ReqBody Person :> Post Integer ReqBody Person :> Post Integer
:<|> "bla" :> ReqBody Person :> Post Integer :<|> "bla" :> ReqBody Person :> Post Integer