git.iko.soy/typeable/servant
on cec89c1 help sign in
b3279d9
swap
1 ahead, 2309 behind
LICENSEdeleted−30
since splitsnapshots
unifiedsplit
@@ -1,30 +0,0 @@
1−Copyright (c) 2014, Zalora South East Asia Pte Ltd
2−
3−All rights reserved.
4−
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are met:
7−
8− * Redistributions of source code must retain the above copyright
9− notice, this list of conditions and the following disclaimer.
10−
11− * Redistributions in binary form must reproduce the above
12− copyright notice, this list of conditions and the following
13− disclaimer in the documentation and/or other materials provided
14− with the distribution.
15−
16− * Neither the name of Zalora South East Asia Pte Ltd nor the names of other
17− contributors may be used to endorse or promote products derived
18− from this software without specific prior written permission.
19−
20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
example/README.mddeleted−2
@@ -1,2 +0,0 @@
1−- `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.
2−- `greet.md` contains the aforementionned generated documentation.
example/greet.hsdeleted−72
@@ -1,72 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE PolyKinds #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE DeriveGeneric #-}
5−{-# LANGUAGE TypeOperators #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−
8−import Data.Aeson
9−import Data.Monoid
10−import Data.Proxy
11−import Data.Text
12−import GHC.Generics
13−import Network.Wai
14−import Network.Wai.Handler.Warp
15−
16−import Servant
17−
18−-- * Example
19−
20−-- | A greet message data type
21−newtype Greet = Greet { msg :: Text }
22− deriving (Generic, Show)
23−
24−instance FromJSON Greet
25−instance ToJSON Greet
26−
27−-- API specification
28−type TestApi =
29− -- GET /hello/:name?capital={true, false} returns a Greet as JSON
30− "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
31−
32− -- POST /greet with a Greet as JSON in the request body,
33− -- returns a Greet as JSON
34− :<|> "greet" :> ReqBody Greet :> Post Greet
35−
36− -- DELETE /greet/:greetid
37− :<|> "greet" :> Capture "greetid" Text :> Delete
38−
39−testApi :: Proxy TestApi
40−testApi = Proxy
41−
42−-- Server-side handlers.
43−--
44−-- There's one handler per endpoint, which, just like in the type
45−-- that represents the API, are glued together using :<|>.
46−--
47−-- Each handler runs in the 'EitherT (Int, String) IO' monad.
48−server :: Server TestApi
49−server = helloH :<|> postGreetH :<|> deleteGreetH
50−
51− where helloH name Nothing = helloH name (Just False)
52− helloH name (Just False) = return . Greet $ "Hello, " <> name
53− helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
54−
55− postGreetH greet = return greet
56−
57− deleteGreetH _ = return ()
58−
59−-- Turn the server into a WAI app. 'serve' is provided by servant,
60−-- more precisely by the Servant.Server module.
61−test :: Application
62−test = serve testApi server
63−
64−-- Run the server.
65−--
66−-- 'run' comes from Network.Wai.Handler.Warp
67−runTestServer :: Port -> IO ()
68−runTestServer port = run port test
69−
70−-- Put this all to work!
71−main :: IO ()
72−main = runTestServer 8001
example/greet.mddeleted−52
@@ -1,52 +0,0 @@
1−POST /greet
2−-----------
3−
4−**Request Body**:
5−
6−``` javascript
7−{"msg":"Hello, haskeller!"}
8−```
9−
10−**Response**:
11−
12− - Status code 201
13− - Response body as below.
14−
15−``` javascript
16−{"msg":"Hello, haskeller!"}
17−```
18−
19−GET /hello/:name
20−----------------
21−
22−**Captures**:
23−
24−- *name*: name of the person to greet
25−
26−**GET Parameters**:
27−
28− - capital
29− - **Values**: *true, false*
30− - **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
31−
32−
33−**Response**:
34−
35− - Status code 200
36− - Response body as below.
37−
38−``` javascript
39−{"msg":"Hello, haskeller!"}
40−```
41−
42−DELETE /greet/:greetid
43−----------------------
44−
45−**Captures**:
46−
47−- *greetid*: identifier of the greet msg to remove
48−
49−**Response**:
50−
51− - Status code 204
52− - No response body
servant.cabaldeleted−97
@@ -1,97 +0,0 @@
1−name: servant
2−version: 0.2
3−-- synopsis:
4−-- description:
5−license: BSD3
6−license-file: LICENSE
7−author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni
8−maintainer: alpmestan@gmail.com
9−copyright: 2014 Zalora South East Asia Pte Ltd
10−category: Web
11−build-type: Simple
12−cabal-version: >=1.10
13−tested-with: GHC >= 7.8
14−
15−library
16− exposed-modules:
17− Servant
18− Servant.API
19− Servant.API.Alternative
20− Servant.API.Capture
21− Servant.API.Delete
22− Servant.API.Get
23− Servant.API.Post
24− Servant.API.Put
25− Servant.API.QueryParam
26− Servant.API.Raw
27− Servant.API.ReqBody
28− Servant.API.Sub
29− Servant.Common.Text
30− Servant.QQ
31− Servant.Server
32− Servant.Utils.Links
33− Servant.Utils.StaticFiles
34− build-depends:
35− base >=4.7 && <5
36− , aeson
37− , attoparsec
38− , bytestring
39− , either
40− , http-types
41− , network-uri >= 2.6
42− , parsec
43− , safe
44− , split
45− , string-conversions
46− , system-filepath
47− , template-haskell
48− , text
49− , transformers
50− , wai
51− , wai-app-static
52− , warp
53− hs-source-dirs: src
54− default-language: Haskell2010
55− ghc-options: -O0 -Wall
56−
57−executable greet
58− main-is: greet.hs
59− hs-source-dirs: example
60− ghc-options: -O0 -Wall
61− default-language: Haskell2010
62− build-depends:
63− base
64− , servant
65− , aeson
66− , warp
67− , wai
68− , text
69−
70−test-suite spec
71− type: exitcode-stdio-1.0
72− ghc-options:
73− -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures
74− default-language: Haskell2010
75− hs-source-dirs: test
76− main-is: Spec.hs
77− build-depends:
78− base == 4.*
79− , aeson
80− , bytestring
81− , directory
82− , either
83− , exceptions
84− , hspec == 2.*
85− , hspec-wai
86− , http-types
87− , network >= 2.6
88− , QuickCheck
89− , parsec
90− , servant
91− , string-conversions
92− , temporary
93− , text
94− , transformers
95− , wai
96− , wai-extra
97− , warp
src/Servant.hsdeleted−24
@@ -1,24 +0,0 @@
1−module Servant (
2− -- | This module and its submodules can be used to define servant APIs. Note
3− -- that these API definitions don't directly implement a server (or anything
4− -- else).
5− module Servant.API,
6− -- | For implementing servers for servant APIs.
7− module Servant.Server,
8− -- | Using your types in request paths and query string parameters
9− module Servant.Common.Text,
10− -- | Utilities on top of the servant core
11− module Servant.QQ,
12− module Servant.Utils.Links,
13− module Servant.Utils.StaticFiles,
14− -- | Useful re-exports
15− Proxy(..),
16− ) where
17−
18−import Data.Proxy
19−import Servant.API
20−import Servant.Common.Text
21−import Servant.Server
22−import Servant.QQ
23−import Servant.Utils.Links
24−import Servant.Utils.StaticFiles
src/Servant/API.hsdeleted−51
@@ -1,51 +0,0 @@
1−module Servant.API (
2−
3− -- * Combinators
4− -- | Type-level combinator for expressing subrouting: @':>'@
5− module Servant.API.Sub,
6− -- | Type-level combinator for alternative endpoints: @':<|>'@
7− module Servant.API.Alternative,
8−
9− -- * Accessing information from the request
10− -- | Capturing parts of the url path as parsed values: @'Capture'@
11− module Servant.API.Capture,
12− -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@
13− module Servant.API.QueryParam,
14− -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@
15− module Servant.API.ReqBody,
16−
17− -- * Actual endpoints, distinguished by HTTP method
18− -- | GET requests
19− module Servant.API.Get,
20− -- | POST requests
21− module Servant.API.Post,
22− -- | DELETE requests
23− module Servant.API.Delete,
24− -- | PUT requests
25− module Servant.API.Put,
26−
27− -- * Untyped endpoints
28− -- | Plugging in a wai 'Network.Wai.Application', serving directories
29− module Servant.API.Raw,
30− module Servant.Utils.StaticFiles,
31−
32− -- * Utilities
33− -- | QuasiQuotes for endpoints
34− module Servant.QQ,
35− -- | Type-safe internal URLs
36− module Servant.Utils.Links,
37− ) where
38−
39−import Servant.API.Alternative
40−import Servant.API.Capture
41−import Servant.API.Delete
42−import Servant.API.Get
43−import Servant.API.Post
44−import Servant.API.Put
45−import Servant.API.QueryParam
46−import Servant.API.Raw
47−import Servant.API.ReqBody
48−import Servant.API.Sub
49−import Servant.QQ (sitemap)
50−import Servant.Utils.Links (mkLink)
51−import Servant.Utils.StaticFiles
src/Servant/API/Alternative.hsdeleted−39
@@ -1,39 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE TypeOperators #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−module Servant.API.Alternative where
5−
6−import Data.Monoid
7−import Data.Proxy
8−import Servant.Server
9−
10−-- | Union of two APIs, first takes precedence in case of overlap.
11−--
12−-- Example:
13−--
14−-- > type MyApi = "books" :> Get [Book] -- GET /books
15−-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
16−data a :<|> b = a :<|> b
17−infixr 8 :<|>
18−
19−-- | A server for @a ':<|>' b@ first tries to match the request again the route
20−-- represented by @a@ and if it fails tries @b@. You must provide a request
21−-- handler for each route.
22−--
23−-- > type MyApi = "books" :> Get [Book] -- GET /books
24−-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
25−-- >
26−-- > server :: Server MyApi
27−-- > server = listAllBooks :<|> postBook
28−-- > where listAllBooks = ...
29−-- > postBook book = ...
30−instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
31− type Server (a :<|> b) = Server a :<|> Server b
32− route Proxy (a :<|> b) request respond =
33− route pa a request $ \ mResponse ->
34− if isMismatch mResponse
35− then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
36− else respond mResponse
37−
38− where pa = Proxy :: Proxy a
39− pb = Proxy :: Proxy b
src/Servant/API/Capture.hsdeleted−60
@@ -1,60 +0,0 @@
1−{-# LANGUAGE PolyKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE TypeOperators #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
7−module Servant.API.Capture (Capture) where
8−
9−import Data.Proxy
10−import Data.Text
11−import GHC.TypeLits
12−import Network.Wai
13−import Servant.API.Sub
14−import Servant.Common.Text
15−import Servant.Server
16−
17−-- | Capture a value from the request path under a certain type @a@.
18−--
19−-- Example:
20−--
21−-- > -- GET /books/:isbn
22−-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book
23−data Capture sym a
24−
25−captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a
26−captured _ = fromText
27−
28−-- | If you use 'Capture' in one of the endpoints for your API,
29−-- this automatically requires your server-side handler to be a function
30−-- that takes an argument of the type specified by the 'Capture'.
31−-- This lets servant worry about getting it from the URL and turning
32−-- it into a value of the type you specify.
33−--
34−-- You can control how it'll be converted from 'Text' to your type
35−-- by simply providing an instance of 'FromText' for your type.
36−--
37−-- Example:
38−--
39−-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book
40−-- >
41−-- > server :: Server MyApi
42−-- > server = getBook
43−-- > where getBook :: Text -> EitherT (Int, String) IO Book
44−-- > getBook isbn = ...
45−instance (KnownSymbol capture, FromText a, HasServer sublayout)
46− => HasServer (Capture capture a :> sublayout) where
47−
48− type Server (Capture capture a :> sublayout) =
49− a -> Server sublayout
50−
51− route Proxy subserver request respond = case pathInfo request of
52− (first : rest)
53− -> case captured captureProxy first of
54− Nothing -> respond $ failWith NotFound
55− Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{
56− pathInfo = rest
57− } respond
58− _ -> respond $ failWith NotFound
59−
60− where captureProxy = Proxy :: Proxy (Capture capture a)
src/Servant/API/Delete.hsdeleted−48
@@ -1,48 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−module Servant.API.Delete where
6−
7−import Control.Monad.Trans.Either
8−import Data.Proxy
9−import Data.String.Conversions
10−import Data.Typeable
11−import Network.HTTP.Types
12−import Network.Wai
13−import Servant.Server
14−
15−-- | Combinator for DELETE requests.
16−--
17−-- Example:
18−--
19−-- > -- DELETE /books/:isbn
20−-- > type MyApi = "books" :> Capture "isbn" Text :> Delete
21−data Delete
22− deriving Typeable
23−
24−-- | If you have a 'Delete' endpoint in your API,
25−-- the handler for this endpoint is meant to delete
26−-- a resource.
27−--
28−-- The code of the handler will, just like
29−-- for 'Servant.API.Get.Get', 'Servant.API.Post.Post' and
30−-- 'Servant.API.Put.Put', run in @EitherT (Int, String) IO ()@.
31−-- The 'Int' represents the status code and the 'String' a message
32−-- to be returned. You can use 'Control.Monad.Trans.Either.left' to
33−-- painlessly error out if the conditions for a successful deletion
34−-- are not met.
35−instance HasServer Delete where
36− type Server Delete = EitherT (Int, String) IO ()
37−
38− route Proxy action request respond
39− | null (pathInfo request) && requestMethod request == methodDelete = do
40− e <- runEitherT action
41− respond $ succeedWith $ case e of
42− Right () ->
43− responseLBS status204 [] ""
44− Left (status, message) ->
45− responseLBS (mkStatus status (cs message)) [] (cs message)
46− | null (pathInfo request) && requestMethod request /= methodDelete =
47− respond $ failWith WrongMethod
48− | otherwise = respond $ failWith NotFound
src/Servant/API/Get.hsdeleted−47
@@ -1,47 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−module Servant.API.Get where
6−
7−import Control.Monad.Trans.Either
8−import Data.Aeson
9−import Data.Proxy
10−import Data.String.Conversions
11−import Data.Typeable
12−import Network.HTTP.Types
13−import Network.Wai
14−import Servant.Server
15−
16−-- | Endpoint for simple GET requests. Serves the result as JSON.
17−--
18−-- Example:
19−--
20−-- > type MyApi = "books" :> Get [Book]
21−data Get a
22− deriving Typeable
23−
24−-- | When implementing the handler for a 'Get' endpoint,
25−-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post'
26−-- and 'Servant.API.Put.Put', the handler code runs in the
27−-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
28−-- the status code and the 'String' a message, returned in case of
29−-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
30−-- to quickly fail if some conditions are not met.
31−--
32−-- If successfully returning a value, we just require that its type has
33−-- a 'ToJSON' instance and servant takes care of encoding it for you,
34−-- yielding status code 200 along the way.
35−instance ToJSON result => HasServer (Get result) where
36− type Server (Get result) = EitherT (Int, String) IO result
37− route Proxy action request respond
38− | null (pathInfo request) && requestMethod request == methodGet = do
39− e <- runEitherT action
40− respond . succeedWith $ case e of
41− Right output ->
42− responseLBS ok200 [("Content-Type", "application/json")] (encode output)
43− Left (status, message) ->
44− responseLBS (mkStatus status (cs message)) [] (cs message)
45− | null (pathInfo request) && requestMethod request /= methodGet =
46− respond $ failWith WrongMethod
47− | otherwise = respond $ failWith NotFound
src/Servant/API/Post.hsdeleted−53
@@ -1,53 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−module Servant.API.Post where
6−
7−import Control.Monad.Trans.Either
8−import Data.Aeson
9−import Data.Proxy
10−import Data.String.Conversions
11−import Data.Typeable
12−import Network.HTTP.Types
13−import Network.Wai
14−import Servant.Server
15−
16−-- | Endpoint for POST requests. The type variable represents the type of the
17−-- response body (not the request body, use 'Servant.API.RQBody.RQBody' for
18−-- that).
19−--
20−-- Example:
21−--
22−-- > -- POST /books
23−-- > -- with a JSON encoded Book as the request body
24−-- > -- returning the just-created Book
25−-- > type MyApi = "books" :> ReqBody Book :> Post Book
26−data Post a
27− deriving Typeable
28−
29−-- | When implementing the handler for a 'Post' endpoint,
30−-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
31−-- and 'Servant.API.Put.Put', the handler code runs in the
32−-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
33−-- the status code and the 'String' a message, returned in case of
34−-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
35−-- to quickly fail if some conditions are not met.
36−--
37−-- If successfully returning a value, we just require that its type has
38−-- a 'ToJSON' instance and servant takes care of encoding it for you,
39−-- yielding status code 201 along the way.
40−instance ToJSON a => HasServer (Post a) where
41− type Server (Post a) = EitherT (Int, String) IO a
42−
43− route Proxy action request respond
44− | null (pathInfo request) && requestMethod request == methodPost = do
45− e <- runEitherT action
46− respond . succeedWith $ case e of
47− Right out ->
48− responseLBS status201 [("Content-Type", "application/json")] (encode out)
49− Left (status, message) ->
50− responseLBS (mkStatus status (cs message)) [] (cs message)
51− | null (pathInfo request) && requestMethod request /= methodPost =
52− respond $ failWith WrongMethod
53− | otherwise = respond $ failWith NotFound
src/Servant/API/Put.hsdeleted−52
@@ -1,52 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−module Servant.API.Put where
6−
7−import Control.Monad.Trans.Either
8−import Data.Aeson
9−import Data.Proxy
10−import Data.String.Conversions
11−import Data.Typeable
12−import Network.HTTP.Types
13−import Network.Wai
14−import Servant.Server
15−
16−-- | Endpoint for PUT requests, usually used to update a ressource.
17−-- The type @a@ is the type of the response body that's returned.
18−--
19−-- Example:
20−--
21−-- > -- PUT /books/:isbn
22−-- > -- with a Book as request body, returning the updated Book
23−-- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put Book
24−data Put a
25− deriving Typeable
26−
27−-- | When implementing the handler for a 'Put' endpoint,
28−-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
29−-- and 'Servant.API.Post.Post', the handler code runs in the
30−-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
31−-- the status code and the 'String' a message, returned in case of
32−-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
33−-- to quickly fail if some conditions are not met.
34−--
35−-- If successfully returning a value, we just require that its type has
36−-- a 'ToJSON' instance and servant takes care of encoding it for you,
37−-- yielding status code 200 along the way.
38−instance ToJSON a => HasServer (Put a) where
39− type Server (Put a) = EitherT (Int, String) IO a
40−
41− route Proxy action request respond
42− | null (pathInfo request) && requestMethod request == methodPut = do
43− e <- runEitherT action
44− respond . succeedWith $ case e of
45− Right out ->
46− responseLBS ok200 [("Content-Type", "application/json")] (encode out)
47− Left (status, message) ->
48− responseLBS (mkStatus status (cs message)) [] (cs message)
49− | null (pathInfo request) && requestMethod request /= methodPut =
50− respond $ failWith WrongMethod
51−
52− | otherwise = respond $ failWith NotFound
src/Servant/API/QueryParam.hsdeleted−162
@@ -1,162 +0,0 @@
1−{-# LANGUAGE PolyKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE TypeOperators #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−module Servant.API.QueryParam where
9−
10−import Data.Maybe
11−import Data.Proxy
12−import Data.String.Conversions
13−import GHC.TypeLits
14−import Network.HTTP.Types
15−import Network.Wai
16−import Servant.API.Sub
17−import Servant.Common.Text
18−import Servant.Server
19−
20−-- | Lookup the value associated to the @sym@ query string parameter
21−-- and try to extract it as a value of type @a@.
22−--
23−-- Example:
24−--
25−-- > -- /books?author=<author name>
26−-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]
27−data QueryParam sym a
28−
29−-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
30−-- this automatically requires your server-side handler to be a function
31−-- that takes an argument of type @'Maybe' 'Text'@.
32−--
33−-- This lets servant worry about looking it up in the query string
34−-- and turning it into a value of the type you specify, enclosed
35−-- in 'Maybe', because it may not be there and servant would then
36−-- hand you 'Nothing'.
37−--
38−-- You can control how it'll be converted from 'Text' to your type
39−-- by simply providing an instance of 'FromText' for your type.
40−--
41−-- Example:
42−--
43−-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]
44−-- >
45−-- > server :: Server MyApi
46−-- > server = getBooksBy
47−-- > where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book]
48−-- > getBooksBy Nothing = ...return all books...
49−-- > getBooksBy (Just author) = ...return books by the given author...
50−instance (KnownSymbol sym, FromText a, HasServer sublayout)
51− => HasServer (QueryParam sym a :> sublayout) where
52−
53− type Server (QueryParam sym a :> sublayout) =
54− Maybe a -> Server sublayout
55−
56− route Proxy subserver request respond = do
57− let querytext = parseQueryText $ rawQueryString request
58− param =
59− case lookup paramname querytext of
60− Nothing -> Nothing -- param absent from the query string
61− Just Nothing -> Nothing -- param present with no value -> Nothing
62− Just (Just v) -> fromText v -- if present, we try to convert to
63− -- the right type
64−
65− route (Proxy :: Proxy sublayout) (subserver param) request respond
66−
67− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
68−
69−-- | Lookup the values associated to the @sym@ query string parameter
70−-- and try to extract it as a value of type @[a]@. This is typically
71−-- meant to support query string parameters of the form
72−-- @param[]=val1&param[]=val2@ and so on. Note that servant doesn't actually
73−-- require the @[]@s and will fetch the values just fine with
74−-- @param=val1&param=val2@, too.
75−--
76−-- Example:
77−--
78−-- > -- /books?authors[]=<author1>&authors[]=<author2>&...
79−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]
80−data QueryParams sym a
81−
82−-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
83−-- this automatically requires your server-side handler to be a function
84−-- that takes an argument of type @['Text']@.
85−--
86−-- This lets servant worry about looking up 0 or more values in the query string
87−-- associated to @authors@ and turning each of them into a value of
88−-- the type you specify.
89−--
90−-- You can control how the individual values are converted from 'Text' to your type
91−-- by simply providing an instance of 'FromText' for your type.
92−--
93−-- Example:
94−--
95−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]
96−-- >
97−-- > server :: Server MyApi
98−-- > server = getBooksBy
99−-- > where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book]
100−-- > getBooksBy authors = ...return all books by these authors...
101−instance (KnownSymbol sym, FromText a, HasServer sublayout)
102− => HasServer (QueryParams sym a :> sublayout) where
103−
104− type Server (QueryParams sym a :> sublayout) =
105− [a] -> Server sublayout
106−
107− route Proxy subserver request respond = do
108− let querytext = parseQueryText $ rawQueryString request
109− -- if sym is "foo", we look for query string parameters
110− -- named "foo" or "foo[]" and call fromText on the
111− -- corresponding values
112− parameters = filter looksLikeParam querytext
113− values = catMaybes $ map (convert . snd) parameters
114−
115− route (Proxy :: Proxy sublayout) (subserver values) request respond
116−
117− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
118− looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
119− convert Nothing = Nothing
120− convert (Just v) = fromText v
121−
122−-- | Lookup a potentially value-less query string parameter
123−-- with boolean semantics. If the param @sym@ is there without any value,
124−-- or if it's there with value "true" or "1", it's interpreted as 'True'.
125−-- Otherwise, it's interpreted as 'False'.
126−--
127−-- Example:
128−--
129−-- > -- /books?published
130−-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]
131−data QueryFlag sym
132−
133−-- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API,
134−-- this automatically requires your server-side handler to be a function
135−-- that takes an argument of type 'Bool'.
136−--
137−-- Example:
138−--
139−-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]
140−-- >
141−-- > server :: Server MyApi
142−-- > server = getBooks
143−-- > where getBooks :: Bool -> EitherT (Int, String) IO [Book]
144−-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
145−instance (KnownSymbol sym, HasServer sublayout)
146− => HasServer (QueryFlag sym :> sublayout) where
147−
148− type Server (QueryFlag sym :> sublayout) =
149− Bool -> Server sublayout
150−
151− route Proxy subserver request respond = do
152− let querytext = parseQueryText $ rawQueryString request
153− param = case lookup paramname querytext of
154− Just Nothing -> True -- param is there, with no value
155− Just (Just v) -> examine v -- param with a value
156− Nothing -> False -- param not in the query string
157−
158− route (Proxy :: Proxy sublayout) (subserver param) request respond
159−
160− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
161− examine v | v == "true" || v == "1" || v == "" = True
162− | otherwise = False
src/Servant/API/Raw.hsdeleted−32
@@ -1,32 +0,0 @@
1−{-# LANGUAGE InstanceSigs #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TypeFamilies #-}
4−module Servant.API.Raw where
5−
6−import Data.Proxy
7−import Network.Wai
8−import Servant.Server
9−
10−-- | Endpoint for plugging in your own Wai 'Application's.
11−--
12−-- The given 'Application' will get the request as received by the server, potentially with
13−-- a modified (stripped) 'pathInfo' if the 'Application' is being routed with 'Servant.API.Sub.:>'.
14−--
15−-- In addition to just letting you plug in your existing WAI 'Application's,
16−-- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve
17−-- static files stored in a particular directory on your filesystem, or to serve
18−-- your API's documentation with 'Servant.Utils.StaticFiles.serveDocumentation'.
19−data Raw
20−
21−-- | Just pass the request to the underlying application and serve its response.
22−--
23−-- Example:
24−--
25−-- > type MyApi = "images" :> Raw
26−-- >
27−-- > server :: Server MyApi
28−-- > server = serveDirectory "/var/www/images"
29−instance HasServer Raw where
30− type Server Raw = Application
31− route Proxy rawApplication request respond =
32− rawApplication request (respond . succeedWith)
src/Servant/API/ReqBody.hsdeleted−49
@@ -1,49 +0,0 @@
1−{-# LANGUAGE PolyKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE TypeOperators #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
6−module Servant.API.ReqBody where
7−
8−import Control.Applicative
9−import Data.Aeson
10−import Data.Proxy
11−import Network.Wai
12−import Servant.API.Sub
13−import Servant.Server
14−
15−-- | Extract the request body as a value of type @a@.
16−--
17−-- Example:
18−--
19−-- > -- POST /books
20−-- > type MyApi = "books" :> ReqBody Book :> Post Book
21−data ReqBody a
22−
23−-- | If you use 'ReqBody' in one of the endpoints for your API,
24−-- this automatically requires your server-side handler to be a function
25−-- that takes an argument of the type specified by 'ReqBody'.
26−-- This lets servant worry about extracting it from the request and turning
27−-- it into a value of the type you specify.
28−--
29−-- All it asks is for a 'FromJSON' instance.
30−--
31−-- Example:
32−--
33−-- > type MyApi = "books" :> ReqBody Book :> Post Book
34−-- >
35−-- > server :: Server MyApi
36−-- > server = postBook
37−-- > where postBook :: Book -> EitherT (Int, String) IO Book
38−-- > postBook book = ...insert into your db...
39−instance (FromJSON a, HasServer sublayout)
40− => HasServer (ReqBody a :> sublayout) where
41−
42− type Server (ReqBody a :> sublayout) =
43− a -> Server sublayout
44−
45− route Proxy subserver request respond = do
46− mrqbody <- decode' <$> lazyRequestBody request
47− case mrqbody of
48− Nothing -> respond $ failWith InvalidBody
49− Just v -> route (Proxy :: Proxy sublayout) (subserver v) request respond
src/Servant/API/Sub.hsdeleted−36
@@ -1,36 +0,0 @@
1−{-# LANGUAGE PolyKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE TypeOperators #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−module Servant.API.Sub where
6−
7−import Data.Proxy
8−import Data.String.Conversions
9−import GHC.TypeLits
10−import Network.Wai
11−import Servant.Server
12−
13−-- | The contained API (second argument) can be found under @("/" ++ path)@
14−-- (path being the first argument).
15−--
16−-- Example:
17−--
18−-- > -- GET /hello/world
19−-- > -- returning a JSON encoded World value
20−-- > type MyApi = "hello" :> "world" :> Get World
21−data (path :: k) :> a = Proxy path :> a
22−infixr 9 :>
23−
24−-- | Make sure the incoming request starts with @"/path"@, strip it and
25−-- pass the rest of the request path to @sublayout@.
26−instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
27− type Server (path :> sublayout) = Server sublayout
28− route Proxy subserver request respond = case pathInfo request of
29− (first : rest)
30− | first == cs (symbolVal proxyPath)
31− -> route (Proxy :: Proxy sublayout) subserver request{
32− pathInfo = rest
33− } respond
34− _ -> respond $ failWith NotFound
35−
36− where proxyPath = Proxy :: Proxy path
src/Servant/Common/Text.hsdeleted−130
@@ -1,130 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TypeSynonymInstances #-}
4−module Servant.Common.Text
5− ( FromText(..)
6− , ToText(..)
7− ) where
8−
9−import Data.String.Conversions
10−import Data.Int
11−import Data.Text
12−import Data.Text.Read
13−import Data.Word
14−
15−-- | For getting values from url captures and query string parameters
16−class FromText a where
17− fromText :: Text -> Maybe a
18−
19−-- | For putting values in paths and query string parameters
20−class ToText a where
21− toText :: a -> Text
22−
23−instance FromText Text where
24− fromText = Just
25−
26−instance ToText Text where
27− toText = id
28−
29−instance FromText String where
30− fromText = Just . cs
31−
32−instance ToText String where
33− toText = cs
34−
35−-- |
36−-- > fromText "true" = Just True
37−-- > fromText "false" = Just False
38−-- > fromText _ = Nothing
39−instance FromText Bool where
40− fromText "true" = Just True
41− fromText "false" = Just False
42− fromText _ = Nothing
43−
44−-- |
45−-- > toText True = "true"
46−-- > toText False = "false"
47−instance ToText Bool where
48− toText True = "true"
49− toText False = "false"
50−
51−instance FromText Int where
52− fromText = runReader (signed decimal)
53−
54−instance ToText Int where
55− toText = cs . show
56−
57−instance FromText Int8 where
58− fromText = runReader (signed decimal)
59−
60−instance ToText Int8 where
61− toText = cs . show
62−
63−instance FromText Int16 where
64− fromText = runReader (signed decimal)
65−
66−instance ToText Int16 where
67− toText = cs . show
68−
69−instance FromText Int32 where
70− fromText = runReader (signed decimal)
71−
72−instance ToText Int32 where
73− toText = cs . show
74−
75−instance FromText Int64 where
76− fromText = runReader (signed decimal)
77−
78−instance ToText Int64 where
79− toText = cs . show
80−
81−instance FromText Word where
82− fromText = runReader decimal
83−
84−instance ToText Word where
85− toText = cs . show
86−
87−instance FromText Word8 where
88− fromText = runReader decimal
89−
90−instance ToText Word8 where
91− toText = cs . show
92−
93−instance FromText Word16 where
94− fromText = runReader decimal
95−
96−instance ToText Word16 where
97− toText = cs . show
98−
99−instance FromText Word32 where
100− fromText = runReader decimal
101−
102−instance ToText Word32 where
103− toText = cs . show
104−
105−instance FromText Word64 where
106− fromText = runReader decimal
107−
108−instance ToText Word64 where
109− toText = cs . show
110−
111−instance FromText Integer where
112− fromText = runReader decimal
113−
114−instance ToText Integer where
115− toText = cs . show
116−
117−instance FromText Double where
118− fromText = runReader rational
119−
120−instance ToText Double where
121− toText = cs . show
122−
123−instance FromText Float where
124− fromText = runReader rational
125−
126−instance ToText Float where
127− toText = cs . show
128−
129−runReader :: Reader a -> Text -> Maybe a
130−runReader reader t = either (const Nothing) (Just . fst) $ reader t
src/Servant/QQ.hsdeleted−198
@@ -1,198 +0,0 @@
1−{-# LANGUAGE MultiParamTypeClasses #-}
2−{-# LANGUAGE FunctionalDependencies #-}
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE TemplateHaskell #-}
7−{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
8−-- | QuasiQuoting utilities for API types.
9−--
10−-- 'sitemap' allows you to write your type in a very natural way:
11−--
12−-- @
13−-- [sitemap|
14−-- PUT hello String -> ()
15−-- POST hello/p:Int String -> ()
16−-- GET hello/?name:String Int
17−-- |]
18−-- @
19−--
20−-- Will generate:
21−--
22−-- @
23−-- "hello" :> ReqBody String :> Put ()
24−-- :\<|> "hello" :> Capture "p" Int :> ReqBody String :> Post ()
25−-- :\<|> "hello" :> QueryParam "name" String :> Get Int
26−-- @
27−--
28−-- Note the @/@ before a @QueryParam@!
29−module Servant.QQ where
30−
31−import Control.Monad (void)
32−import Control.Applicative hiding (many, (<|>), optional)
33−import Language.Haskell.TH.Quote
34−import Language.Haskell.TH
35−import Text.ParserCombinators.Parsec
36−
37−import Servant.API.Capture
38−import Servant.API.Get
39−import Servant.API.Post
40−import Servant.API.Put
41−import Servant.API.Delete
42−import Servant.API.QueryParam
43−import Servant.API.ReqBody
44−import Servant.API.Sub
45−import Servant.API.Alternative
46−
47−-- | Finally-tagless encoding for our DSL.
48−-- Keeping 'repr'' and 'repr' distinct when writing functions with an
49−-- @ExpSYM@ context ensures certain invariants (for instance, that there is
50−-- only one of 'get', 'post', 'put', and 'delete' in a value), but
51−-- sometimes requires a little more work.
52−class ExpSYM repr' repr | repr -> repr', repr' -> repr where
53− lit :: String -> repr' -> repr
54− capture :: String -> String -> repr -> repr
55− reqBody :: String -> repr -> repr
56− queryParam :: String -> String -> repr -> repr
57− conj :: repr' -> repr -> repr
58− get :: String -> repr
59− post :: String -> repr
60− put :: String -> repr
61− delete :: String -> repr
62−
63−
64−infixr 6 >:
65−
66−(>:) :: Type -> Type -> Type
67−(>:) = conj
68−
69−
70−instance ExpSYM Type Type where
71− lit name r = LitT (StrTyLit name) >: r
72− capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
73− (ConT $ mkName typ) >: r
74− reqBody typ r = AppT (ConT ''ReqBody) (ConT $ mkName typ) >: r
75− queryParam name typ r = AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name)))
76− (ConT $ mkName typ) >: r
77− conj x = AppT (AppT (ConT ''(:>)) x)
78− get typ = AppT (ConT ''Get) (ConT $ mkName typ)
79− post typ = AppT (ConT ''Post) (ConT $ mkName typ)
80− put typ = AppT (ConT ''Put) (ConT $ mkName typ)
81− delete "()" = ConT ''Delete
82− delete _ = error "Delete does not return a request body"
83−
84−parseMethod :: ExpSYM repr' repr => Parser (String -> repr)
85−parseMethod = try (string "GET" >> return get)
86− <|> try (string "POST" >> return post)
87− <|> try (string "PUT" >> return put)
88− <|> try (string "DELETE" >> return delete)
89−
90−parseUrlSegment :: ExpSYM repr repr => Parser (repr -> repr)
91−parseUrlSegment = try parseCapture
92− <|> try parseQueryParam
93− <|> try parseLit
94− where
95− parseCapture = do
96− cname <- many (noneOf " ?/:")
97− char ':'
98− ctyp <- many (noneOf " ?/:")
99− return $ capture cname ctyp
100− parseQueryParam = do
101− char '?'
102− cname <- many (noneOf " ?/:")
103− char ':'
104− ctyp <- many (noneOf " ?/:")
105− return $ queryParam cname ctyp
106− parseLit = lit <$> many (noneOf " ?/:")
107−
108−parseUrl :: ExpSYM repr repr => Parser (repr -> repr)
109−parseUrl = do
110− optional $ char '/'
111− url <- parseUrlSegment `sepBy1` char '/'
112− return $ foldr1 (.) url
113−
114−data Typ = Val String
115− | ReqArgVal String String
116−
117−parseTyp :: Parser Typ
118−parseTyp = do
119− f <- many (noneOf "-{\n\r")
120− spaces
121− s <- optionMaybe (try parseRet)
122− try $ optional inlineComment
123− try $ optional blockComment
124− case s of
125− Nothing -> return $ Val (stripTr f)
126− Just s' -> return $ ReqArgVal (stripTr f) (stripTr s')
127− where
128− parseRet :: Parser String
129− parseRet = do
130− string "->"
131− spaces
132− many (noneOf "-{\n\r")
133− stripTr = reverse . dropWhile (== ' ') . reverse
134−
135−
136−parseEntry :: ExpSYM repr repr => Parser repr
137−parseEntry = do
138− met <- parseMethod
139− spaces
140− url <- parseUrl
141− spaces
142− typ <- parseTyp
143− case typ of
144− Val s -> return $ url (met s)
145− ReqArgVal i o -> return $ url $ reqBody i (met o)
146−
147−blockComment :: Parser ()
148−blockComment = do
149− string "{-"
150− manyTill anyChar (try $ string "-}")
151− return ()
152−
153−inlineComment :: Parser ()
154−inlineComment = do
155− string "--"
156− manyTill anyChar (try $ lookAhead eol)
157− return ()
158−
159−eol :: Parser String
160−eol = try (string "\n\r")
161− <|> try (string "\r\n")
162− <|> string "\n"
163− <|> string "\r"
164− <?> "end of line"
165−
166−eols :: Parser ()
167−eols = skipMany $ void eol <|> blockComment <|> inlineComment
168−
169−parseAll :: Parser Type
170−parseAll = do
171− eols
172− entries <- parseEntry `endBy` eols
173− return $ foldr1 union entries
174− where union :: Type -> Type -> Type
175− union a = AppT (AppT (ConT ''(:<|>)) a)
176−
177−-- | The sitemap QuasiQuoter.
178−--
179−-- * @.../<var>:<type>/...@ becomes a capture
180−-- * @.../?<var>:<type>@ becomes a query parameter
181−-- * @<method> ... <typ>@ becomes a method returning @<typ>@
182−-- * @<method> ... <typ1> -> <typ2>@ becomes a method with request
183−-- body of @<typ1>@ and returning @<typ2>@
184−--
185−-- Comments are allowed, and have the standard Haskell format
186−--
187−-- * @--@ for inline
188−-- * @{- ... -}@ for block
189−--
190−sitemap :: QuasiQuoter
191−sitemap = QuasiQuoter { quoteExp = undefined
192− , quotePat = undefined
193− , quoteType = \x -> case parse parseAll "" x of
194− Left err -> error $ show err
195− Right st -> return st
196− , quoteDec = undefined
197− }
198−
src/Servant/Server.hsdeleted−105
@@ -1,105 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−-- | This module lets you implement 'Server's for defined APIs. You'll
5−-- most likely just need 'serve'.
6−module Servant.Server where
7−
8−import Data.Monoid
9−import Data.Proxy
10−import Network.HTTP.Types
11−import Network.Wai
12−
13−-- * Implementing Servers
14−
15−-- | 'serve' allows you to implement an API and produce a wai 'Application'.
16−--
17−-- Example:
18−--
19−-- > type MyApi = "books" :> Get [Book] -- GET /books
20−-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
21−-- >
22−-- > server :: Server MyApi
23−-- > server = listAllBooks :<|> postBook
24−-- > where listAllBooks = ...
25−-- > postBook book = ...
26−-- >
27−-- > app :: Application
28−-- > app = serve myApi server
29−-- >
30−-- > main :: IO ()
31−-- > main = Network.Wai.Handler.Warp.run 8080 app
32−serve :: HasServer layout => Proxy layout -> Server layout -> Application
33−serve p server = toApplication (route p server)
34−
35−toApplication :: RoutingApplication -> Application
36−toApplication ra request respond = do
37− ra request (routingRespond . routeResult)
38− where
39− routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
40− routingRespond (Left NotFound) =
41− respond $ responseLBS notFound404 [] "not found"
42− routingRespond (Left WrongMethod) =
43− respond $ responseLBS methodNotAllowed405 [] "method not allowed"
44− routingRespond (Left InvalidBody) =
45− respond $ responseLBS badRequest400 [] "Invalid JSON in request body"
46− routingRespond (Right response) =
47− respond response
48−
49−-- * Route mismatch
50−data RouteMismatch =
51− NotFound -- ^ the usual "not found" error
52− | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error
53− | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error
54− deriving (Eq, Show)
55−
56−-- |
57−-- @
58−-- > mempty = NotFound
59−-- >
60−-- > NotFound `mappend` x = x
61−-- > WrongMethod `mappend` InvalidBody = InvalidBody
62−-- > WrongMethod `mappend` _ = WrongMethod
63−-- > InvalidBody `mappend` _ = InvalidBody
64−-- @
65−instance Monoid RouteMismatch where
66− mempty = NotFound
67−
68− NotFound `mappend` x = x
69− WrongMethod `mappend` InvalidBody = InvalidBody
70− WrongMethod `mappend` _ = WrongMethod
71− InvalidBody `mappend` _ = InvalidBody
72−
73−-- | A wrapper around @'Either' 'RouteMismatch' a@.
74−newtype RouteResult a =
75− RR { routeResult :: Either RouteMismatch a }
76− deriving (Eq, Show)
77−
78−failWith :: RouteMismatch -> RouteResult a
79−failWith = RR . Left
80−
81−succeedWith :: a -> RouteResult a
82−succeedWith = RR . Right
83−
84−isMismatch :: RouteResult a -> Bool
85−isMismatch (RR (Left _)) = True
86−isMismatch _ = False
87−
88−-- | If we get a `Right`, it has precedence over everything else.
89−--
90−-- This in particular means that if we could get several 'Right's,
91−-- only the first we encounter would be taken into account.
92−instance Monoid (RouteResult a) where
93− mempty = RR $ Left mempty
94−
95− RR (Left x) `mappend` RR (Left y) = RR $ Left (x <> y)
96− RR (Left _) `mappend` RR (Right y) = RR $ Right y
97− r `mappend` _ = r
98−
99−type RoutingApplication =
100− Request -- ^ the request, the field 'pathInfo' may be modified by url routing
101− -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
102−
103−class HasServer layout where
104− type Server layout :: *
105− route :: Proxy layout -> Server layout -> RoutingApplication
src/Servant/Utils/Links.hsdeleted−110
@@ -1,110 +0,0 @@
1−{-# LANGUAGE PolyKinds #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE TypeOperators #-}
6−{-# LANGUAGE FunctionalDependencies #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE UndecidableInstances #-}
9−-- | Type safe internal links.
10−--
11−-- Provides the function 'mkLink':
12−--
13−-- @
14−-- type API = Proxy ("hello" :> Get Int
15−-- :<|> "bye" :> QueryParam "name" String :> Post Bool)
16−--
17−-- api :: API
18−-- api = proxy
19−--
20−-- link1 :: Proxy ("hello" :> Get Int)
21−-- link1 = proxy
22−--
23−-- link2 :: Proxy ("hello" :> Delete)
24−-- link2 = proxy
25−--
26−-- mkLink link1 API -- typechecks, returns 'Link "/hello"'
27−--
28−-- mkLink link2 API -- doesn't typecheck
29−-- @
30−--
31−-- That is, 'mkLink' takes two arguments, a link proxy and a sitemap, and
32−-- returns a 'Link', but only typechecks if the link proxy is a valid link,
33−-- and part of the sitemap.
34−--
35−-- __N.B.:__ 'mkLink' assumes a capture matches any string (without slashes).
36−module Servant.Utils.Links where
37−
38−import Data.Proxy
39−import GHC.TypeLits
40−
41−import Servant.API.Capture
42−import Servant.API.ReqBody
43−import Servant.API.QueryParam
44−import Servant.API.Get
45−import Servant.API.Post
46−import Servant.API.Put
47−import Servant.API.Delete
48−import Servant.API.Sub
49−import Servant.API.Alternative
50−
51−
52−type family Or a b where
53− Or 'False 'False = 'False
54− Or 'True b = 'True
55− Or a 'True = 'True
56−
57−type family And a b where
58− And 'True 'True = 'True
59− And a 'False = 'False
60− And 'False b = 'False
61−
62−type family IsElem a s where
63− IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
64− IsElem (e :> sa) (e :> sb) = IsElem sa sb
65− IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
66− IsElem sa (ReqBody x :> sb) = IsElem sa sb
67− IsElem sa (QueryParam x y :> sb) = IsElem sa sb
68− IsElem e e = 'True
69− IsElem e a = 'False
70−
71−type family IsLink'' l where
72− IsLink'' (e :> Get x) = IsLink' e
73− IsLink'' (e :> Post x) = IsLink' e
74− IsLink'' (e :> Put x) = IsLink' e
75− IsLink'' (e :> Delete) = IsLink' e
76− IsLink'' a = 'False
77−
78−type family IsLink' e where
79− IsLink' (f :: Symbol) = 'True
80−
81−type family IsLink e where
82− IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
83− (IsLink'' (a :> b))
84−
85−
86−-- | The 'ValidLinkIn f s' constraint holds when 's' is an API that
87−-- contains 'f', and 'f' is a link.
88−class ValidLinkIn f s where
89− mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
90− -- is an URI within `s`
91−
92−instance ( IsElem f s ~ 'True
93− , IsLink f ~ 'True
94− , VLinkHelper f) => ValidLinkIn f s where
95− mkLink _ _ = Link (vlh (Proxy :: Proxy f))
96−
97−data Link = Link String deriving Show
98−
99−class VLinkHelper f where
100− vlh :: forall proxy. proxy f -> String
101−
102−instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where
103− vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)
104−
105−instance VLinkHelper (Get x) where
106− vlh _ = ""
107−
108−instance VLinkHelper (Post x) where
109− vlh _ = ""
110−
src/Servant/Utils/StaticFiles.hsdeleted−36
@@ -1,36 +0,0 @@
1−-- | This module defines a sever-side handler that lets you serve static files.
2−--
3−-- - 'serveDirectory' lets you serve anything that lives under a particular
4−-- directory on your filesystem.
5−module Servant.Utils.StaticFiles (
6− serveDirectory,
7− ) where
8−
9−import Filesystem.Path.CurrentOS (decodeString)
10−import Network.Wai.Application.Static
11−import Servant.API.Raw
12−import Servant.Server
13−
14−-- | Serve anything under the specified directory as a 'Raw' endpoint.
15−--
16−-- @
17−-- type MyApi = "static" :> Raw
18−--
19−-- server :: Server MyApi
20−-- server = serveDirectory "\/var\/www"
21−-- @
22−--
23−-- would capture any request to @\/static\/\<something>@ and look for
24−-- @\<something>@ under @\/var\/www@.
25−--
26−-- It will do its best to guess the MIME type for that file, based on the extension,
27−-- and send an appropriate /Content-Type/ header if possible.
28−--
29−-- If your goal is to serve HTML, CSS and Javascript files that use the rest of the API
30−-- as a webapp backend, you will most likely not want the static files to be hidden
31−-- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory'
32−-- handler in the last position, because /servant/ will try to match the handlers
33−-- in order.
34−serveDirectory :: FilePath -> Server Raw
35−serveDirectory documentRoot =
36− staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))
test/Servant/QQSpec.hsdeleted−177
@@ -1,177 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE MultiParamTypeClasses #-}
5−{-# LANGUAGE OverlappingInstances #-}
6−{-# LANGUAGE QuasiQuotes #-}
7−{-# LANGUAGE TypeFamilies #-}
8−{-# LANGUAGE TypeOperators #-}
9−{-# LANGUAGE UndecidableInstances #-}
10−module Servant.QQSpec where
11−
12−import Test.Hspec
13−
14−import Servant.API
15−
16−--------------------------------------------------------------------------
17−-- Types for testing
18−--------------------------------------------------------------------------
19−
20−-- Methods ---------------------------------------------------------------
21−type SimpleGet = [sitemap|
22−GET hello ()
23−|]
24−type SimpleGet' = "hello" :> Get ()
25−type SimpleGet'' = "hello" :> Get Bool
26−
27−type SimpleGet2 = [sitemap|
28−GET hello Bool
29−|]
30−type SimpleGet2' = "hello" :> Get Bool
31−type SimpleGet2'' = "hello" :> Get Int
32−
33−type SimplePost = [sitemap|
34−POST hello ()
35−|]
36−type SimplePost' = "hello" :> Post ()
37−type SimplePost'' = "hello" :> Post Bool
38−
39−type SimplePost2 = [sitemap|
40−POST hello Bool
41−|]
42−type SimplePost2' = "hello" :> Post Bool
43−type SimplePost2'' = "hello" :> Post ()
44−
45−type SimplePut = [sitemap|
46−PUT hello ()
47−|]
48−type SimplePut' = "hello" :> Put ()
49−type SimplePut'' = "hello" :> Put Bool
50−
51−type SimplePut2 = [sitemap|
52−PUT hello Bool
53−|]
54−type SimplePut2' = "hello" :> Put Bool
55−type SimplePut2'' = "hello" :> Put ()
56−
57−-- Parameters ------------------------------------------------------------
58−
59−type SimpleReqBody = [sitemap|
60−POST hello () -> Bool
61−|]
62−type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
63−type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
64−
65−type SimpleCapture = [sitemap|
66−POST hello/p:Int Bool
67−|]
68−type SimpleCapture' = "hello" :> Capture "p" Int :> Post Bool
69−type SimpleCapture'' = "hello" :> Capture "r" Int :> Post Bool
70−type SimpleCapture''' = "hello" :> Capture "p" Bool :> Post Bool
71−
72−type SimpleQueryParam = [sitemap|
73−POST hello/?p:Int Bool
74−|]
75−type SimpleQueryParam' = "hello" :> QueryParam "p" Int :> Post Bool
76−type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool
77−type SimpleQueryParam''' = "hello" :> QueryParam "p" Bool :> Post Bool
78−
79−-- Combinations ----------------------------------------------------------
80−
81−type TwoPaths = [sitemap|
82−POST hello Bool
83−GET hello Bool
84−|]
85−type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get Bool)
86−
87−type WithInlineComments = [sitemap|
88−GET hello Bool -- This is a comment
89−|]
90−type WithInlineComments' = "hello" :> Get Bool
91−
92−type WithInlineComments2 = [sitemap|
93−GET hello Bool
94−-- This is a comment
95−|]
96−type WithInlineComments2' = "hello" :> Get Bool
97−
98−
99−type WithBlockComments = [sitemap|
100−GET hello Bool {-
101−POST hello Bool
102−-}
103−|]
104−type WithBlockComments' = "hello" :> Get Bool
105−
106−type WithBlockComments2 = [sitemap|
107−GET hello Bool {-
108−POST hello Bool
109−-}
110−POST hello Bool
111−|]
112−type WithBlockComments2' = ("hello" :> Get Bool) :<|> ("hello" :> Post Bool)
113−
114−--------------------------------------------------------------------------
115−-- Spec
116−--------------------------------------------------------------------------
117−
118−spec :: Spec
119−spec = do
120− describe "'sitemap' QuasiQuoter" $ do
121− it "Handles simple GET types" $ do
122− (u::SimpleGet) ~= (u::SimpleGet' ) ~> True
123− (u::SimpleGet) ~= (u::SimpleGet'' ) ~> False
124− (u::SimpleGet2) ~= (u::SimpleGet2' ) ~> True
125− (u::SimpleGet2) ~= (u::SimpleGet2'') ~> False
126− it "Handles simple POST types" $ do
127− (u::SimplePost) ~= (u::SimplePost' ) ~> True
128− (u::SimplePost) ~= (u::SimplePost'' ) ~> False
129− (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
130− (u::SimplePost2) ~= (u::SimplePost2'') ~> False
131− it "Handles simple PUT types" $ do
132− (u::SimplePut) ~= (u::SimplePut' ) ~> True
133− (u::SimplePut) ~= (u::SimplePut'' ) ~> False
134− (u::SimplePut2) ~= (u::SimplePut2' ) ~> True
135− (u::SimplePut2) ~= (u::SimplePut2'') ~> False
136− it "Handles simple request body types" $ do
137− (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
138− (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
139− it "Handles simple captures" $ do
140− (u::SimpleCapture) ~= (u::SimpleCapture' ) ~> True
141− (u::SimpleCapture) ~= (u::SimpleCapture'') ~> False
142− (u::SimpleCapture) ~= (u::SimpleCapture''') ~> False
143− it "Handles simple querystring parameters" $ do
144− (u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True
145− (u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False
146− (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
147− it "Handles multiples paths" $ do
148− (u::TwoPaths) ~= (u::TwoPaths') ~> True
149− it "Ignores inline comments" $ do
150− (u::WithInlineComments) ~= (u::WithInlineComments') ~> True
151− (u::WithInlineComments2) ~= (u::WithInlineComments2') ~> True
152− it "Ignores inline comments" $ do
153− (u::WithBlockComments) ~= (u::WithBlockComments') ~> True
154− (u::WithBlockComments2) ~= (u::WithBlockComments2') ~> True
155−
156−
157−--------------------------------------------------------------------------
158−-- Utilities
159−--------------------------------------------------------------------------
160−data HTrue
161−data HFalse
162−
163−-- Kiselyov's Type Equality predicate
164−class TypeEq x y b | x y -> b where { areEq :: x -> y -> Bool }
165−instance TypeEq x x HTrue where { areEq _ _ = True }
166−instance b ~ HFalse => TypeEq x y b where { areEq _ _ = False}
167−
168−infix 4 ~=
169−(~=) :: TypeEq x y b => x -> y -> Bool
170−(~=) = areEq
171−
172−u :: a
173−u = undefined
174−
175−infix 3 ~>
176−(~>) :: (Show a, Eq a) => a -> a -> Expectation
177−(~>) = shouldBe
test/Servant/ServerSpec.hsdeleted−258
@@ -1,258 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE QuasiQuotes #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE TypeOperators #-}
7−
8−module Servant.ServerSpec where
9−
10−
11−import Control.Monad.Trans.Either
12−import Data.Aeson
13−import Data.Char
14−import Data.Proxy
15−import Data.String
16−import Data.String.Conversions
17−import GHC.Generics
18−import Network.HTTP.Types
19−import Network.Wai
20−import Network.Wai.Test
21−import Test.Hspec
22−import Test.Hspec.Wai
23−
24−import Servant.API.Capture
25−import Servant.API.Get
26−import Servant.API.ReqBody
27−import Servant.API.Post
28−import Servant.API.QueryParam
29−import Servant.API.Raw
30−import Servant.API.Sub
31−import Servant.API.Alternative
32−import Servant.Server
33−
34−
35−-- * test data types
36−
37−data Person = Person {
38− name :: String,
39− age :: Integer
40− }
41− deriving (Eq, Show, Generic)
42−
43−instance ToJSON Person
44−instance FromJSON Person
45−
46−alice :: Person
47−alice = Person "Alice" 42
48−
49−data Animal = Animal {
50− species :: String,
51− numberOfLegs :: Integer
52− }
53− deriving (Eq, Show, Generic)
54−
55−instance ToJSON Animal
56−instance FromJSON Animal
57−
58−jerry :: Animal
59−jerry = Animal "Mouse" 4
60−
61−tweety :: Animal
62−tweety = Animal "Bird" 2
63−
64−
65−-- * specs
66−
67−spec :: Spec
68−spec = do
69− captureSpec
70− getSpec
71− queryParamSpec
72− postSpec
73− rawSpec
74− unionSpec
75−
76−
77−type CaptureApi = Capture "legs" Integer :> Get Animal
78−captureApi :: Proxy CaptureApi
79−captureApi = Proxy
80−captureServer :: Integer -> EitherT (Int, String) IO Animal
81−captureServer legs = case legs of
82− 4 -> return jerry
83− 2 -> return tweety
84− _ -> left (404, "not found")
85−
86−captureSpec :: Spec
87−captureSpec = do
88− describe "Servant.API.Capture" $ do
89− with (return (serve captureApi captureServer)) $ do
90− it "can capture parts of the 'pathInfo'" $ do
91− response <- get "/2"
92− liftIO $ do
93− decode' (simpleBody response) `shouldBe` Just tweety
94−
95− with (return (serve
96− (Proxy :: Proxy (Capture "captured" String :> Raw))
97− (\ "captured" request respond ->
98− respond $ responseLBS ok200 [] (cs $ show $ pathInfo request)))) $ do
99− it "strips the captured path snippet from pathInfo" $ do
100− get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
101−
102−
103−type GetApi = Get Person
104−getApi :: Proxy GetApi
105−getApi = Proxy
106−
107−getSpec :: Spec
108−getSpec = do
109− describe "Servant.API.Get" $ do
110− with (return (serve getApi (return alice))) $ do
111− it "allows to GET a Person" $ do
112− response <- get "/"
113− return response `shouldRespondWith` 200
114− liftIO $ do
115− decode' (simpleBody response) `shouldBe` Just alice
116−
117− it "throws 405 (wrong method) on POSTs" $ do
118− post "/" "" `shouldRespondWith` 405
119−
120−
121−type QueryParamApi = QueryParam "name" String :> Get Person
122− :<|> "a" :> QueryParams "names" String :> Get Person
123− :<|> "b" :> QueryFlag "capitalize" :> Get Person
124−
125−queryParamApi :: Proxy QueryParamApi
126−queryParamApi = Proxy
127−
128−qpServer :: Server QueryParamApi
129−qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize
130−
131− where qpNames (_:name2:_) = return alice { name = name2 }
132− qpNames _ = return alice
133−
134− qpCapitalize False = return alice
135− qpCapitalize True = return alice { name = map toUpper (name alice) }
136−
137− queryParamServer (Just name) = return alice{name = name}
138− queryParamServer Nothing = return alice
139−
140−queryParamSpec :: Spec
141−queryParamSpec = do
142− describe "Servant.API.QueryParam" $ do
143− it "allows to retrieve simple GET parameters" $
144− (flip runSession) (serve queryParamApi qpServer) $ do
145− let params1 = "?name=bob"
146− response1 <- Network.Wai.Test.request defaultRequest{
147− rawQueryString = params1,
148− queryString = parseQuery params1
149− }
150− liftIO $ do
151− decode' (simpleBody response1) `shouldBe` Just alice{
152− name = "bob"
153− }
154−
155− it "allows to retrieve lists in GET parameters" $
156− (flip runSession) (serve queryParamApi qpServer) $ do
157− let params2 = "?names[]=bob&names[]=john"
158− response2 <- Network.Wai.Test.request defaultRequest{
159− rawQueryString = params2,
160− queryString = parseQuery params2,
161− pathInfo = ["a"]
162− }
163− liftIO $
164− decode' (simpleBody response2) `shouldBe` Just alice{
165− name = "john"
166− }
167−
168− it "allows to retrieve value-less GET parameters" $
169− (flip runSession) (serve queryParamApi qpServer) $ do
170− let params3 = "?capitalize"
171− response3 <- Network.Wai.Test.request defaultRequest{
172− rawQueryString = params3,
173− queryString = parseQuery params3,
174− pathInfo = ["b"]
175− }
176− liftIO $
177− decode' (simpleBody response3) `shouldBe` Just alice{
178− name = "ALICE"
179− }
180−
181− let params3' = "?capitalize="
182− response3' <- Network.Wai.Test.request defaultRequest{
183− rawQueryString = params3',
184− queryString = parseQuery params3',
185− pathInfo = ["b"]
186− }
187− liftIO $
188− decode' (simpleBody response3') `shouldBe` Just alice{
189− name = "ALICE"
190− }
191−
192−type PostApi = ReqBody Person :> Post Integer
193−postApi :: Proxy PostApi
194−postApi = Proxy
195−
196−postSpec :: Spec
197−postSpec = do
198− describe "Servant.API.Post and .ReqBody" $ do
199− with (return (serve postApi (return . age))) $ do
200− it "allows to POST a Person" $ do
201− post "/" (encode alice) `shouldRespondWith` "42"{
202− matchStatus = 201
203− }
204−
205− it "correctly rejects invalid request bodies with status 400" $ do
206− post "/" "some invalid body" `shouldRespondWith` 400
207−
208−
209−type RawApi = "foo" :> Raw
210−rawApi :: Proxy RawApi
211−rawApi = Proxy
212−rawApplication :: Show a => (Request -> a) -> Application
213−rawApplication f request respond = respond $ responseLBS ok200 [] (cs $ show $ f request)
214−
215−rawSpec :: Spec
216−rawSpec = do
217− describe "Servant.API.Raw" $ do
218− it "runs applications" $ do
219− (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
220− response <- Network.Wai.Test.request defaultRequest{
221− pathInfo = ["foo"]
222− }
223− liftIO $ do
224− simpleBody response `shouldBe` "42"
225−
226− it "gets the pathInfo modified" $ do
227− (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
228− response <- Network.Wai.Test.request defaultRequest{
229− pathInfo = ["foo", "bar"]
230− }
231− liftIO $ do
232− simpleBody response `shouldBe` cs (show ["bar" :: String])
233−
234−
235−type AlternativeApi =
236− "foo" :> Get Person
237− :<|> "bar" :> Get Animal
238−unionApi :: Proxy AlternativeApi
239−unionApi = Proxy
240−
241−unionServer :: Server AlternativeApi
242−unionServer =
243− return alice
244− :<|> return jerry
245−
246−unionSpec :: Spec
247−unionSpec = do
248− describe "Servant.API.Alternative" $ do
249− with (return $ serve unionApi unionServer) $ do
250− it "unions endpoints" $ do
251− response <- get "/foo"
252− liftIO $ do
253− decode' (simpleBody response) `shouldBe`
254− Just alice
255− response <- get "/bar"
256− liftIO $ do
257− decode' (simpleBody response) `shouldBe`
258− Just jerry
test/Servant/Utils/LinksSpec.hsdeleted−52
@@ -1,52 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE PolyKinds #-}
3−{-# LANGUAGE TypeOperators #-}
4−module Servant.Utils.LinksSpec where
5−
6−import Test.Hspec
7−
8−import Servant.API
9−import Servant.QQSpec ( (~>) )
10−import Servant.Utils.Links (IsElem, IsLink)
11−
12−type TestApi =
13− "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Get Bool
14− :<|> "greet" :> ReqBody 'True :> Post Bool
15−
16−type TestLink = "hello" :> "hi" :> Get Bool
17−type TestLink2 = "greet" :> Post Bool
18−
19−type BadTestLink = "hallo" :> "hi" :> Get Bool
20−type BadTestLink2 = "greet" :> Get Bool
21−
22−type NotALink = "hello" :> Capture "x" Bool :> Get Bool
23−type NotALink2 = "hello" :> ReqBody 'True :> Get Bool
24−
25−data Proxy x = Proxy
26−class ReflectT (x::Bool) where { reflected :: Proxy x -> Bool }
27−instance ReflectT 'True where { reflected _ = True }
28−instance ReflectT 'False where { reflected _ = False }
29−
30−spec :: Spec
31−spec = describe "Servant.API.Elem" $ do
32− isElem
33− isLink
34−
35−isElem :: Spec
36−isElem = describe "IsElem" $ do
37− it "is True when the first argument is an url within the second" $ do
38− reflected (Proxy::Proxy (IsElem TestLink TestApi)) ~> True
39− reflected (Proxy::Proxy (IsElem TestLink2 TestApi)) ~> True
40− it "is False when the first argument is not an url within the second" $ do
41− reflected (Proxy::Proxy (IsElem BadTestLink TestApi)) ~> False
42− reflected (Proxy::Proxy (IsElem BadTestLink2 TestApi)) ~> False
43−
44−isLink :: Spec
45−isLink = describe "IsLink" $ do
46− it "is True when all Subs are paths and the last is a method" $ do
47− reflected (Proxy::Proxy (IsLink TestLink)) ~> True
48− reflected (Proxy::Proxy (IsLink TestLink2)) ~> True
49− it "is False of anything with captures" $ do
50− reflected (Proxy::Proxy (IsLink NotALink)) ~> False
51− reflected (Proxy::Proxy (IsLink NotALink2)) ~> False
52−
test/Servant/Utils/StaticFilesSpec.hsdeleted−64
@@ -1,64 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TypeOperators #-}
5−{-# OPTIONS_GHC -fno-warn-orphans #-}
6−module Servant.Utils.StaticFilesSpec where
7−
8−import Control.Exception
9−import Data.Proxy
10−import Network.Wai
11−import System.Directory
12−import System.IO.Temp
13−import Test.Hspec hiding (pending)
14−import Test.Hspec.Wai
15−
16−import Servant.API.Alternative
17−import Servant.API.Capture
18−import Servant.API.Get
19−import Servant.API.Raw
20−import Servant.API.Sub
21−import Servant.Server
22−import Servant.ServerSpec
23−import Servant.Utils.StaticFiles
24−
25−type Api =
26− "dummy_api" :> Capture "person_name" String :> Get Person
27− :<|> "static" :> Raw
28−
29−
30−api :: Proxy Api
31−api = Proxy
32−
33−app :: Application
34−app = serve api server
35−
36−server :: Server Api
37−server =
38− (\ name -> return (Person name 42))
39− :<|> serveDirectory "static"
40−
41−withStaticFiles :: IO () -> IO ()
42−withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->
43− bracket (setup tmpDir) teardown (const action)
44− where
45− setup tmpDir = do
46− outer <- getCurrentDirectory
47− setCurrentDirectory tmpDir
48− createDirectory "static"
49− writeFile "static/foo.txt" "bar"
50− writeFile "static/index.html" "index"
51− return outer
52−
53− teardown outer = do
54− setCurrentDirectory outer
55−
56−spec :: Spec
57−spec = do
58− around_ withStaticFiles $ with (return app) $ do
59− describe "serveDirectory" $ do
60− it "successfully serves files" $ do
61− get "/static/foo.txt" `shouldRespondWith` "bar"
62−
63− it "serves the contents of index.html when requesting the root of a directory" $ do
64− get "/static" `shouldRespondWith` "index"
test/Spec.hsdeleted−1
@@ -1 +0,0 @@
1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}