Merge pull request #16 from dlarsson/matrix

Added support for matrix parameters.

.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

CHANGELOG.md

@@ -1,3 +1,8 @@
+master
+------
+
+* Added support for matrix parameters, see e.g. http://www.w3.org/DesignIssues/MatrixURIs.html
+
 0.2.3
 -----
 

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

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
@@ -194,6 +219,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
 
     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
 -- a resource.
@@ -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{

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