git.iko.soy/typeable/servant
on master help sign in
Review fixes
f1b6603Julian K. Arni
servant-client/src/Servant/Client.hs+1−2
compare with master
unifiedsplit
@@ -24,7 +24,6 @@ module Servant.Client
24#if !MIN_VERSION_base(4,8,0)
24#if !MIN_VERSION_base(4,8,0)
25import Control.Applicative ((<$>))
25import Control.Applicative ((<$>))
26#endif
26#endif
27−import Control.Monad
28import Control.Monad.Trans.Except
27import Control.Monad.Trans.Except
29import Data.ByteString.Lazy (ByteString)
28import Data.ByteString.Lazy (ByteString)
30import Data.List
29import Data.List
@@ -420,6 +419,6 @@ It may seem to make more sense to have:
420
419
421But this means that if another instance exists that does *not* require
420But this means that if another instance exists that does *not* require
422non-empty lists, but is otherwise more specific, no instance will be overall
421non-empty lists, but is otherwise more specific, no instance will be overall
423−more specific. This in turns generally means adding yet another instance (one
422+more specific. This in turn generally means adding yet another instance (one
424for empty and one for non-empty lists).
423for empty and one for non-empty lists).
425-}
424-}
servant-client/src/Servant/Common/Req.hs+1−1
@@ -156,7 +156,7 @@ performRequest reqMethod req reqHost manager = do
156
156
157performRequestCT :: MimeUnrender ct result =>
157performRequestCT :: MimeUnrender ct result =>
158 Proxy ct -> Method -> Req -> BaseUrl -> Manager
158 Proxy ct -> Method -> Req -> BaseUrl -> Manager
159− -> ExceptT ServantError IO ([HTTP.Header], result)
159+ -> ExceptT ServantError IO ([HTTP.Header], result)
160performRequestCT ct reqMethod req reqHost manager = do
160performRequestCT ct reqMethod req reqHost manager = do
161 let acceptCT = contentType ct
161 let acceptCT = contentType ct
162 (_status, respBody, respCT, hdrs, _response) <-
162 (_status, respBody, respCT, hdrs, _response) <-
servant-server/test/Servant/ServerSpec.hs+223−245
@@ -3,8 +3,10 @@
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE PolyKinds #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE TypeOperators #-}
9+{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeSynonymInstances #-}
10{-# LANGUAGE TypeSynonymInstances #-}
9{-# LANGUAGE FlexibleInstances #-}
11{-# LANGUAGE FlexibleInstances #-}
10
12
@@ -13,7 +15,7 @@ module Servant.ServerSpec where
13#if !MIN_VERSION_base(4,8,0)
15#if !MIN_VERSION_base(4,8,0)
14import Control.Applicative ((<$>))
16import Control.Applicative ((<$>))
15#endif
17#endif
16−import Control.Monad (forM_, when)
18+import Control.Monad (forM_, when, unless)
17import Control.Monad.Trans.Except (ExceptT, throwE)
19import Control.Monad.Trans.Except (ExceptT, throwE)
18import Data.Aeson (FromJSON, ToJSON, decode', encode)
20import Data.Aeson (FromJSON, ToJSON, decode', encode)
19import Data.ByteString.Conversion ()
21import Data.ByteString.Conversion ()
@@ -23,82 +25,144 @@ import Data.String (fromString)
23import Data.String.Conversions (cs)
25import Data.String.Conversions (cs)
24import qualified Data.Text as T
26import qualified Data.Text as T
25import GHC.Generics (Generic)
27import GHC.Generics (Generic)
26−import Network.HTTP.Types (hAccept, hContentType,
28+import Network.HTTP.Types (Status (..), hAccept, hContentType,
27− methodDelete, methodGet, methodHead,
29+ methodDelete, methodGet,
30+ methodHead, methodPatch,
28− methodPatch, methodPost, methodPut,
31+ methodPost, methodPut, ok200,
29− ok200, parseQuery, Status(..))
32+ parseQuery)
30import Network.Wai (Application, Request, pathInfo,
33import Network.Wai (Application, Request, pathInfo,
31 queryString, rawQueryString,
34 queryString, rawQueryString,
32− responseLBS, responseBuilder)
35+ responseBuilder, responseLBS)
33−import Network.Wai.Internal (Response(ResponseBuilder))
36+import Network.Wai.Internal (Response (ResponseBuilder))
34import Network.Wai.Test (defaultRequest, request,
37import Network.Wai.Test (defaultRequest, request,
35− runSession, simpleBody)
38+ runSession, simpleBody,
39+ simpleHeaders, simpleStatus)
36import Servant.API ((:<|>) (..), (:>), Capture, Delete,
40import Servant.API ((:<|>) (..), (:>), Capture, Delete,
37− Get, Header (..), Headers,
41+ Get, Header (..),
42+ Headers, HttpVersion,
38− HttpVersion, IsSecure (..), JSON,
43+ IsSecure (..), JSON,
39− Patch, PlainText, Post, Put,
44+ NoContent (..), Patch, PlainText,
45+ Post, Put,
40 QueryFlag, QueryParam, QueryParams,
46 QueryFlag, QueryParam, QueryParams,
41− Raw, RemoteHost, ReqBody, GetNoContent,
47+ Raw, RemoteHost, ReqBody,
42− PostNoContent, addHeader, NoContent(..))
48+ StdMethod (..), Verb, addHeader)
43−import Servant.Server (Server, serve, ServantErr(..), err404)
49+import Servant.Server (ServantErr (..), Server, err404,
50+ serve)
44−import Test.Hspec (Spec, describe, it, shouldBe)
51+import Test.Hspec (Spec, context, describe, it,
52+ shouldBe, shouldContain)
45import Test.Hspec.Wai (get, liftIO, matchHeaders,
53import Test.Hspec.Wai (get, liftIO, matchHeaders,
46− matchStatus, post, request,
54+ matchStatus, request,
47 shouldRespondWith, with, (<:>))
55 shouldRespondWith, with, (<:>))
56+
48−import Servant.Server.Internal.RoutingApplication (toApplication, RouteResult(..))
57+import Servant.Server.Internal.RoutingApplication
58+ (toApplication, RouteResult(..))
49import Servant.Server.Internal.Router
59import Servant.Server.Internal.Router
50 (tweakResponse, runRouter,
60 (tweakResponse, runRouter,
51 Router, Router'(LeafRouter))
61 Router, Router'(LeafRouter))
52
62
53
63
54−-- * test data types
64+-- * Specs
55−
56−data Person = Person {
57− name :: String,
58− age :: Integer
59− }
60− deriving (Eq, Show, Generic)
61−
62−instance ToJSON Person
63−instance FromJSON Person
64−
65−alice :: Person
66−alice = Person "Alice" 42
67−
68−data Animal = Animal {
69− species :: String,
70− numberOfLegs :: Integer
71− }
72− deriving (Eq, Show, Generic)
73−
74−instance ToJSON Animal
75−instance FromJSON Animal
76−
77−jerry :: Animal
78−jerry = Animal "Mouse" 4
79−
80−tweety :: Animal
81−tweety = Animal "Bird" 2
82−
83−
84−-- * specs
85
65
86spec :: Spec
66spec :: Spec
87spec = do
67spec = do
68+ verbSpec
88 captureSpec
69 captureSpec
89− getSpec
90− headSpec
91− postSpec
92− putSpec
93− patchSpec
94 queryParamSpec
70 queryParamSpec
71+ reqBodySpec
95 headerSpec
72 headerSpec
96 rawSpec
73 rawSpec
97− unionSpec
74+ alternativeSpec
98− routerSpec
99 responseHeadersSpec
75 responseHeadersSpec
100− miscReqCombinatorsSpec
76+ routerSpec
101−
77+ miscCombinatorSpec
78+
79+------------------------------------------------------------------------------
80+-- * verbSpec {{{
81+------------------------------------------------------------------------------
82+
83+type VerbApi method status
84+ = Verb method status '[JSON] Person
85+ :<|> "noContent" :> Verb method status '[JSON] NoContent
86+ :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)
87+ :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)
88+
89+verbSpec :: Spec
90+verbSpec = describe "Servant.API.Verb" $ do
91+ let server :: Server (VerbApi method status)
92+ server = return alice
93+ :<|> return NoContent
94+ :<|> return (addHeader 5 alice)
95+ :<|> return (addHeader 10 NoContent)
96+ get200 = Proxy :: Proxy (VerbApi 'GET 200)
97+ post210 = Proxy :: Proxy (VerbApi 'POST 210)
98+ put203 = Proxy :: Proxy (VerbApi 'PUT 203)
99+ delete280 = Proxy :: Proxy (VerbApi 'DELETE 280)
100+ patch214 = Proxy :: Proxy (VerbApi 'PATCH 214)
101+ wrongMethod m = if m == methodPatch then methodPost else methodPatch
102+ test desc api method (status :: Int) = context desc $
103+
104+ with (return $ serve api server) $ do
105+
106+ -- HEAD and 214/215 need not return bodies
107+ unless (status `elem` [214, 215] || method == methodHead) $
108+ it "returns the person" $ do
109+ response <- Test.Hspec.Wai.request method "/" [] ""
110+ liftIO $ statusCode (simpleStatus response) `shouldBe` status
111+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice
112+
113+ it "returns no content on NoContent" $ do
114+ response <- Test.Hspec.Wai.request method "/noContent" [] ""
115+ liftIO $ statusCode (simpleStatus response) `shouldBe` status
116+ liftIO $ simpleBody response `shouldBe` ""
117+
118+ -- HEAD should not return body
119+ when (method == methodHead) $
120+ it "HEAD returns no content body" $ do
121+ response <- Test.Hspec.Wai.request method "/" [] ""
122+ liftIO $ simpleBody response `shouldBe` ""
123+
124+ it "throws 405 on wrong method " $ do
125+ Test.Hspec.Wai.request (wrongMethod method) "/" [] ""
126+ `shouldRespondWith` 405
127+
128+ it "returns headers" $ do
129+ response1 <- Test.Hspec.Wai.request method "/header" [] ""
130+ liftIO $ statusCode (simpleStatus response1) `shouldBe` status
131+ liftIO $ simpleHeaders response1 `shouldContain` [("H", "5")]
132+
133+ response2 <- Test.Hspec.Wai.request method "/header" [] ""
134+ liftIO $ statusCode (simpleStatus response2) `shouldBe` status
135+ liftIO $ simpleHeaders response2 `shouldContain` [("H", "5")]
136+
137+ it "handles trailing '/' gracefully" $ do
138+ response <- Test.Hspec.Wai.request method "/headerNC/" [] ""
139+ liftIO $ statusCode (simpleStatus response) `shouldBe` status
140+
141+ it "returns 406 if the Accept header is not supported" $ do
142+ Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
143+ `shouldRespondWith` 406
144+
145+ it "responds if the Accept header is supported" $ do
146+ response <- Test.Hspec.Wai.request method ""
147+ [(hAccept, "application/json")] ""
148+ liftIO $ statusCode (simpleStatus response) `shouldBe` status
149+
150+ it "sets the Content-Type header" $ do
151+ response <- Test.Hspec.Wai.request method "" [] ""
152+ liftIO $ simpleHeaders response `shouldContain`
153+ [("Content-Type", "application/json")]
154+
155+ test "GET 200" get200 methodGet 200
156+ test "POST 210" post210 methodPost 210
157+ test "PUT 203" put203 methodPut 203
158+ test "DELETE 280" delete280 methodDelete 280
159+ test "PATCH 214" patch214 methodPatch 214
160+ test "GET 200 with HEAD" get200 methodHead 200
161+
162+-- }}}
163+------------------------------------------------------------------------------
164+-- * captureSpec {{{
165+------------------------------------------------------------------------------
102
166
103type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
167type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
104captureApi :: Proxy CaptureApi
168captureApi :: Proxy CaptureApi
@@ -128,68 +192,10 @@ captureSpec = do
128 it "strips the captured path snippet from pathInfo" $ do
192 it "strips the captured path snippet from pathInfo" $ do
129 get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
193 get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
130
194
131−
195+-- }}}
132−type GetApi = Get '[JSON] Person
196+------------------------------------------------------------------------------
133− :<|> "empty" :> GetNoContent '[JSON] NoContent
197+-- * queryParamSpec {{{
134− :<|> "emptyWithHeaders" :> GetNoContent '[JSON] (Headers '[Header "H" Int] NoContent)
198+------------------------------------------------------------------------------
135− :<|> "post" :> PostNoContent '[JSON] NoContent
136−
137−getApi :: Proxy GetApi
138−getApi = Proxy
139−
140−getSpec :: Spec
141−getSpec = do
142− describe "Servant.API.Get" $ do
143− let server = return alice
144− :<|> return NoContent
145− :<|> return (addHeader 5 NoContent)
146− :<|> return NoContent
147−
148− with (return $ serve getApi server) $ do
149−
150− it "allows to GET a Person" $ do
151− response <- get "/"
152− return response `shouldRespondWith` 200
153− liftIO $ decode' (simpleBody response) `shouldBe` Just alice
154−
155− it "throws 405 (wrong method) on POSTs" $ do
156− post "/" "" `shouldRespondWith` 405
157− post "/empty" "" `shouldRespondWith` 405
158−
159− it "returns headers" $ do
160− get "/emptyWithHeaders" `shouldRespondWith` 204 { matchHeaders = [ "H" <:> "5" ] }
161−
162− it "returns 406 if the Accept header is not supported" $ do
163− Test.Hspec.Wai.request methodGet "" [(hAccept, "crazy/mime")] ""
164− `shouldRespondWith` 406
165−
166−
167−headSpec :: Spec
168−headSpec = do
169− describe "Servant.API.Head" $ do
170− let server = return alice
171− :<|> return NoContent
172− :<|> return (addHeader 5 NoContent)
173− :<|> return NoContent
174− with (return $ serve getApi server) $ do
175−
176− it "allows to GET a Person" $ do
177− response <- Test.Hspec.Wai.request methodHead "/" [] ""
178− return response `shouldRespondWith` 200
179− liftIO $ decode' (simpleBody response) `shouldBe` (Nothing :: Maybe Person)
180−
181− it "does not allow HEAD to POST route" $ do
182− response <- Test.Hspec.Wai.request methodHead "/post" [] ""
183− return response `shouldRespondWith` 405
184−
185− it "throws 405 (wrong method) on POSTs" $ do
186− post "/" "" `shouldRespondWith` 405
187− post "/empty" "" `shouldRespondWith` 405
188−
189− it "returns 406 if the Accept header is not supported" $ do
190− Test.Hspec.Wai.request methodHead "" [(hAccept, "crazy/mime")] ""
191− `shouldRespondWith` 406
192−
193
199
194type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
200type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
195 :<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
201 :<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
@@ -274,122 +280,41 @@ queryParamSpec = do
274 name = "Alice"
280 name = "Alice"
275 }
281 }
276
282
277−type PostApi =
283+-- }}}
284+------------------------------------------------------------------------------
285+-- * reqBodySpec {{{
286+------------------------------------------------------------------------------
278− ReqBody '[JSON] Person :> Post '[JSON] Integer
287+type ReqBodyApi = ReqBody '[JSON] Person :> Post '[JSON] Person
279− :<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
288+ :<|> "blah" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
280− :<|> "empty" :> Post '[JSON] ()
281−
282−postApi :: Proxy PostApi
283−postApi = Proxy
284−
285−postSpec :: Spec
286−postSpec = do
287− describe "Servant.API.Post and .ReqBody" $ do
288− let server = return . age :<|> return . age :<|> return ()
289− with (return $ serve postApi server) $ do
290− let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
291− , "application/json;charset=utf-8")]
292−
293− it "allows to POST a Person" $ do
294− post' "/" (encode alice) `shouldRespondWith` "42"{
295− matchStatus = 200
296− }
297−
298− it "allows alternative routes if all have request bodies" $ do
299− post' "/bla" (encode alice) `shouldRespondWith` "42"{
300− matchStatus = 200
301− }
302−
303− it "handles trailing '/' gracefully" $ do
304− post' "/bla/" (encode alice) `shouldRespondWith` "42"{
305− matchStatus = 200
306− }
307
289
308− it "correctly rejects invalid request bodies with status 400" $ do
290+reqBodyApi :: Proxy ReqBodyApi
309− post' "/" "some invalid body" `shouldRespondWith` 400
291+reqBodyApi = Proxy
310−
311− it "responds with 415 if the request body media type is unsupported" $ do
312− let post'' x = Test.Hspec.Wai.request methodPost x [(hContentType
313− , "application/nonsense")]
314− post'' "/" "anything at all" `shouldRespondWith` 415
315−
316−type PutApi =
317− ReqBody '[JSON] Person :> Put '[JSON] Integer
318− :<|> "bla" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
319− :<|> "empty" :> Put '[JSON] ()
320−
321−putApi :: Proxy PutApi
322−putApi = Proxy
323−
324−putSpec :: Spec
325−putSpec = do
326− describe "Servant.API.Put and .ReqBody" $ do
327− let server = return . age :<|> return . age :<|> return ()
328− with (return $ serve putApi server) $ do
329− let put' x = Test.Hspec.Wai.request methodPut x [(hContentType
330− , "application/json;charset=utf-8")]
331−
332− it "allows to put a Person" $ do
333− put' "/" (encode alice) `shouldRespondWith` "42"{
334− matchStatus = 200
335− }
336
292
337− it "allows alternative routes if all have request bodies" $ do
293+reqBodySpec :: Spec
338− put' "/bla" (encode alice) `shouldRespondWith` "42"{
294+reqBodySpec = describe "Servant.API.ReqBody" $ do
339− matchStatus = 200
340− }
341
295
342− it "handles trailing '/' gracefully" $ do
296+ let server :: Server ReqBodyApi
343− put' "/bla/" (encode alice) `shouldRespondWith` "42"{
297+ server = return :<|> return . age
344− matchStatus = 200
298+ mkReq method x = Test.Hspec.Wai.request method x
345− }
299+ [(hContentType, "application/json;charset=utf-8")]
346
300
347− it "correctly rejects invalid request bodies with status 400" $ do
348− put' "/" "some invalid body" `shouldRespondWith` 400
349−
350− it "responds with 415 if the request body media type is unsupported" $ do
351− let put'' x = Test.Hspec.Wai.request methodPut x [(hContentType
352− , "application/nonsense")]
353− put'' "/" "anything at all" `shouldRespondWith` 415
354−
355−type PatchApi =
356− ReqBody '[JSON] Person :> Patch '[JSON] Integer
357− :<|> "bla" :> ReqBody '[JSON] Person :> Patch '[JSON] Integer
358− :<|> "empty" :> Patch '[JSON] ()
359−
360−patchApi :: Proxy PatchApi
361−patchApi = Proxy
362−
363−patchSpec :: Spec
364−patchSpec = do
365− describe "Servant.API.Patch and .ReqBody" $ do
366− let server = return . age :<|> return . age :<|> return ()
367− with (return $ serve patchApi server) $ do
301+ with (return $ serve reqBodyApi server) $ do
368− let patch' x = Test.Hspec.Wai.request methodPatch x [(hContentType
369− , "application/json;charset=utf-8")]
370−
371− it "allows to patch a Person" $ do
372− patch' "/" (encode alice) `shouldRespondWith` "42"{
373− matchStatus = 200
374− }
375
302
376− it "allows alternative routes if all have request bodies" $ do
303+ it "passes the argument to the handler" $ do
377− patch' "/bla" (encode alice) `shouldRespondWith` "42"{
304+ response <- mkReq methodPost "" (encode alice)
378− matchStatus = 200
305+ liftIO $ decode' (simpleBody response) `shouldBe` Just alice
379− }
380
306
381− it "handles trailing '/' gracefully" $ do
307+ it "rejects invalid request bodies with status 400" $ do
382− patch' "/bla/" (encode alice) `shouldRespondWith` "42"{
308+ mkReq methodPut "/blah" "some invalid body" `shouldRespondWith` 400
383− matchStatus = 200
384− }
385
309
386− it "correctly rejects invalid request bodies with status 400" $ do
310+ it "responds with 415 if the request body media type is unsupported" $ do
387− patch' "/" "some invalid body" `shouldRespondWith` 400
311+ Test.Hspec.Wai.request methodPost "/"
312+ [(hContentType, "application/nonsense")] "" `shouldRespondWith` 415
388
313
389− it "responds with 415 if the request body media type is unsupported" $ do
314+-- }}}
390− let patch'' x = Test.Hspec.Wai.request methodPatch x [(hContentType
315+------------------------------------------------------------------------------
391− , "application/nonsense")]
316+-- * headerSpec {{{
392− patch'' "/" "anything at all" `shouldRespondWith` 415
317+------------------------------------------------------------------------------
393
318
394type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] ()
319type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] ()
395headerApi :: Proxy (HeaderApi a)
320headerApi :: Proxy (HeaderApi a)
@@ -418,12 +343,19 @@ headerSpec = describe "Servant.API.Header" $ do
418 it "passes the header to the handler (String)" $
343 it "passes the header to the handler (String)" $
419 delete' "/" "" `shouldRespondWith` 200
344 delete' "/" "" `shouldRespondWith` 200
420
345
346+-- }}}
347+------------------------------------------------------------------------------
348+-- * rawSpec {{{
349+------------------------------------------------------------------------------
421
350
422type RawApi = "foo" :> Raw
351type RawApi = "foo" :> Raw
352+
423rawApi :: Proxy RawApi
353rawApi :: Proxy RawApi
424rawApi = Proxy
354rawApi = Proxy
355+
425rawApplication :: Show a => (Request -> a) -> Application
356rawApplication :: Show a => (Request -> a) -> Application
426−rawApplication f request_ respond = respond $ responseLBS ok200 [] (cs $ show $ f request_)
357+rawApplication f request_ respond = respond $ responseLBS ok200 []
358+ (cs $ show $ f request_)
427
359
428rawSpec :: Spec
360rawSpec :: Spec
429rawSpec = do
361rawSpec = do
@@ -444,7 +376,10 @@ rawSpec = do
444 liftIO $ do
376 liftIO $ do
445 simpleBody response `shouldBe` cs (show ["bar" :: String])
377 simpleBody response `shouldBe` cs (show ["bar" :: String])
446
378
447−
379+-- }}}
380+------------------------------------------------------------------------------
381+-- * alternativeSpec {{{
382+------------------------------------------------------------------------------
448type AlternativeApi =
383type AlternativeApi =
449 "foo" :> Get '[JSON] Person
384 "foo" :> Get '[JSON] Person
450 :<|> "bar" :> Get '[JSON] Animal
385 :<|> "bar" :> Get '[JSON] Animal
@@ -452,11 +387,12 @@ type AlternativeApi =
452 :<|> "bar" :> Post '[JSON] Animal
387 :<|> "bar" :> Post '[JSON] Animal
453 :<|> "bar" :> Put '[JSON] Animal
388 :<|> "bar" :> Put '[JSON] Animal
454 :<|> "bar" :> Delete '[JSON] ()
389 :<|> "bar" :> Delete '[JSON] ()
455−unionApi :: Proxy AlternativeApi
456−unionApi = Proxy
457
390
391+alternativeApi :: Proxy AlternativeApi
392+alternativeApi = Proxy
393+
458−unionServer :: Server AlternativeApi
394+alternativeServer :: Server AlternativeApi
459−unionServer =
395+alternativeServer =
460 return alice
396 return alice
461 :<|> return jerry
397 :<|> return jerry
462 :<|> return "a string"
398 :<|> return "a string"
@@ -464,10 +400,10 @@ unionServer =
464 :<|> return jerry
400 :<|> return jerry
465 :<|> return ()
401 :<|> return ()
466
402
467−unionSpec :: Spec
403+alternativeSpec :: Spec
468−unionSpec = do
404+alternativeSpec = do
469 describe "Servant.API.Alternative" $ do
405 describe "Servant.API.Alternative" $ do
470− with (return $ serve unionApi unionServer) $ do
406+ with (return $ serve alternativeApi alternativeServer) $ do
471
407
472 it "unions endpoints" $ do
408 it "unions endpoints" $ do
473 response <- get "/foo"
409 response <- get "/foo"
@@ -484,7 +420,10 @@ unionSpec = do
484
420
485 it "returns 404 if the path does not exist" $ do
421 it "returns 404 if the path does not exist" $ do
486 get "/nonexistent" `shouldRespondWith` 404
422 get "/nonexistent" `shouldRespondWith` 404
487−
423+-- }}}
424+------------------------------------------------------------------------------
425+-- * responseHeaderSpec {{{
426+------------------------------------------------------------------------------
488type ResponseHeadersApi =
427type ResponseHeadersApi =
489 Get '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
428 Get '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
490 :<|> Post '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
429 :<|> Post '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
@@ -501,26 +440,29 @@ responseHeadersSpec :: Spec
501responseHeadersSpec = describe "ResponseHeaders" $ do
440responseHeadersSpec = describe "ResponseHeaders" $ do
502 with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
441 with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
503
442
504− let methods = [(methodGet, 200), (methodPost, 200), (methodPut, 200), (methodPatch, 200)]
443+ let methods = [methodGet, methodPost, methodPut, methodPatch]
505
444
506 it "includes the headers in the response" $
445 it "includes the headers in the response" $
507− forM_ methods $ \(method, expected) ->
446+ forM_ methods $ \method ->
508 Test.Hspec.Wai.request method "/" [] ""
447 Test.Hspec.Wai.request method "/" [] ""
509 `shouldRespondWith` "\"hi\""{ matchHeaders = ["H1" <:> "5", "H2" <:> "kilroy"]
448 `shouldRespondWith` "\"hi\""{ matchHeaders = ["H1" <:> "5", "H2" <:> "kilroy"]
510− , matchStatus = expected
449+ , matchStatus = 200
511 }
450 }
512
451
513 it "responds with not found for non-existent endpoints" $
452 it "responds with not found for non-existent endpoints" $
514− forM_ methods $ \(method,_) ->
453+ forM_ methods $ \method ->
515 Test.Hspec.Wai.request method "blahblah" [] ""
454 Test.Hspec.Wai.request method "blahblah" [] ""
516 `shouldRespondWith` 404
455 `shouldRespondWith` 404
517
456
518 it "returns 406 if the Accept header is not supported" $
457 it "returns 406 if the Accept header is not supported" $
519− forM_ methods $ \(method,_) ->
458+ forM_ methods $ \method ->
520 Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
459 Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
521 `shouldRespondWith` 406
460 `shouldRespondWith` 406
522
461
523−
462+-- }}}
463+------------------------------------------------------------------------------
464+-- * routerSpec {{{
465+------------------------------------------------------------------------------
524routerSpec :: Spec
466routerSpec :: Spec
525routerSpec = do
467routerSpec = do
526 describe "Servant.Server.Internal.Router" $ do
468 describe "Servant.Server.Internal.Router" $ do
@@ -539,6 +481,10 @@ routerSpec = do
539 it "calls f on route result" $ do
481 it "calls f on route result" $ do
540 get "" `shouldRespondWith` 202
482 get "" `shouldRespondWith` 202
541
483
484+-- }}}
485+------------------------------------------------------------------------------
486+-- * miscCombinatorSpec {{{
487+------------------------------------------------------------------------------
542type MiscCombinatorsAPI
488type MiscCombinatorsAPI
543 = "version" :> HttpVersion :> Get '[JSON] String
489 = "version" :> HttpVersion :> Get '[JSON] String
544 :<|> "secure" :> IsSecure :> Get '[JSON] String
490 :<|> "secure" :> IsSecure :> Get '[JSON] String
@@ -557,8 +503,8 @@ miscServ = versionHandler
557 secureHandler NotSecure = return "not secure"
503 secureHandler NotSecure = return "not secure"
558 hostHandler = return . show
504 hostHandler = return . show
559
505
560−miscReqCombinatorsSpec :: Spec
506+miscCombinatorSpec :: Spec
561−miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
507+miscCombinatorSpec = with (return $ serve miscApi miscServ) $
562 describe "Misc. combinators for request inspection" $ do
508 describe "Misc. combinators for request inspection" $ do
563 it "Successfully gets the HTTP version specified in the request" $
509 it "Successfully gets the HTTP version specified in the request" $
564 go "/version" "\"HTTP/1.0\""
510 go "/version" "\"HTTP/1.0\""
@@ -570,3 +516,35 @@ miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
570 go "/host" "\"0.0.0.0:0\""
516 go "/host" "\"0.0.0.0:0\""
571
517
572 where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res
518 where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res
519+-- }}}
520+------------------------------------------------------------------------------
521+-- * Test data types {{{
522+------------------------------------------------------------------------------
523+
524+data Person = Person {
525+ name :: String,
526+ age :: Integer
527+ }
528+ deriving (Eq, Show, Generic)
529+
530+instance ToJSON Person
531+instance FromJSON Person
532+
533+alice :: Person
534+alice = Person "Alice" 42
535+
536+data Animal = Animal {
537+ species :: String,
538+ numberOfLegs :: Integer
539+ }
540+ deriving (Eq, Show, Generic)
541+
542+instance ToJSON Animal
543+instance FromJSON Animal
544+
545+jerry :: Animal
546+jerry = Animal "Mouse" 4
547+
548+tweety :: Animal
549+tweety = Animal "Bird" 2
550+-- }}}
servant/src/Servant/API.hs+2−2
@@ -70,7 +70,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),
70 getHeadersHList, getResponse)
70 getHeadersHList, getResponse)
71import Servant.API.Sub ((:>))
71import Servant.API.Sub ((:>))
72import Servant.API.Vault (Vault)
72import Servant.API.Vault (Vault)
73−import Servant.API.Verbs (Created, Delete, DeleteAccepted,
73+import Servant.API.Verbs (PostCreated, Delete, DeleteAccepted,
74 DeleteNoContent,
74 DeleteNoContent,
75 DeleteNonAuthoritative, Get,
75 DeleteNonAuthoritative, Get,
76 GetAccepted, GetNoContent,
76 GetAccepted, GetNoContent,
@@ -87,7 +87,7 @@ import Servant.API.Verbs (Created, Delete, DeleteAccepted,
87 PutAccepted, PutNoContent,
87 PutAccepted, PutNoContent,
88 PutNoContent, PutNonAuthoritative,
88 PutNoContent, PutNonAuthoritative,
89 ReflectMethod (reflectMethod),
89 ReflectMethod (reflectMethod),
90− Verb)
90+ Verb, StdMethod(..))
91import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
91import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
92 URI (..), safeLink)
92 URI (..), safeLink)
93import Web.HttpApiData (FromHttpApiData (..),
93import Web.HttpApiData (FromHttpApiData (..),
servant/src/Servant/API/ContentTypes.hs+1−1
@@ -304,7 +304,7 @@ instance MimeRender OctetStream ByteString where
304instance MimeRender OctetStream BS.ByteString where
304instance MimeRender OctetStream BS.ByteString where
305 mimeRender _ = fromStrict
305 mimeRender _ = fromStrict
306
306
307−-- | A type for responses with content-body.
307+-- | A type for responses without content-body.
308data NoContent = NoContent
308data NoContent = NoContent
309 deriving (Show, Eq, Read)
309 deriving (Show, Eq, Read)
310
310
servant/src/Servant/API/Verbs.hs+9−6
@@ -3,17 +3,20 @@
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE PolyKinds #-}
6−module Servant.API.Verbs where
6+module Servant.API.Verbs
7+ ( module Servant.API.Verbs
8+ , StdMethod(GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS, PATCH)
9+ ) where
7
10
8import Data.Typeable (Typeable)
11import Data.Typeable (Typeable)
12+import Data.Proxy (Proxy)
9import GHC.Generics (Generic)
13import GHC.Generics (Generic)
10import GHC.TypeLits (Nat)
14import GHC.TypeLits (Nat)
11import Network.HTTP.Types.Method (Method, StdMethod (..),
15import Network.HTTP.Types.Method (Method, StdMethod (..),
12 methodDelete, methodGet, methodHead,
16 methodDelete, methodGet, methodHead,
13 methodPatch, methodPost, methodPut)
17 methodPatch, methodPost, methodPut)
14−import Servant.API.ContentTypes (NoContent(..))
15
18
16−-- | @Verb@ is a general type for representing HTTP verbs/methods. For
19+-- | @Verb@ is a general type for representing HTTP verbs (a.k.a. methods). For
17-- convenience, type synonyms for each verb with a 200 response code are
20-- convenience, type synonyms for each verb with a 200 response code are
18-- provided, but you are free to define your own:
21-- provided, but you are free to define your own:
19--
22--
@@ -55,7 +58,7 @@ type Patch contentTypes a = Verb 'PATCH 200 contentTypes a
55
58
56-- | 'POST' with 201 status code.
59-- | 'POST' with 201 status code.
57--
60--
58−type Created contentTypes a = Verb 'POST 201 contentTypes a
61+type PostCreated contentTypes a = Verb 'POST 201 contentTypes a
59
62
60
63
61-- ** 202 Accepted
64-- ** 202 Accepted
@@ -141,11 +144,11 @@ type PutResetContent contentTypes noContent = Verb 'PUT 205 contentTypes noConte
141-- RFC7233 Section 4.1>
144-- RFC7233 Section 4.1>
142
145
143-- | 'GET' with 206 status code.
146-- | 'GET' with 206 status code.
144−type GetPartialContent contentTypes noContent = Verb 'GET 205 contentTypes noContent
147+type GetPartialContent contentTypes noContent = Verb 'GET 206 contentTypes noContent
145
148
146
149
147class ReflectMethod a where
150class ReflectMethod a where
148− reflectMethod :: proxy a -> Method
151+ reflectMethod :: Proxy a -> Method
149
152
150instance ReflectMethod 'GET where
153instance ReflectMethod 'GET where
151 reflectMethod _ = methodGet
154 reflectMethod _ = methodGet
servant/src/Servant/Utils/Links.hs+1−3
@@ -74,9 +74,7 @@
74-- >>> safeLink api bad_link
74-- >>> safeLink api bad_link
75-- ...
75-- ...
76-- Could not deduce (Or
76-- Could not deduce (Or
77−-- (IsElem'
78−-- (Verb 'Network.HTTP.Types.Method.DELETE 200 '[JSON] ())
77+-- (IsElem' (Verb 'DELETE 200 '[JSON] ()) (Verb 'GET 200 '[JSON] Int))
79−-- (Verb 'Network.HTTP.Types.Method.GET 200 '[JSON] Int))
80-- (IsElem'
78-- (IsElem'
81-- ("hello" :> Delete '[JSON] ())
79-- ("hello" :> Delete '[JSON] ())
82-- ("bye" :> (QueryParam "name" String :> Delete '[JSON] ()))))
80-- ("bye" :> (QueryParam "name" String :> Delete '[JSON] ()))))