diff --git a/example/greet.hs b/example/greet.hs deleted file mode 100644 --- a/example/greet.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} - -import Data.Aeson -import Data.Monoid -import Data.Proxy -import Data.Text -import GHC.Generics -import Network.Wai -import Network.Wai.Handler.Warp - -import Servant - --- * Example - --- | A greet message data type -newtype Greet = Greet { msg :: Text } - deriving (Generic, Show) - -instance FromJSON Greet -instance ToJSON Greet - --- API specification -type TestApi = - -- GET /hello/:name?capital={true, false} returns a Greet as JSON - "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet - - -- POST /greet with a Greet as JSON in the request body, - -- returns a Greet as JSON - :<|> "greet" :> ReqBody Greet :> Post Greet - - -- DELETE /greet/:greetid - :<|> "greet" :> Capture "greetid" Text :> Delete - -testApi :: Proxy TestApi -testApi = Proxy - --- Server-side handlers. --- --- There's one handler per endpoint, which, just like in the type --- that represents the API, are glued together using :<|>. --- --- Each handler runs in the 'EitherT (Int, String) IO' monad. -server :: Server TestApi -server = helloH :<|> postGreetH :<|> deleteGreetH - - where helloH name Nothing = helloH name (Just False) - helloH name (Just False) = return . Greet $ "Hello, " <> name - helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name - - postGreetH greet = return greet - - deleteGreetH _ = return () - --- Turn the server into a WAI app. 'serve' is provided by servant, --- more precisely by the Servant.Server module. -test :: Application -test = serve testApi server - --- Run the server. --- --- 'run' comes from Network.Wai.Handler.Warp -runTestServer :: Port -> IO () -runTestServer port = run port test - --- Put this all to work! -main :: IO () -main = runTestServer 8001 diff --git a/servant.cabal b/servant.cabal --- a/servant.cabal +++ b/servant.cabal @@ -1,87 +1,13 @@ name: servant -version: 0.2 -synopsis: A family of combinators for defining webservices APIs and serving them +version: 0.2.1 +synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them . You can learn about the basics in guide. . - Here's a runnable example, with comments, that defines a dummy API and - implements a webserver that serves this API. You can find it too. - . - > {-# LANGUAGE DataKinds #-} - > {-# LANGUAGE PolyKinds #-} - > {-# LANGUAGE TypeFamilies #-} - > {-# LANGUAGE DeriveGeneric #-} - > {-# LANGUAGE TypeOperators #-} - > {-# LANGUAGE OverloadedStrings #-} - > - > import Data.Aeson - > import Data.Monoid - > import Data.Proxy - > import Data.Text - > import GHC.Generics - > import Network.Wai - > import Network.Wai.Handler.Warp - > - > import Servant - > - > -- * Example - > - > -- | A greet message data type - > newtype Greet = Greet { msg :: Text } - > deriving (Generic, Show) - > - > instance FromJSON Greet - > instance ToJSON Greet - > - > -- API specification - > type TestApi = - > -- GET /hello/:name?capital={true, false} - -- returns a Greet as JSON - > "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet - > - > -- POST /greet with a Greet as JSON in the request body, - > -- returns a Greet as JSON - > :<|> "greet" :> ReqBody Greet :> Post Greet - > - > -- DELETE /greet/:greetid - > :<|> "greet" :> Capture "greetid" Text :> Delete - > - > testApi :: Proxy TestApi - > testApi = Proxy - > - > -- Server-side handlers. - > -- - > -- There's one handler per endpoint, which, just like in the type - > -- that represents the API, are glued together using :<|>. - > -- - > -- Each handler runs in the 'EitherT (Int, String) IO' monad. - > server :: Server TestApi - > server = helloH :<|> postGreetH :<|> deleteGreetH - > - > where helloH name Nothing = helloH name (Just False) - > helloH name (Just False) = return . Greet $ "Hello, " <> name - > helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name - > - > postGreetH greet = return greet - > - > deleteGreetH _ = return () - > - > -- Turn the server into a WAI app. 'serve' is provided by servant, - > -- more precisely by the Servant.Server module. - > test :: Application - > test = serve testApi server - > - > -- Run the server. - > -- - > -- 'run' comes from Network.Wai.Handler.Warp - > runTestServer :: Port -> IO () - > runTestServer port = run port test - > - > -- Put this all to work! - > main :: IO () - > main = runTestServer 8001 + 's a runnable example, with comments, that defines a dummy API and + implements a webserver that serves this API, using the package. homepage: http://haskell-servant.github.io/ Bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 @@ -99,7 +25,6 @@ library exposed-modules: - Servant Servant.API Servant.API.Alternative Servant.API.Capture @@ -114,45 +39,17 @@ Servant.API.Sub Servant.Common.Text Servant.QQ - Servant.Server Servant.Utils.Links - Servant.Utils.StaticFiles build-depends: base >=4.7 && <5 - , aeson - , attoparsec - , bytestring - , either - , http-types - , network-uri >= 2.6 - , parsec - , safe - , split - , string-conversions - , system-filepath + , text >= 1 , template-haskell - , text - , transformers - , wai - , wai-app-static - , warp + , parsec >= 3.1 + , string-conversions >= 0.3 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -executable greet - main-is: greet.hs - hs-source-dirs: example - ghc-options: -Wall - default-language: Haskell2010 - build-depends: - base - , servant - , aeson - , warp - , wai - , text - test-suite spec type: exitcode-stdio-1.0 ghc-options: @@ -162,22 +59,9 @@ main-is: Spec.hs build-depends: base == 4.* - , aeson - , bytestring - , directory - , either - , exceptions , hspec == 2.* - , hspec-wai - , http-types - , network >= 2.6 , QuickCheck , parsec , servant , string-conversions - , temporary , text - , transformers - , wai - , wai-extra - , warp diff --git a/src/Servant.hs b/src/Servant.hs deleted file mode 100644 --- a/src/Servant.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Servant ( - -- | This module and its submodules can be used to define servant APIs. Note - -- that these API definitions don't directly implement a server (or anything - -- else). - module Servant.API, - -- | For implementing servers for servant APIs. - module Servant.Server, - -- | Using your types in request paths and query string parameters - module Servant.Common.Text, - -- | Utilities on top of the servant core - module Servant.QQ, - module Servant.Utils.Links, - module Servant.Utils.StaticFiles, - -- | Useful re-exports - Proxy(..), - ) where - -import Data.Proxy -import Servant.API -import Servant.Common.Text -import Servant.Server -import Servant.QQ -import Servant.Utils.Links -import Servant.Utils.StaticFiles diff --git a/src/Servant/API.hs b/src/Servant/API.hs --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -29,7 +29,6 @@ -- * Untyped endpoints -- | Plugging in a wai 'Network.Wai.Application', serving directories module Servant.API.Raw, - module Servant.Utils.StaticFiles, -- * Utilities -- | QuasiQuotes for endpoints @@ -51,4 +50,3 @@ import Servant.API.Sub import Servant.QQ (sitemap) import Servant.Utils.Links (mkLink) -import Servant.Utils.StaticFiles diff --git a/src/Servant/API/Alternative.hs b/src/Servant/API/Alternative.hs --- a/src/Servant/API/Alternative.hs +++ b/src/Servant/API/Alternative.hs @@ -1,12 +1,6 @@ -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.Alternative where -import Data.Monoid -import Data.Proxy -import Servant.Server - -- | Union of two APIs, first takes precedence in case of overlap. -- -- Example: @@ -15,25 +9,3 @@ -- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books data a :<|> b = a :<|> b infixr 8 :<|> - --- | A server for @a ':<|>' b@ first tries to match the request again the route --- represented by @a@ and if it fails tries @b@. You must provide a request --- handler for each route. --- --- > type MyApi = "books" :> Get [Book] -- GET /books --- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books --- > --- > server :: Server MyApi --- > server = listAllBooks :<|> postBook --- > where listAllBooks = ... --- > postBook book = ... -instance (HasServer a, HasServer b) => HasServer (a :<|> b) where - type Server (a :<|> b) = Server a :<|> Server b - route Proxy (a :<|> b) request respond = - route pa a request $ \ mResponse -> - if isMismatch mResponse - then route pb b request $ \mResponse' -> respond (mResponse <> mResponse') - else respond mResponse - - where pa = Proxy :: Proxy a - pb = Proxy :: Proxy b diff --git a/src/Servant/API/Capture.hs b/src/Servant/API/Capture.hs --- a/src/Servant/API/Capture.hs +++ b/src/Servant/API/Capture.hs @@ -1,19 +1,6 @@ {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.Capture (Capture) where -import Data.Proxy -import Data.Text -import GHC.TypeLits -import Network.Wai -import Servant.API.Sub -import Servant.Common.Text -import Servant.Server - -- | Capture a value from the request path under a certain type @a@. -- -- Example: @@ -21,40 +8,3 @@ -- > -- GET /books/:isbn -- > type MyApi = "books" :> Capture "isbn" Text :> Get Book data Capture sym a - -captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a -captured _ = fromText - --- | If you use 'Capture' in one of the endpoints for your API, --- this automatically requires your server-side handler to be a function --- that takes an argument of the type specified by the 'Capture'. --- This lets servant worry about getting it from the URL and turning --- it into a value of the type you specify. --- --- 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" :> Capture "isbn" Text :> Get Book --- > --- > server :: Server MyApi --- > server = getBook --- > where getBook :: Text -> EitherT (Int, String) IO Book --- > getBook isbn = ... -instance (KnownSymbol capture, FromText a, HasServer sublayout) - => HasServer (Capture capture a :> sublayout) where - - type Server (Capture capture a :> sublayout) = - a -> Server sublayout - - route Proxy subserver request respond = case pathInfo request of - (first : rest) - -> case captured captureProxy first of - Nothing -> respond $ failWith NotFound - Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{ - pathInfo = rest - } respond - _ -> respond $ failWith NotFound - - where captureProxy = Proxy :: Proxy (Capture capture a) diff --git a/src/Servant/API/Delete.hs b/src/Servant/API/Delete.hs --- a/src/Servant/API/Delete.hs +++ b/src/Servant/API/Delete.hs @@ -1,16 +1,7 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Servant.API.Delete where -import Control.Monad.Trans.Either -import Data.Proxy -import Data.String.Conversions import Data.Typeable -import Network.HTTP.Types -import Network.Wai -import Servant.Server -- | Combinator for DELETE requests. -- @@ -20,29 +11,3 @@ -- > type MyApi = "books" :> Capture "isbn" Text :> Delete data Delete deriving Typeable - --- | If you have a 'Delete' endpoint in your API, --- the handler for this endpoint is meant to delete --- a resource. --- --- The code of the handler will, just like --- for 'Servant.API.Get.Get', 'Servant.API.Post.Post' and --- 'Servant.API.Put.Put', run in @EitherT (Int, String) IO ()@. --- The 'Int' represents the status code and the 'String' a message --- to be returned. You can use 'Control.Monad.Trans.Either.left' to --- painlessly error out if the conditions for a successful deletion --- are not met. -instance HasServer Delete where - type Server Delete = EitherT (Int, String) IO () - - route Proxy action request respond - | null (pathInfo request) && requestMethod request == methodDelete = do - e <- runEitherT action - respond $ succeedWith $ case e of - Right () -> - responseLBS status204 [] "" - Left (status, message) -> - responseLBS (mkStatus status (cs message)) [] (cs message) - | null (pathInfo request) && requestMethod request /= methodDelete = - respond $ failWith WrongMethod - | otherwise = respond $ failWith NotFound diff --git a/src/Servant/API/Get.hs b/src/Servant/API/Get.hs --- a/src/Servant/API/Get.hs +++ b/src/Servant/API/Get.hs @@ -1,17 +1,7 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Servant.API.Get where -import Control.Monad.Trans.Either -import Data.Aeson -import Data.Proxy -import Data.String.Conversions import Data.Typeable -import Network.HTTP.Types -import Network.Wai -import Servant.Server -- | Endpoint for simple GET requests. Serves the result as JSON. -- @@ -20,28 +10,3 @@ -- > type MyApi = "books" :> Get [Book] data Get a deriving Typeable - --- | When implementing the handler for a 'Get' endpoint, --- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post' --- and 'Servant.API.Put.Put', the handler code runs in the --- @EitherT (Int, String) IO@ monad, where the 'Int' represents --- the status code and the 'String' a message, returned in case of --- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left' --- to quickly fail if some conditions are not met. --- --- If successfully returning a value, we just require that its type has --- a 'ToJSON' instance and servant takes care of encoding it for you, --- yielding status code 200 along the way. -instance ToJSON result => HasServer (Get result) where - type Server (Get result) = EitherT (Int, String) IO result - route Proxy action request respond - | null (pathInfo request) && requestMethod request == methodGet = do - e <- runEitherT action - respond . succeedWith $ case e of - Right output -> - responseLBS ok200 [("Content-Type", "application/json")] (encode output) - Left (status, message) -> - responseLBS (mkStatus status (cs message)) [] (cs message) - | null (pathInfo request) && requestMethod request /= methodGet = - respond $ failWith WrongMethod - | otherwise = respond $ failWith NotFound diff --git a/src/Servant/API/Header.hs b/src/Servant/API/Header.hs --- a/src/Servant/API/Header.hs +++ b/src/Servant/API/Header.hs @@ -1,18 +1,7 @@ {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.Header where -import Data.Proxy -import Data.String -import Data.Text.Encoding (decodeUtf8) import GHC.TypeLits -import Network.Wai -import Servant.API.Sub -import Servant.Common.Text -import Servant.Server -- | Extract the given header's value as a value of type @a@. -- @@ -24,35 +13,3 @@ -- > -- GET /view-my-referer -- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer data Header sym a - --- | If you use 'Header' in one of the endpoints for your API, --- this automatically requires your server-side handler to be a function --- that takes an argument of the type specified by 'Header'. --- This lets servant worry about extracting it from the request and turning --- it into a value of the type you specify. --- --- All it asks is for a 'FromText' instance. --- --- Example: --- --- > newtype Referer = Referer Text --- > deriving (Eq, Show, FromText, ToText) --- > --- > -- GET /view-my-referer --- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer --- > --- > server :: Server MyApi --- > server = viewReferer --- > where viewReferer :: Referer -> EitherT (Int, String) IO referer --- > viewReferer referer = return referer -instance (KnownSymbol sym, FromText a, HasServer sublayout) - => HasServer (Header sym a :> sublayout) where - - type Server (Header sym a :> sublayout) = - Maybe a -> Server sublayout - - route Proxy subserver request respond = do - let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request) - route (Proxy :: Proxy sublayout) (subserver mheader) request respond - - where str = fromString $ symbolVal (Proxy :: Proxy sym) diff --git a/src/Servant/API/Post.hs b/src/Servant/API/Post.hs --- a/src/Servant/API/Post.hs +++ b/src/Servant/API/Post.hs @@ -1,17 +1,7 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Servant.API.Post where -import Control.Monad.Trans.Either -import Data.Aeson -import Data.Proxy -import Data.String.Conversions import Data.Typeable -import Network.HTTP.Types -import Network.Wai -import Servant.Server -- | Endpoint for POST requests. The type variable represents the type of the -- response body (not the request body, use 'Servant.API.RQBody.RQBody' for @@ -25,29 +15,3 @@ -- > type MyApi = "books" :> ReqBody Book :> Post Book data Post a deriving Typeable - --- | When implementing the handler for a 'Post' endpoint, --- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get' --- and 'Servant.API.Put.Put', the handler code runs in the --- @EitherT (Int, String) IO@ monad, where the 'Int' represents --- the status code and the 'String' a message, returned in case of --- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left' --- to quickly fail if some conditions are not met. --- --- If successfully returning a value, we just require that its type has --- a 'ToJSON' instance and servant takes care of encoding it for you, --- yielding status code 201 along the way. -instance ToJSON a => HasServer (Post a) where - type Server (Post a) = EitherT (Int, String) IO a - - route Proxy action request respond - | null (pathInfo request) && requestMethod request == methodPost = do - e <- runEitherT action - respond . succeedWith $ case e of - Right out -> - responseLBS status201 [("Content-Type", "application/json")] (encode out) - Left (status, message) -> - responseLBS (mkStatus status (cs message)) [] (cs message) - | null (pathInfo request) && requestMethod request /= methodPost = - respond $ failWith WrongMethod - | otherwise = respond $ failWith NotFound diff --git a/src/Servant/API/Put.hs b/src/Servant/API/Put.hs --- a/src/Servant/API/Put.hs +++ b/src/Servant/API/Put.hs @@ -1,17 +1,7 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Servant.API.Put where -import Control.Monad.Trans.Either -import Data.Aeson -import Data.Proxy -import Data.String.Conversions import Data.Typeable -import Network.HTTP.Types -import Network.Wai -import Servant.Server -- | Endpoint for PUT requests, usually used to update a ressource. -- The type @a@ is the type of the response body that's returned. @@ -23,30 +13,3 @@ -- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put Book data Put a deriving Typeable - --- | When implementing the handler for a 'Put' endpoint, --- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get' --- and 'Servant.API.Post.Post', the handler code runs in the --- @EitherT (Int, String) IO@ monad, where the 'Int' represents --- the status code and the 'String' a message, returned in case of --- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left' --- to quickly fail if some conditions are not met. --- --- If successfully returning a value, we just require that its type has --- a 'ToJSON' instance and servant takes care of encoding it for you, --- yielding status code 200 along the way. -instance ToJSON a => HasServer (Put a) where - type Server (Put a) = EitherT (Int, String) IO a - - route Proxy action request respond - | null (pathInfo request) && requestMethod request == methodPut = do - e <- runEitherT action - respond . succeedWith $ case e of - Right out -> - responseLBS ok200 [("Content-Type", "application/json")] (encode out) - Left (status, message) -> - responseLBS (mkStatus status (cs message)) [] (cs message) - | null (pathInfo request) && requestMethod request /= methodPut = - respond $ failWith WrongMethod - - | otherwise = respond $ failWith NotFound diff --git a/src/Servant/API/QueryParam.hs b/src/Servant/API/QueryParam.hs --- a/src/Servant/API/QueryParam.hs +++ b/src/Servant/API/QueryParam.hs @@ -1,22 +1,6 @@ {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.QueryParam where -import Data.Maybe -import Data.Proxy -import Data.String.Conversions -import GHC.TypeLits -import Network.HTTP.Types -import Network.Wai -import Servant.API.Sub -import Servant.Common.Text -import Servant.Server - -- | Lookup the value associated to the @sym@ query string parameter -- and try to extract it as a value of type @a@. -- @@ -26,46 +10,6 @@ -- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book] data QueryParam sym a --- | If you use @'QueryParam' "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" :> QueryParam "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 (QueryParam sym a :> sublayout) where - - type Server (QueryParam sym a :> sublayout) = - Maybe a -> Server sublayout - - route Proxy subserver request respond = do - let querytext = parseQueryText $ rawQueryString request - 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 - - where paramname = cs $ symbolVal (Proxy :: Proxy sym) - -- | Lookup the values associated to the @sym@ query string parameter -- and try to extract it as a value of type @[a]@. This is typically -- meant to support query string parameters of the form @@ -79,46 +23,6 @@ -- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book] data QueryParams sym a --- | If you use @'QueryParams' "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" :> QueryParams "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 (QueryParams sym a :> sublayout) where - - type Server (QueryParams sym a :> sublayout) = - [a] -> Server sublayout - - route Proxy subserver request respond = do - let querytext = parseQueryText $ rawQueryString request - -- if sym is "foo", we look for query string parameters - -- named "foo" or "foo[]" and call fromText on the - -- corresponding values - parameters = filter looksLikeParam querytext - values = catMaybes $ map (convert . snd) parameters - - route (Proxy :: Proxy sublayout) (subserver values) request respond - - where paramname = cs $ symbolVal (Proxy :: Proxy sym) - looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") - convert Nothing = Nothing - convert (Just v) = fromText v - -- | Lookup a potentially value-less query 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'. @@ -129,34 +33,3 @@ -- > -- /books?published -- > type MyApi = "books" :> QueryFlag "published" :> Get [Book] data QueryFlag sym - --- | If you use @'QueryFlag' "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" :> QueryFlag "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 (QueryFlag sym :> sublayout) where - - type Server (QueryFlag sym :> sublayout) = - Bool -> Server sublayout - - route Proxy subserver request respond = do - let querytext = parseQueryText $ rawQueryString request - param = case lookup paramname querytext 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 - - where paramname = cs $ symbolVal (Proxy :: Proxy sym) - examine v | v == "true" || v == "1" || v == "" = True - | otherwise = False diff --git a/src/Servant/API/Raw.hs b/src/Servant/API/Raw.hs --- a/src/Servant/API/Raw.hs +++ b/src/Servant/API/Raw.hs @@ -1,12 +1,5 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} module Servant.API.Raw where -import Data.Proxy -import Network.Wai -import Servant.Server - -- | Endpoint for plugging in your own Wai 'Application's. -- -- The given 'Application' will get the request as received by the server, potentially with @@ -17,16 +10,3 @@ -- static files stored in a particular directory on your filesystem, or to serve -- your API's documentation with 'Servant.Utils.StaticFiles.serveDocumentation'. data Raw - --- | Just pass the request to the underlying application and serve its response. --- --- Example: --- --- > type MyApi = "images" :> Raw --- > --- > server :: Server MyApi --- > server = serveDirectory "/var/www/images" -instance HasServer Raw where - type Server Raw = Application - route Proxy rawApplication request respond = - rawApplication request (respond . succeedWith) diff --git a/src/Servant/API/ReqBody.hs b/src/Servant/API/ReqBody.hs --- a/src/Servant/API/ReqBody.hs +++ b/src/Servant/API/ReqBody.hs @@ -1,17 +1,6 @@ {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.ReqBody where -import Control.Applicative -import Data.Aeson -import Data.Proxy -import Network.Wai -import Servant.API.Sub -import Servant.Server - -- | Extract the request body as a value of type @a@. -- -- Example: @@ -19,31 +8,3 @@ -- > -- POST /books -- > type MyApi = "books" :> ReqBody Book :> Post Book data ReqBody a - --- | If you use 'ReqBody' in one of the endpoints for your API, --- this automatically requires your server-side handler to be a function --- that takes an argument of the type specified by 'ReqBody'. --- This lets servant worry about extracting it from the request and turning --- it into a value of the type you specify. --- --- All it asks is for a 'FromJSON' instance. --- --- Example: --- --- > type MyApi = "books" :> ReqBody Book :> Post Book --- > --- > server :: Server MyApi --- > server = postBook --- > where postBook :: Book -> EitherT (Int, String) IO Book --- > postBook book = ...insert into your db... -instance (FromJSON a, HasServer sublayout) - => HasServer (ReqBody a :> sublayout) where - - type Server (ReqBody a :> sublayout) = - a -> Server sublayout - - route Proxy subserver request respond = do - mrqbody <- decode' <$> lazyRequestBody request - case mrqbody of - Nothing -> respond $ failWith InvalidBody - Just v -> route (Proxy :: Proxy sublayout) (subserver v) request respond diff --git a/src/Servant/API/Sub.hs b/src/Servant/API/Sub.hs --- a/src/Servant/API/Sub.hs +++ b/src/Servant/API/Sub.hs @@ -1,14 +1,9 @@ {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ScopedTypeVariables #-} module Servant.API.Sub where import Data.Proxy -import Data.String.Conversions import GHC.TypeLits -import Network.Wai -import Servant.Server -- | The contained API (second argument) can be found under @("/" ++ path)@ -- (path being the first argument). @@ -20,17 +15,3 @@ -- > type MyApi = "hello" :> "world" :> Get World data (path :: k) :> a = Proxy path :> a infixr 9 :> - --- | Make sure the incoming request starts with @"/path"@, strip it and --- 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 - (first : rest) - | first == cs (symbolVal proxyPath) - -> route (Proxy :: Proxy sublayout) subserver request{ - pathInfo = rest - } respond - _ -> respond $ failWith NotFound - - where proxyPath = Proxy :: Proxy path diff --git a/src/Servant/QQ.hs b/src/Servant/QQ.hs --- a/src/Servant/QQ.hs +++ b/src/Servant/QQ.hs @@ -26,7 +26,7 @@ -- @ -- -- Note the @/@ before a @QueryParam@! -module Servant.QQ where +module Servant.QQ (sitemap) where import Control.Monad (void) import Control.Applicative hiding (many, (<|>), optional) diff --git a/src/Servant/Server.hs b/src/Servant/Server.hs deleted file mode 100644 --- a/src/Servant/Server.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} - --- | This module lets you implement 'Server's for defined APIs. You'll --- most likely just need 'serve'. -module Servant.Server where - -import Data.Monoid -import Data.Proxy -import Network.HTTP.Types -import Network.Wai - --- * Implementing Servers - --- | 'serve' allows you to implement an API and produce a wai 'Application'. --- --- Example: --- --- > type MyApi = "books" :> Get [Book] -- GET /books --- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books --- > --- > server :: Server MyApi --- > server = listAllBooks :<|> postBook --- > where listAllBooks = ... --- > postBook book = ... --- > --- > app :: Application --- > app = serve myApi server --- > --- > main :: IO () --- > main = Network.Wai.Handler.Warp.run 8080 app -serve :: HasServer layout => Proxy layout -> Server layout -> Application -serve p server = toApplication (route p server) - -toApplication :: RoutingApplication -> Application -toApplication ra request respond = do - ra request (routingRespond . routeResult) - where - routingRespond :: Either RouteMismatch Response -> IO ResponseReceived - routingRespond (Left NotFound) = - respond $ responseLBS notFound404 [] "not found" - routingRespond (Left WrongMethod) = - respond $ responseLBS methodNotAllowed405 [] "method not allowed" - routingRespond (Left InvalidBody) = - respond $ responseLBS badRequest400 [] "Invalid JSON in request body" - routingRespond (Right response) = - respond response - --- * Route mismatch -data RouteMismatch = - NotFound -- ^ the usual "not found" error - | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error - | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error - deriving (Eq, Show) - --- | --- @ --- > mempty = NotFound --- > --- > NotFound `mappend` x = x --- > WrongMethod `mappend` InvalidBody = InvalidBody --- > WrongMethod `mappend` _ = WrongMethod --- > InvalidBody `mappend` _ = InvalidBody --- @ -instance Monoid RouteMismatch where - mempty = NotFound - - NotFound `mappend` x = x - WrongMethod `mappend` InvalidBody = InvalidBody - WrongMethod `mappend` _ = WrongMethod - InvalidBody `mappend` _ = InvalidBody - --- | A wrapper around @'Either' 'RouteMismatch' a@. -newtype RouteResult a = - RR { routeResult :: Either RouteMismatch a } - deriving (Eq, Show) - -failWith :: RouteMismatch -> RouteResult a -failWith = RR . Left - -succeedWith :: a -> RouteResult a -succeedWith = RR . Right - -isMismatch :: RouteResult a -> Bool -isMismatch (RR (Left _)) = True -isMismatch _ = False - --- | If we get a `Right`, it has precedence over everything else. --- --- This in particular means that if we could get several 'Right's, --- only the first we encounter would be taken into account. -instance Monoid (RouteResult a) where - mempty = RR $ Left mempty - - RR (Left x) `mappend` RR (Left y) = RR $ Left (x <> y) - RR (Left _) `mappend` RR (Right y) = RR $ Right y - r `mappend` _ = r - -type RoutingApplication = - Request -- ^ the request, the field 'pathInfo' may be modified by url routing - -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived - -class HasServer layout where - type Server layout :: * - route :: Proxy layout -> Server layout -> RoutingApplication diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs --- a/src/Servant/Utils/Links.hs +++ b/src/Servant/Utils/Links.hs @@ -33,7 +33,20 @@ -- and part of the sitemap. -- -- __N.B.:__ 'mkLink' assumes a capture matches any string (without slashes). -module Servant.Utils.Links where +module Servant.Utils.Links ( + -- * Link and mkLink + -- | The only end-user utilities + mkLink + , Link + -- * Internal + -- | These functions will likely only be of interest if you are writing + -- more API combinators and would like to extend the behavior of + -- 'mkLink' + , ValidLinkIn() + , VLinkHelper(..) + , IsElem + , IsLink + )where import Data.Proxy import GHC.TypeLits @@ -94,6 +107,9 @@ , VLinkHelper f) => ValidLinkIn f s where mkLink _ _ = Link (vlh (Proxy :: Proxy f)) +-- | A safe link datatype. +-- The only way of constructing a 'Link' is using 'mkLink', which means any +-- 'Link' is guaranteed to be part of the mentioned API. data Link = Link String deriving Show class VLinkHelper f where diff --git a/src/Servant/Utils/StaticFiles.hs b/src/Servant/Utils/StaticFiles.hs deleted file mode 100644 --- a/src/Servant/Utils/StaticFiles.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | This module defines a sever-side handler that lets you serve static files. --- --- - 'serveDirectory' lets you serve anything that lives under a particular --- directory on your filesystem. -module Servant.Utils.StaticFiles ( - serveDirectory, - ) where - -import Filesystem.Path.CurrentOS (decodeString) -import Network.Wai.Application.Static -import Servant.API.Raw -import Servant.Server - --- | Serve anything under the specified directory as a 'Raw' endpoint. --- --- @ --- type MyApi = "static" :> Raw --- --- server :: Server MyApi --- server = serveDirectory "\/var\/www" --- @ --- --- would capture any request to @\/static\/\@ and look for --- @\@ under @\/var\/www@. --- --- It will do its best to guess the MIME type for that file, based on the extension, --- and send an appropriate /Content-Type/ header if possible. --- --- If your goal is to serve HTML, CSS and Javascript files that use the rest of the API --- as a webapp backend, you will most likely not want the static files to be hidden --- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory' --- handler in the last position, because /servant/ will try to match the handlers --- in order. -serveDirectory :: FilePath -> Server Raw -serveDirectory documentRoot = - staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))