From 6836eb6bccdef13af935085912499f17f33bba65 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 10 Dec 2014 16:11:57 +0100 Subject: [PATCH] add split server-side bits into servant-server --- example/README.md | 2 - example/greet.hs | 72 ------- example/greet.md | 52 ------ servant.cabal | 130 +------------ src/Servant.hs | 24 --- src/Servant/API.hs | 2 - src/Servant/API/Alternative.hs | 28 --- src/Servant/API/Capture.hs | 50 ----- src/Servant/API/Delete.hs | 35 ---- src/Servant/API/Get.hs | 35 ---- src/Servant/API/Header.hs | 43 ----- src/Servant/API/Post.hs | 36 ---- src/Servant/API/Put.hs | 37 ---- src/Servant/API/QueryParam.hs | 127 ------------- src/Servant/API/Raw.hs | 20 -- src/Servant/API/ReqBody.hs | 40 ---- src/Servant/API/Sub.hs | 19 -- src/Servant/Server.hs | 105 ----------- src/Servant/Utils/StaticFiles.hs | 36 ---- test/Servant/ServerSpec.hs | 258 -------------------------- test/Servant/Utils/StaticFilesSpec.hs | 64 ------- 21 files changed, 7 insertions(+), 1208 deletions(-) delete mode 100644 example/README.md delete mode 100644 example/greet.hs delete mode 100644 example/greet.md delete mode 100644 src/Servant.hs delete mode 100644 src/Servant/Server.hs delete mode 100644 src/Servant/Utils/StaticFiles.hs delete mode 100644 test/Servant/ServerSpec.hs delete mode 100644 test/Servant/Utils/StaticFilesSpec.hs diff --git a/example/README.md b/example/README.md deleted file mode 100644 index a787d7c7..00000000 --- a/example/README.md +++ /dev/null @@ -1,2 +0,0 @@ -- `greet.hs` shows how to write a simple webservice, run it, query it with automatically-derived haskell functions and print the (generated) markdown documentation for the API. -- `greet.md` contains the aforementionned generated documentation. \ No newline at end of file diff --git a/example/greet.hs b/example/greet.hs deleted file mode 100644 index 822559d6..00000000 --- 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/example/greet.md b/example/greet.md deleted file mode 100644 index 149c3d59..00000000 --- a/example/greet.md +++ /dev/null @@ -1,52 +0,0 @@ -POST /greet ------------ - -**Request Body**: - -``` javascript -{"msg":"Hello, haskeller!"} -``` - -**Response**: - - - Status code 201 - - Response body as below. - -``` javascript -{"msg":"Hello, haskeller!"} -``` - -GET /hello/:name ----------------- - -**Captures**: - -- *name*: name of the person to greet - -**GET Parameters**: - - - capital - - **Values**: *true, false* - - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false. - - -**Response**: - - - Status code 200 - - Response body as below. - -``` javascript -{"msg":"Hello, haskeller!"} -``` - -DELETE /greet/:greetid ----------------------- - -**Captures**: - -- *greetid*: identifier of the greet msg to remove - -**Response**: - - - Status code 204 - - No response body diff --git a/servant.cabal b/servant.cabal index 46158ac4..dce0d075 100644 --- 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 @@ source-repository head library exposed-modules: - Servant Servant.API Servant.API.Alternative Servant.API.Capture @@ -114,45 +39,17 @@ library 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 @@ test-suite spec 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 index 0a92f8dd..00000000 --- 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 index bc2eab22..67064ec7 100644 --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -29,7 +29,6 @@ module Servant.API ( -- * 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.ReqBody 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 index d8a73e59..708aeee0 100644 --- 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 @@ import Servant.Server -- > :<|> "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 index fd92fd23..54b71f5b 100644 --- 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 @@ import Servant.Server -- > -- 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 index 8e6690be..7de045db 100644 --- 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 @@ import Servant.Server -- > 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 index d3d2f406..65a3235a 100644 --- 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 @@ import Servant.Server -- > 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 index cf19bc6e..5dc25e17 100644 --- 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 @@ import Servant.Server -- > -- 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 index a9600b29..392fbb75 100644 --- 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 @@ import Servant.Server -- > 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 index 527fc4e7..d423caaa 100644 --- 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 @@ import Servant.Server -- > 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 index 49978db3..d8a93233 100644 --- 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 @@ import Servant.Server -- > 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 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout) -- > 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 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout) -- > -- /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 index 2d8d175a..fddfd461 100644 --- 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 @@ import Servant.Server -- 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 index 2e6aabb9..b601da16 100644 --- a/src/Servant/API/ReqBody.hs +++ b/src/Servant/API/ReqBody.hs @@ -1,17 +1,5 @@ -{-# 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 +7,3 @@ import Servant.Server -- > -- 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 index 06a3ff84..d7bfc2ba 100644 --- 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 @@ import Servant.Server -- > 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/Server.hs b/src/Servant/Server.hs deleted file mode 100644 index 3dc6f168..00000000 --- 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/StaticFiles.hs b/src/Servant/Utils/StaticFiles.hs deleted file mode 100644 index a8a05ed4..00000000 --- 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 ++ "/"))) diff --git a/test/Servant/ServerSpec.hs b/test/Servant/ServerSpec.hs deleted file mode 100644 index 38313136..00000000 --- a/test/Servant/ServerSpec.hs +++ /dev/null @@ -1,258 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - -module Servant.ServerSpec where - - -import Control.Monad.Trans.Either -import Data.Aeson -import Data.Char -import Data.Proxy -import Data.String -import Data.String.Conversions -import GHC.Generics -import Network.HTTP.Types -import Network.Wai -import Network.Wai.Test -import Test.Hspec -import Test.Hspec.Wai - -import Servant.API.Capture -import Servant.API.Get -import Servant.API.ReqBody -import Servant.API.Post -import Servant.API.QueryParam -import Servant.API.Raw -import Servant.API.Sub -import Servant.API.Alternative -import Servant.Server - - --- * test data types - -data Person = Person { - name :: String, - age :: Integer - } - deriving (Eq, Show, Generic) - -instance ToJSON Person -instance FromJSON Person - -alice :: Person -alice = Person "Alice" 42 - -data Animal = Animal { - species :: String, - numberOfLegs :: Integer - } - deriving (Eq, Show, Generic) - -instance ToJSON Animal -instance FromJSON Animal - -jerry :: Animal -jerry = Animal "Mouse" 4 - -tweety :: Animal -tweety = Animal "Bird" 2 - - --- * specs - -spec :: Spec -spec = do - captureSpec - getSpec - queryParamSpec - postSpec - rawSpec - unionSpec - - -type CaptureApi = Capture "legs" Integer :> Get Animal -captureApi :: Proxy CaptureApi -captureApi = Proxy -captureServer :: Integer -> EitherT (Int, String) IO Animal -captureServer legs = case legs of - 4 -> return jerry - 2 -> return tweety - _ -> left (404, "not found") - -captureSpec :: Spec -captureSpec = do - describe "Servant.API.Capture" $ do - with (return (serve captureApi captureServer)) $ do - it "can capture parts of the 'pathInfo'" $ do - response <- get "/2" - liftIO $ do - decode' (simpleBody response) `shouldBe` Just tweety - - with (return (serve - (Proxy :: Proxy (Capture "captured" String :> Raw)) - (\ "captured" request respond -> - respond $ responseLBS ok200 [] (cs $ show $ pathInfo request)))) $ do - it "strips the captured path snippet from pathInfo" $ do - get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String])) - - -type GetApi = Get Person -getApi :: Proxy GetApi -getApi = Proxy - -getSpec :: Spec -getSpec = do - describe "Servant.API.Get" $ do - with (return (serve getApi (return alice))) $ do - it "allows to GET a Person" $ do - response <- get "/" - return response `shouldRespondWith` 200 - liftIO $ do - decode' (simpleBody response) `shouldBe` Just alice - - it "throws 405 (wrong method) on POSTs" $ do - post "/" "" `shouldRespondWith` 405 - - -type QueryParamApi = QueryParam "name" String :> Get Person - :<|> "a" :> QueryParams "names" String :> Get Person - :<|> "b" :> QueryFlag "capitalize" :> Get Person - -queryParamApi :: Proxy QueryParamApi -queryParamApi = Proxy - -qpServer :: Server QueryParamApi -qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize - - where qpNames (_:name2:_) = return alice { name = name2 } - qpNames _ = return alice - - qpCapitalize False = return alice - qpCapitalize True = return alice { name = map toUpper (name alice) } - - queryParamServer (Just name) = return alice{name = name} - queryParamServer Nothing = return alice - -queryParamSpec :: Spec -queryParamSpec = do - describe "Servant.API.QueryParam" $ do - it "allows to retrieve simple GET parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params1 = "?name=bob" - response1 <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params1, - queryString = parseQuery params1 - } - liftIO $ do - decode' (simpleBody response1) `shouldBe` Just alice{ - name = "bob" - } - - it "allows to retrieve lists in GET parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params2 = "?names[]=bob&names[]=john" - response2 <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params2, - queryString = parseQuery params2, - pathInfo = ["a"] - } - liftIO $ - decode' (simpleBody response2) `shouldBe` Just alice{ - name = "john" - } - - it "allows to retrieve value-less GET parameters" $ - (flip runSession) (serve queryParamApi qpServer) $ do - let params3 = "?capitalize" - response3 <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params3, - queryString = parseQuery params3, - pathInfo = ["b"] - } - liftIO $ - decode' (simpleBody response3) `shouldBe` Just alice{ - name = "ALICE" - } - - let params3' = "?capitalize=" - response3' <- Network.Wai.Test.request defaultRequest{ - rawQueryString = params3', - queryString = parseQuery params3', - pathInfo = ["b"] - } - liftIO $ - decode' (simpleBody response3') `shouldBe` Just alice{ - name = "ALICE" - } - -type PostApi = ReqBody Person :> Post Integer -postApi :: Proxy PostApi -postApi = Proxy - -postSpec :: Spec -postSpec = do - describe "Servant.API.Post and .ReqBody" $ do - with (return (serve postApi (return . age))) $ do - it "allows to POST a Person" $ do - post "/" (encode alice) `shouldRespondWith` "42"{ - matchStatus = 201 - } - - it "correctly rejects invalid request bodies with status 400" $ do - post "/" "some invalid body" `shouldRespondWith` 400 - - -type RawApi = "foo" :> Raw -rawApi :: Proxy RawApi -rawApi = Proxy -rawApplication :: Show a => (Request -> a) -> Application -rawApplication f request respond = respond $ responseLBS ok200 [] (cs $ show $ f request) - -rawSpec :: Spec -rawSpec = do - describe "Servant.API.Raw" $ do - it "runs applications" $ do - (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do - response <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["foo"] - } - liftIO $ do - simpleBody response `shouldBe` "42" - - it "gets the pathInfo modified" $ do - (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do - response <- Network.Wai.Test.request defaultRequest{ - pathInfo = ["foo", "bar"] - } - liftIO $ do - simpleBody response `shouldBe` cs (show ["bar" :: String]) - - -type AlternativeApi = - "foo" :> Get Person - :<|> "bar" :> Get Animal -unionApi :: Proxy AlternativeApi -unionApi = Proxy - -unionServer :: Server AlternativeApi -unionServer = - return alice - :<|> return jerry - -unionSpec :: Spec -unionSpec = do - describe "Servant.API.Alternative" $ do - with (return $ serve unionApi unionServer) $ do - it "unions endpoints" $ do - response <- get "/foo" - liftIO $ do - decode' (simpleBody response) `shouldBe` - Just alice - response <- get "/bar" - liftIO $ do - decode' (simpleBody response) `shouldBe` - Just jerry diff --git a/test/Servant/Utils/StaticFilesSpec.hs b/test/Servant/Utils/StaticFilesSpec.hs deleted file mode 100644 index 8d34f90f..00000000 --- a/test/Servant/Utils/StaticFilesSpec.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Servant.Utils.StaticFilesSpec where - -import Control.Exception -import Data.Proxy -import Network.Wai -import System.Directory -import System.IO.Temp -import Test.Hspec hiding (pending) -import Test.Hspec.Wai - -import Servant.API.Alternative -import Servant.API.Capture -import Servant.API.Get -import Servant.API.Raw -import Servant.API.Sub -import Servant.Server -import Servant.ServerSpec -import Servant.Utils.StaticFiles - -type Api = - "dummy_api" :> Capture "person_name" String :> Get Person - :<|> "static" :> Raw - - -api :: Proxy Api -api = Proxy - -app :: Application -app = serve api server - -server :: Server Api -server = - (\ name -> return (Person name 42)) - :<|> serveDirectory "static" - -withStaticFiles :: IO () -> IO () -withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir -> - bracket (setup tmpDir) teardown (const action) - where - setup tmpDir = do - outer <- getCurrentDirectory - setCurrentDirectory tmpDir - createDirectory "static" - writeFile "static/foo.txt" "bar" - writeFile "static/index.html" "index" - return outer - - teardown outer = do - setCurrentDirectory outer - -spec :: Spec -spec = do - around_ withStaticFiles $ with (return app) $ do - describe "serveDirectory" $ do - it "successfully serves files" $ do - get "/static/foo.txt" `shouldRespondWith` "bar" - - it "serves the contents of index.html when requesting the root of a directory" $ do - get "/static" `shouldRespondWith` "index"