@@ -13,19 +13,21 @@ import Data.Aeson (ToJSON, FromJSON, encode, decode')
13import qualified Data.ByteString as B
13import qualified Data.ByteString as B
14import qualified Data.ByteString.Lazy as BL
14import qualified Data.ByteString.Lazy as BL
15import Data.IORef (newIORef, readIORef, writeIORef)
15import Data.IORef (newIORef, readIORef, writeIORef)
16+import Data.List (unfoldr)
16import Data.Maybe (catMaybes)
17import Data.Maybe (catMaybes)
17import Data.Monoid (Monoid, mempty, mappend)
18import Data.Monoid (Monoid, mempty, mappend)
18import Data.Proxy (Proxy(Proxy))
19import Data.Proxy (Proxy(Proxy))
19import Data.String (fromString)
20import Data.String (fromString)
20import Data.String.Conversions (cs, (<>))
21import Data.String.Conversions (cs, (<>))
21−import Data.Text.Encoding (decodeUtf8)
22+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
22import Data.Text (Text)
23import Data.Text (Text)
24+import qualified Data.Text as T
23import GHC.TypeLits (KnownSymbol, symbolVal)
25import GHC.TypeLits (KnownSymbol, symbolVal)
24import Network.HTTP.Types hiding (Header)
26import Network.HTTP.Types hiding (Header)
25import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody,
27import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody,
26 strictRequestBody, lazyRequestBody, requestHeaders, requestMethod,
28 strictRequestBody, lazyRequestBody, requestHeaders, requestMethod,
27 rawQueryString, responseLBS)
29 rawQueryString, responseLBS)
28−import Servant.API (QueryParams, QueryParam, QueryFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..))
30+import Servant.API (QueryParams, QueryParam, QueryFlag, MatrixParams, MatrixParam, MatrixFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..))
29import Servant.Common.Text (FromText, fromText)
31import Servant.Common.Text (FromText, fromText)
31data ReqBodyState = Uncalled
33data ReqBodyState = Uncalled
@@ -108,7 +110,7 @@ isMismatch _ = False
109-- | Like `null . pathInfo`, but works with redundant trailing slashes.
111-- | Like `null . pathInfo`, but works with redundant trailing slashes.
110pathIsEmpty :: Request -> Bool
112pathIsEmpty :: Request -> Bool
111−pathIsEmpty = f . pathInfo
113+pathIsEmpty = f . processedPathInfo
113 f [] = True
115 f [] = True
114 f [""] = True
116 f [""] = True
@@ -129,13 +131,36 @@ type RoutingApplication =
129 Request -- ^ the request, the field 'pathInfo' may be modified by url routing
131 Request -- ^ the request, the field 'pathInfo' may be modified by url routing
130 -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
132 -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
134+splitMatrixParameters :: Text -> (Text, Text)
135+splitMatrixParameters = T.break (== ';')
137+parsePathInfo :: Request -> [Text]
138+parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
139+ where mergePairs = concat . unfoldr pairToList
140+ pairToList [] = Nothing
141+ pairToList ((a, b):xs) = Just ([a, b], xs)
143+-- | Returns a processed pathInfo from the request.
145+-- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
146+-- processed, so routing works as intended. Therefor this function should be used to access
147+-- the pathInfo for routing purposes.
148+processedPathInfo :: Request -> [Text]
149+processedPathInfo r =
151+ (x:xs) | T.head x == ';' -> xs
153+ where pinfo = parsePathInfo r
132class HasServer layout where
155class HasServer layout where
133 type Server layout :: *
156 type Server layout :: *
134 route :: Proxy layout -> Server layout -> RoutingApplication
157 route :: Proxy layout -> Server layout -> RoutingApplication
136-- * Instances
161-- * Instances
138−-- | A server for @a ':<|>' b@ first tries to match the request again the route
163+-- | A server for @a ':<|>' b@ first tries to match the request against the route
139-- represented by @a@ and if it fails tries @b@. You must provide a request
164-- represented by @a@ and if it fails tries @b@. You must provide a request
140-- handler for each route.
165-- handler for each route.
@@ -183,7 +208,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
183 type Server (Capture capture a :> sublayout) =
208 type Server (Capture capture a :> sublayout) =
184 a -> Server sublayout
209 a -> Server sublayout
186− route Proxy subserver request respond = case pathInfo request of
211+ route Proxy subserver request respond = case processedPathInfo request of
187 (first : rest)
212 (first : rest)
188 -> case captured captureProxy first of
213 -> case captured captureProxy first of
189 Nothing -> respond $ failWith NotFound
214 Nothing -> respond $ failWith NotFound
@@ -193,6 +218,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
193 _ -> respond $ failWith NotFound
218 _ -> respond $ failWith NotFound
195 where captureProxy = Proxy :: Proxy (Capture capture a)
220 where captureProxy = Proxy :: Proxy (Capture capture a)
197-- | If you have a 'Delete' endpoint in your API,
223-- | If you have a 'Delete' endpoint in your API,
198-- the handler for this endpoint is meant to delete
224-- the handler for this endpoint is meant to delete
@@ -441,6 +467,124 @@ instance (KnownSymbol sym, HasServer sublayout)
441 examine v | v == "true" || v == "1" || v == "" = True
467 examine v | v == "true" || v == "1" || v == "" = True
442 | otherwise = False
468 | otherwise = False
470+parseMatrixText :: B.ByteString -> QueryText
471+parseMatrixText = parseQueryText
473+-- | If you use @'MatrixParam' "author" Text@ in one of the endpoints for your API,
474+-- this automatically requires your server-side handler to be a function
475+-- that takes an argument of type @'Maybe' 'Text'@.
477+-- This lets servant worry about looking it up in the query string
478+-- and turning it into a value of the type you specify, enclosed
479+-- in 'Maybe', because it may not be there and servant would then
480+-- hand you 'Nothing'.
482+-- You can control how it'll be converted from 'Text' to your type
483+-- by simply providing an instance of 'FromText' for your type.
487+-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]
489+-- > server :: Server MyApi
490+-- > server = getBooksBy
491+-- > where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book]
492+-- > getBooksBy Nothing = ...return all books...
493+-- > getBooksBy (Just author) = ...return books by the given author...
494+instance (KnownSymbol sym, FromText a, HasServer sublayout)
495+ => HasServer (MatrixParam sym a :> sublayout) where
497+ type Server (MatrixParam sym a :> sublayout) =
498+ Maybe a -> Server sublayout
500+ route Proxy subserver request respond = case parsePathInfo request of
502+ -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
503+ param = case lookup paramname querytext of
504+ Nothing -> Nothing -- param absent from the query string
505+ Just Nothing -> Nothing -- param present with no value -> Nothing
506+ Just (Just v) -> fromText v -- if present, we try to convert to
508+ route (Proxy :: Proxy sublayout) (subserver param) request respond
509+ _ -> route (Proxy :: Proxy sublayout) (subserver Nothing) request respond
511+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
513+-- | If you use @'MatrixParams' "authors" Text@ in one of the endpoints for your API,
514+-- this automatically requires your server-side handler to be a function
515+-- that takes an argument of type @['Text']@.
517+-- This lets servant worry about looking up 0 or more values in the query string
518+-- associated to @authors@ and turning each of them into a value of
519+-- the type you specify.
521+-- You can control how the individual values are converted from 'Text' to your type
522+-- by simply providing an instance of 'FromText' for your type.
526+-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]
528+-- > server :: Server MyApi
529+-- > server = getBooksBy
530+-- > where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book]
531+-- > getBooksBy authors = ...return all books by these authors...
532+instance (KnownSymbol sym, FromText a, HasServer sublayout)
533+ => HasServer (MatrixParams sym a :> sublayout) where
535+ type Server (MatrixParams sym a :> sublayout) =
536+ [a] -> Server sublayout
538+ route Proxy subserver request respond = case parsePathInfo request of
540+ -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
541+ -- if sym is "foo", we look for matrix parameters
542+ -- named "foo" or "foo[]" and call fromText on the
543+ -- corresponding values
544+ parameters = filter looksLikeParam matrixtext
545+ values = catMaybes $ map (convert . snd) parameters
546+ route (Proxy :: Proxy sublayout) (subserver values) request respond
547+ _ -> route (Proxy :: Proxy sublayout) (subserver []) request respond
549+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
550+ looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
551+ convert Nothing = Nothing
552+ convert (Just v) = fromText v
554+-- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API,
555+-- this automatically requires your server-side handler to be a function
556+-- that takes an argument of type 'Bool'.
560+-- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book]
562+-- > server :: Server MyApi
563+-- > server = getBooks
564+-- > where getBooks :: Bool -> EitherT (Int, String) IO [Book]
565+-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
566+instance (KnownSymbol sym, HasServer sublayout)
567+ => HasServer (MatrixFlag sym :> sublayout) where
569+ type Server (MatrixFlag sym :> sublayout) =
570+ Bool -> Server sublayout
572+ route Proxy subserver request respond = case parsePathInfo request of
574+ -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
575+ param = case lookup paramname matrixtext of
576+ Just Nothing -> True -- param is there, with no value
577+ Just (Just v) -> examine v -- param with a value
578+ Nothing -> False -- param not in the query string
580+ route (Proxy :: Proxy sublayout) (subserver param) request respond
582+ _ -> route (Proxy :: Proxy sublayout) (subserver False) request respond
584+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
585+ examine v | v == "true" || v == "1" || v == "" = True
444-- | Just pass the request to the underlying application and serve its response.
588-- | Just pass the request to the underlying application and serve its response.
446-- Example:
590-- Example:
@@ -486,7 +630,7 @@ instance (FromJSON a, HasServer sublayout)
486-- pass the rest of the request path to @sublayout@.
630-- pass the rest of the request path to @sublayout@.
487instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
631instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
488 type Server (path :> sublayout) = Server sublayout
632 type Server (path :> sublayout) = Server sublayout
489− route Proxy subserver request respond = case pathInfo request of
633+ route Proxy subserver request respond = case processedPathInfo request of
490 (first : rest)
634 (first : rest)
491 | first == cs (symbolVal proxyPath)
635 | first == cs (symbolVal proxyPath)
492 -> route (Proxy :: Proxy sublayout) subserver request{
636 -> route (Proxy :: Proxy sublayout) subserver request{