master...a8a896f · typeable/servant

git.iko.soy/typeable/servant

example/README.mddeleted−2

since splitsnapshots

@@ -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.cabal+7−123

@@ -1,87 +1,13 @@

1name: servant

2−version: 0.2

2+version: 0.2.1

3−synopsis: A family of combinators for defining webservices APIs and serving them

3+synopsis: A family of combinators for defining webservices APIs

4description:

5 A family of combinators for defining webservices APIs and serving them

6 .

7 You can learn about the basics in <http://haskell-servant.github.io/getting-started/ the getting started> guide.

8 .

9− Here's a runnable example, with comments, that defines a dummy API and

9+ <https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and

10− implements a webserver that serves this API. You can find it <https://github.com/haskell-servant/servant/blob/master/example/greet.hs here> too.

10+ implements a webserver that serves this API, using the <http://hackage.haskell.org/package/servant-server servant-server> package.

11− .

12− > {-# LANGUAGE DataKinds #-}

13− > {-# LANGUAGE PolyKinds #-}

14− > {-# LANGUAGE TypeFamilies #-}

15− > {-# LANGUAGE DeriveGeneric #-}

16− > {-# LANGUAGE TypeOperators #-}

17− > {-# LANGUAGE OverloadedStrings #-}

18− >

19− > import Data.Aeson

20− > import Data.Monoid

21− > import Data.Proxy

22− > import Data.Text

23− > import GHC.Generics

24− > import Network.Wai

25− > import Network.Wai.Handler.Warp

26− >

27− > import Servant

28− >

29− > -- * Example

30− >

31− > -- | A greet message data type

32− > newtype Greet = Greet { msg :: Text }

33− > deriving (Generic, Show)

34− >

35− > instance FromJSON Greet

36− > instance ToJSON Greet

37− >

38− > -- API specification

39− > type TestApi =

40− > -- GET /hello/:name?capital={true, false}

41− -- returns a Greet as JSON

42− > "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet

43− >

44− > -- POST /greet with a Greet as JSON in the request body,

45− > -- returns a Greet as JSON

46− > :<|> "greet" :> ReqBody Greet :> Post Greet

47− >

48− > -- DELETE /greet/:greetid

49− > :<|> "greet" :> Capture "greetid" Text :> Delete

50− >

51− > testApi :: Proxy TestApi

52− > testApi = Proxy

53− >

54− > -- Server-side handlers.

55− > --

56− > -- There's one handler per endpoint, which, just like in the type

57− > -- that represents the API, are glued together using :<|>.

58− > --

59− > -- Each handler runs in the 'EitherT (Int, String) IO' monad.

60− > server :: Server TestApi

61− > server = helloH :<|> postGreetH :<|> deleteGreetH

62− >

63− > where helloH name Nothing = helloH name (Just False)

64− > helloH name (Just False) = return . Greet $ "Hello, " <> name

65− > helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name

66− >

67− > postGreetH greet = return greet

68− >

69− > deleteGreetH _ = return ()

70− >

71− > -- Turn the server into a WAI app. 'serve' is provided by servant,

72− > -- more precisely by the Servant.Server module.

73− > test :: Application

74− > test = serve testApi server

75− >

76− > -- Run the server.

77− > --

78− > -- 'run' comes from Network.Wai.Handler.Warp

79− > runTestServer :: Port -> IO ()

80− > runTestServer port = run port test

81− >

82− > -- Put this all to work!

83− > main :: IO ()

84− > main = runTestServer 8001

85homepage: http://haskell-servant.github.io/

11homepage: http://haskell-servant.github.io/

86Bug-reports: http://github.com/haskell-servant/servant/issues

12Bug-reports: http://github.com/haskell-servant/servant/issues

87license: BSD3

13license: BSD3

@@ -99,7 +25,6 @@ source-repository head

100library

26library

101 exposed-modules:

27 exposed-modules:

102− Servant

103 Servant.API

28 Servant.API

104 Servant.API.Alternative

29 Servant.API.Alternative

105 Servant.API.Capture

30 Servant.API.Capture

@@ -114,45 +39,17 @@ library

114 Servant.API.Sub

39 Servant.API.Sub

115 Servant.Common.Text

40 Servant.Common.Text

116 Servant.QQ

41 Servant.QQ

117− Servant.Server

118 Servant.Utils.Links

42 Servant.Utils.Links

119− Servant.Utils.StaticFiles

120 build-depends:

43 build-depends:

121 base >=4.7 && <5

44 base >=4.7 && <5

122− , aeson

45+ , text >= 1

123− , attoparsec

124− , bytestring

125− , either

126− , http-types

127− , network-uri >= 2.6

128− , parsec

129− , safe

130− , split

131− , string-conversions

132− , system-filepath

133 , template-haskell

46 , template-haskell

134− , text

47+ , parsec >= 3.1

135− , transformers

48+ , string-conversions >= 0.3

136− , wai

137− , wai-app-static

138− , warp

139 hs-source-dirs: src

49 hs-source-dirs: src

140 default-language: Haskell2010

50 default-language: Haskell2010

141 ghc-options: -Wall

51 ghc-options: -Wall

142

143−executable greet

144− main-is: greet.hs

145− hs-source-dirs: example

146− ghc-options: -Wall

147− default-language: Haskell2010

148− build-depends:

149− base

150− , servant

151− , aeson

152− , warp

153− , wai

154− , text

155−

156test-suite spec

53test-suite spec

157 type: exitcode-stdio-1.0

54 type: exitcode-stdio-1.0

158 ghc-options:

55 ghc-options:

@@ -162,22 +59,9 @@ test-suite spec

162 main-is: Spec.hs

59 main-is: Spec.hs

163 build-depends:

60 build-depends:

164 base == 4.*

61 base == 4.*

165− , aeson

166− , bytestring

167− , directory

168− , either

169− , exceptions

170 , hspec == 2.*

62 , hspec == 2.*

171− , hspec-wai

172− , http-types

173− , network >= 2.6

174 , QuickCheck

63 , QuickCheck

175 , parsec

64 , parsec

176 , servant

65 , servant

177 , string-conversions

66 , string-conversions

178− , temporary

179 , text

67 , text

180− , transformers

181− , wai

182− , wai-extra

183− , 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.hs−2

@@ -29,7 +29,6 @@ module Servant.API (

29 -- * Untyped endpoints

30 -- | Plugging in a wai 'Network.Wai.Application', serving directories

31 module Servant.API.Raw,

32− module Servant.Utils.StaticFiles,

34 -- * Utilities

33 -- * Utilities

35 -- | QuasiQuotes for endpoints

34 -- | QuasiQuotes for endpoints

@@ -51,4 +50,3 @@ import Servant.API.ReqBody

51import Servant.API.Sub

50import Servant.API.Sub

52import Servant.QQ (sitemap)

51import Servant.QQ (sitemap)

53import Servant.Utils.Links (mkLink)

52import Servant.Utils.Links (mkLink)

54−import Servant.Utils.StaticFiles

src/Servant/API/Alternative.hs−28

@@ -1,12 +1,6 @@

1−{-# LANGUAGE TypeFamilies #-}

2{-# LANGUAGE TypeOperators #-}

1{-# LANGUAGE TypeOperators #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4module Servant.API.Alternative where

2module Servant.API.Alternative where

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.

4-- | Union of two APIs, first takes precedence in case of overlap.

11--

5--

12-- Example:

6-- Example:

@@ -15,25 +9,3 @@ import Servant.Server

15-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books

9-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books

16data a :<|> b = a :<|> b

10data a :<|> b = a :<|> b

17infixr 8 :<|>

11infixr 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.hs−50

@@ -1,19 +1,6 @@

1{-# LANGUAGE PolyKinds #-}

2−{-# LANGUAGE TypeFamilies #-}

3−{-# LANGUAGE TypeOperators #-}

4−{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE ScopedTypeVariables #-}

7module Servant.API.Capture (Capture) where

2module Servant.API.Capture (Capture) where

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@.

4-- | Capture a value from the request path under a certain type @a@.

18--

5--

19-- Example:

6-- Example:

@@ -21,40 +8,3 @@ import Servant.Server

21-- > -- GET /books/:isbn

8-- > -- GET /books/:isbn

22-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book

9-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book

23data Capture sym a

10data 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.hs−35

@@ -1,16 +1,7 @@

1−{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

5module Servant.API.Delete where

2module Servant.API.Delete where

7−import Control.Monad.Trans.Either

8−import Data.Proxy

9−import Data.String.Conversions

10import Data.Typeable

4import Data.Typeable

11−import Network.HTTP.Types

12−import Network.Wai

13−import Servant.Server

15-- | Combinator for DELETE requests.

6-- | Combinator for DELETE requests.

16--

7--

@@ -20,29 +11,3 @@ import Servant.Server

20-- > type MyApi = "books" :> Capture "isbn" Text :> Delete

11-- > type MyApi = "books" :> Capture "isbn" Text :> Delete

21data Delete

12data Delete

22 deriving Typeable

13 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.hs−35

@@ -1,17 +1,7 @@

1−{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

5module Servant.API.Get where

2module Servant.API.Get where

7−import Control.Monad.Trans.Either

8−import Data.Aeson

9−import Data.Proxy

10−import Data.String.Conversions

11import Data.Typeable

4import Data.Typeable

12−import Network.HTTP.Types

13−import Network.Wai

14−import Servant.Server

16-- | Endpoint for simple GET requests. Serves the result as JSON.

6-- | Endpoint for simple GET requests. Serves the result as JSON.

17--

7--

@@ -20,28 +10,3 @@ import Servant.Server

20-- > type MyApi = "books" :> Get [Book]

10-- > type MyApi = "books" :> Get [Book]

21data Get a

11data Get a

22 deriving Typeable

12 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/Header.hs−43

@@ -1,18 +1,7 @@

1{-# LANGUAGE PolyKinds #-}

2−{-# LANGUAGE TypeFamilies #-}

3−{-# LANGUAGE TypeOperators #-}

4−{-# LANGUAGE FlexibleInstances #-}

5−{-# LANGUAGE ScopedTypeVariables #-}

6module Servant.API.Header where

2module Servant.API.Header where

8−import Data.Proxy

9−import Data.String

10−import Data.Text.Encoding (decodeUtf8)

11import GHC.TypeLits

4import GHC.TypeLits

12−import Network.Wai

13−import Servant.API.Sub

14−import Servant.Common.Text

15−import Servant.Server

17-- | Extract the given header's value as a value of type @a@.

6-- | Extract the given header's value as a value of type @a@.

18--

7--

@@ -24,35 +13,3 @@ import Servant.Server

24-- > -- GET /view-my-referer

13-- > -- GET /view-my-referer

25-- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer

14-- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer

26data Header sym a

15data Header sym a

27−

28−-- | If you use 'Header' 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 'Header'.

31−-- This lets servant worry about extracting it from the request and turning

32−-- it into a value of the type you specify.

33−--

34−-- All it asks is for a 'FromText' instance.

35−--

36−-- Example:

37−--

38−-- > newtype Referer = Referer Text

39−-- > deriving (Eq, Show, FromText, ToText)

40−-- >

41−-- > -- GET /view-my-referer

42−-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer

43−-- >

44−-- > server :: Server MyApi

45−-- > server = viewReferer

46−-- > where viewReferer :: Referer -> EitherT (Int, String) IO referer

47−-- > viewReferer referer = return referer

48−instance (KnownSymbol sym, FromText a, HasServer sublayout)

49− => HasServer (Header sym a :> sublayout) where

50−

51− type Server (Header sym a :> sublayout) =

52− Maybe a -> Server sublayout

53−

54− route Proxy subserver request respond = do

55− let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)

56− route (Proxy :: Proxy sublayout) (subserver mheader) request respond

57−

58− where str = fromString $ symbolVal (Proxy :: Proxy sym)

src/Servant/API/Post.hs−36

@@ -1,17 +1,7 @@

1−{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

5module Servant.API.Post where

2module Servant.API.Post where

7−import Control.Monad.Trans.Either

8−import Data.Aeson

9−import Data.Proxy

10−import Data.String.Conversions

11import Data.Typeable

4import Data.Typeable

12−import Network.HTTP.Types

13−import Network.Wai

14−import Servant.Server

16-- | Endpoint for POST requests. The type variable represents the type of the

6-- | 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

7-- response body (not the request body, use 'Servant.API.RQBody.RQBody' for

@@ -25,29 +15,3 @@ import Servant.Server

25-- > type MyApi = "books" :> ReqBody Book :> Post Book

15-- > type MyApi = "books" :> ReqBody Book :> Post Book

26data Post a

16data Post a

27 deriving Typeable

17 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.hs−37

@@ -1,17 +1,7 @@

1−{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

5module Servant.API.Put where

2module Servant.API.Put where

7−import Control.Monad.Trans.Either

8−import Data.Aeson

9−import Data.Proxy

10−import Data.String.Conversions

11import Data.Typeable

4import Data.Typeable

12−import Network.HTTP.Types

13−import Network.Wai

14−import Servant.Server

16-- | Endpoint for PUT requests, usually used to update a ressource.

6-- | Endpoint for PUT requests, usually used to update a ressource.

17-- The type @a@ is the type of the response body that's returned.

7-- The type @a@ is the type of the response body that's returned.

@@ -23,30 +13,3 @@ import Servant.Server

23-- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put Book

13-- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put Book

24data Put a

14data Put a

25 deriving Typeable

15 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.hs−127

@@ -1,22 +1,6 @@

1{-# LANGUAGE PolyKinds #-}

2−{-# LANGUAGE TypeFamilies #-}

3−{-# LANGUAGE TypeOperators #-}

4−{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE OverloadedStrings #-}

7−{-# LANGUAGE ScopedTypeVariables #-}

8module Servant.API.QueryParam where

2module Servant.API.QueryParam where

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

4-- | Lookup the value associated to the @sym@ query string parameter

21-- and try to extract it as a value of type @a@.

5-- and try to extract it as a value of type @a@.

22--

6--

@@ -26,46 +10,6 @@ import Servant.Server

26-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]

10-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]

27data QueryParam sym a

11data QueryParam sym a

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

13-- | 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

14-- and try to extract it as a value of type @[a]@. This is typically

71-- meant to support query string parameters of the form

15-- meant to support query string parameters of the form

@@ -79,46 +23,6 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)

79-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]

23-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]

80data QueryParams sym a

24data QueryParams sym a

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

26-- | Lookup a potentially value-less query string parameter

123-- with boolean semantics. If the param @sym@ is there without any value,

27-- 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'.

28-- 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)

129-- > -- /books?published

33-- > -- /books?published

130-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]

34-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]

131data QueryFlag sym

35data 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.hs−20

@@ -1,12 +1,5 @@

1−{-# LANGUAGE InstanceSigs #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TypeFamilies #-}

4module Servant.API.Raw where

1module Servant.API.Raw where

6−import Data.Proxy

7−import Network.Wai

8−import Servant.Server

9−

10-- | Endpoint for plugging in your own Wai 'Application's.

3-- | Endpoint for plugging in your own Wai 'Application's.

11--

4--

12-- The given 'Application' will get the request as received by the server, potentially with

5-- The given 'Application' will get the request as received by the server, potentially with

@@ -17,16 +10,3 @@ import Servant.Server

17-- static files stored in a particular directory on your filesystem, or to serve

10-- static files stored in a particular directory on your filesystem, or to serve

18-- your API's documentation with 'Servant.Utils.StaticFiles.serveDocumentation'.

11-- your API's documentation with 'Servant.Utils.StaticFiles.serveDocumentation'.

19data Raw

12data 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.hs−39

@@ -1,17 +1,6 @@

1{-# LANGUAGE PolyKinds #-}

2−{-# LANGUAGE TypeFamilies #-}

3−{-# LANGUAGE TypeOperators #-}

4−{-# LANGUAGE FlexibleInstances #-}

5−{-# LANGUAGE ScopedTypeVariables #-}

6module Servant.API.ReqBody where

2module Servant.API.ReqBody where

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@.

4-- | Extract the request body as a value of type @a@.

16--

5--

17-- Example:

6-- Example:

@@ -19,31 +8,3 @@ import Servant.Server

19-- > -- POST /books

8-- > -- POST /books

20-- > type MyApi = "books" :> ReqBody Book :> Post Book

9-- > type MyApi = "books" :> ReqBody Book :> Post Book

21data ReqBody a

10data 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.hs−19

@@ -1,14 +1,9 @@

1{-# LANGUAGE PolyKinds #-}

2−{-# LANGUAGE TypeFamilies #-}

3{-# LANGUAGE TypeOperators #-}

2{-# LANGUAGE TypeOperators #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5module Servant.API.Sub where

3module Servant.API.Sub where

7import Data.Proxy

5import Data.Proxy

8−import Data.String.Conversions

9import GHC.TypeLits

6import GHC.TypeLits

10−import Network.Wai

11−import Servant.Server

13-- | The contained API (second argument) can be found under @("/" ++ path)@

8-- | The contained API (second argument) can be found under @("/" ++ path)@

14-- (path being the first argument).

9-- (path being the first argument).

@@ -20,17 +15,3 @@ import Servant.Server

20-- > type MyApi = "hello" :> "world" :> Get World

15-- > type MyApi = "hello" :> "world" :> Get World

21data (path :: k) :> a = Proxy path :> a

16data (path :: k) :> a = Proxy path :> a

22infixr 9 :>

17infixr 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/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/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/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/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"