git.iko.soy/typeable/servant
on f76c729 help sign in
typeable/servant/test/Servant/ServerSpec.hs
449 lines 15 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE QuasiQuotes #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeOperators #-}
8module Servant.ServerSpec where
11import Control.Monad (when)
12import Control.Monad.Trans.Either (EitherT, left)
13import Data.Aeson (ToJSON, FromJSON, encode, decode')
14import Data.Char (toUpper)
15import Data.Monoid ((<>))
16import Data.Proxy (Proxy(Proxy))
17import Data.String (fromString)
18import Data.String.Conversions (cs)
19import GHC.Generics (Generic)
20import Network.HTTP.Types ( parseQuery, ok200, status409, methodPost
21 , methodDelete, hContentType)
22import Network.Wai ( Application, Request, responseLBS, pathInfo
23 , queryString, rawQueryString )
24import Network.Wai.Test (runSession, defaultRequest, simpleBody, request)
25import Test.Hspec (Spec, describe, it, shouldBe)
26import Test.Hspec.Wai ( liftIO, with, get, post, shouldRespondWith
27 , matchStatus, request )
29import Servant.API (JSON, Capture, Get, ReqBody, Post, QueryParam
30 , QueryParams, QueryFlag, MatrixParam, MatrixParams
31 , MatrixFlag, Raw, (:>), (:<|>)(..), Header, Delete )
32import Servant.Server (Server, serve)
33import Servant.Server.Internal (RouteMismatch(..))
36-- * test data types
38data Person = Person {
39 name :: String,
40 age :: Integer
41 }
42 deriving (Eq, Show, Generic)
44instance ToJSON Person
45instance FromJSON Person
47alice :: Person
48alice = Person "Alice" 42
50data Animal = Animal {
51 species :: String,
52 numberOfLegs :: Integer
53 }
54 deriving (Eq, Show, Generic)
56instance ToJSON Animal
57instance FromJSON Animal
59jerry :: Animal
60jerry = Animal "Mouse" 4
62tweety :: Animal
63tweety = Animal "Bird" 2
66-- * specs
68spec :: Spec
69spec = do
70 captureSpec
71 getSpec
72 queryParamSpec
73 matrixParamSpec
74 postSpec
75 headerSpec
76 rawSpec
77 unionSpec
78 errorsSpec
81type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
82captureApi :: Proxy CaptureApi
83captureApi = Proxy
84captureServer :: Integer -> EitherT (Int, String) IO Animal
85captureServer legs = case legs of
86 4 -> return jerry
87 2 -> return tweety
88 _ -> left (404, "not found")
90captureSpec :: Spec
91captureSpec = do
92 describe "Servant.API.Capture" $ do
93 with (return (serve captureApi captureServer)) $ do
94 it "can capture parts of the 'pathInfo'" $ do
95 response <- get "/2"
96 liftIO $ do
97 decode' (simpleBody response) `shouldBe` Just tweety
99 with (return (serve
100 (Proxy :: Proxy (Capture "captured" String :> Raw))
101 (\ "captured" request_ respond ->
102 respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
103 it "strips the captured path snippet from pathInfo" $ do
104 get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
107type GetApi = Get '[JSON] Person
108getApi :: Proxy GetApi
109getApi = Proxy
111getSpec :: Spec
112getSpec = do
113 describe "Servant.API.Get" $ do
114 with (return (serve getApi (return alice))) $ do
115 it "allows to GET a Person" $ do
116 response <- get "/"
117 return response `shouldRespondWith` 200
118 liftIO $ do
119 decode' (simpleBody response) `shouldBe` Just alice
121 it "throws 405 (wrong method) on POSTs" $ do
122 post "/" "" `shouldRespondWith` 405
125type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
126 :<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
127 :<|> "b" :> QueryFlag "capitalize" :> Get '[JSON] Person
129queryParamApi :: Proxy QueryParamApi
130queryParamApi = Proxy
132qpServer :: Server QueryParamApi
133qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize
135 where qpNames (_:name2:_) = return alice { name = name2 }
136 qpNames _ = return alice
138 qpCapitalize False = return alice
139 qpCapitalize True = return alice { name = map toUpper (name alice) }
141 queryParamServer (Just name_) = return alice{name = name_}
142 queryParamServer Nothing = return alice
144queryParamSpec :: Spec
145queryParamSpec = do
146 describe "Servant.API.QueryParam" $ do
147 it "allows to retrieve simple GET parameters" $
148 (flip runSession) (serve queryParamApi qpServer) $ do
149 let params1 = "?name=bob"
150 response1 <- Network.Wai.Test.request defaultRequest{
151 rawQueryString = params1,
152 queryString = parseQuery params1
153 }
154 liftIO $ do
155 decode' (simpleBody response1) `shouldBe` Just alice{
156 name = "bob"
157 }
159 it "allows to retrieve lists in GET parameters" $
160 (flip runSession) (serve queryParamApi qpServer) $ do
161 let params2 = "?names[]=bob&names[]=john"
162 response2 <- Network.Wai.Test.request defaultRequest{
163 rawQueryString = params2,
164 queryString = parseQuery params2,
165 pathInfo = ["a"]
166 }
167 liftIO $
168 decode' (simpleBody response2) `shouldBe` Just alice{
169 name = "john"
170 }
173 it "allows to retrieve value-less GET parameters" $
174 (flip runSession) (serve queryParamApi qpServer) $ do
175 let params3 = "?capitalize"
176 response3 <- Network.Wai.Test.request defaultRequest{
177 rawQueryString = params3,
178 queryString = parseQuery params3,
179 pathInfo = ["b"]
180 }
181 liftIO $
182 decode' (simpleBody response3) `shouldBe` Just alice{
183 name = "ALICE"
184 }
186 let params3' = "?capitalize="
187 response3' <- Network.Wai.Test.request defaultRequest{
188 rawQueryString = params3',
189 queryString = parseQuery params3',
190 pathInfo = ["b"]
191 }
192 liftIO $
193 decode' (simpleBody response3') `shouldBe` Just alice{
194 name = "ALICE"
195 }
197 let params3'' = "?unknown="
198 response3' <- Network.Wai.Test.request defaultRequest{
199 rawQueryString = params3'',
200 queryString = parseQuery params3'',
201 pathInfo = ["b"]
202 }
203 liftIO $
204 decode' (simpleBody response3') `shouldBe` Just alice{
205 name = "Alice"
206 }
208type MatrixParamApi = "a" :> MatrixParam "name" String :> Get '[JSON] Person
209 :<|> "b" :> MatrixParams "names" String :> "bsub" :> MatrixParams "names" String :> Get '[JSON] Person
210 :<|> "c" :> MatrixFlag "capitalize" :> Get '[JSON] Person
211 :<|> "d" :> Capture "foo" Integer :> MatrixParam "name" String :> MatrixFlag "capitalize" :> "dsub" :> Get '[JSON] Person
213matrixParamApi :: Proxy MatrixParamApi
214matrixParamApi = Proxy
216mpServer :: Server MatrixParamApi
217mpServer = matrixParamServer :<|> mpNames :<|> mpCapitalize alice :<|> mpComplex
218 where mpNames (_:name2:_) _ = return alice { name = name2 }
219 mpNames _ _ = return alice
221 mpCapitalize p False = return p
222 mpCapitalize p True = return p { name = map toUpper (name p) }
224 matrixParamServer (Just name) = return alice{name = name}
225 matrixParamServer Nothing = return alice
227 mpAge age p = return p { age = age }
228 mpComplex capture name cap = matrixParamServer name >>= flip mpCapitalize cap >>= mpAge capture
230matrixParamSpec :: Spec
231matrixParamSpec = do
232 describe "Servant.API.MatrixParam" $ do
233 it "allows to retrieve simple matrix parameters" $
234 (flip runSession) (serve matrixParamApi mpServer) $ do
235 response1 <- Network.Wai.Test.request defaultRequest{
236 pathInfo = ["a;name=bob"]
237 }
238 liftIO $ do
239 decode' (simpleBody response1) `shouldBe` Just alice{
240 name = "bob"
241 }
243 it "allows to retrieve lists in matrix parameters" $
244 (flip runSession) (serve matrixParamApi mpServer) $ do
245 response2 <- Network.Wai.Test.request defaultRequest{
246 pathInfo = ["b;names=bob;names=john", "bsub;names=anna;names=sarah"]
247 }
248 liftIO $
249 decode' (simpleBody response2) `shouldBe` Just alice{
250 name = "john"
251 }
253 it "allows to retrieve value-less matrix parameters" $
254 (flip runSession) (serve matrixParamApi mpServer) $ do
255 response3 <- Network.Wai.Test.request defaultRequest{
256 pathInfo = ["c;capitalize"]
257 }
258 liftIO $
259 decode' (simpleBody response3) `shouldBe` Just alice{
260 name = "ALICE"
261 }
263 response3' <- Network.Wai.Test.request defaultRequest{
264 pathInfo = ["c;capitalize="]
265 }
266 liftIO $
267 decode' (simpleBody response3') `shouldBe` Just alice{
268 name = "ALICE"
269 }
271 it "allows to retrieve matrix parameters on captured segments" $
272 (flip runSession) (serve matrixParamApi mpServer) $ do
273 response4 <- Network.Wai.Test.request defaultRequest{
274 pathInfo = ["d", "12;name=stephen;capitalize", "dsub"]
275 }
276 liftIO $
277 decode' (simpleBody response4) `shouldBe` Just alice{
278 name = "STEPHEN",
279 age = 12
280 }
282 response4' <- Network.Wai.Test.request defaultRequest{
283 pathInfo = ["d;ignored=1", "5", "dsub"]
284 }
285 liftIO $
286 decode' (simpleBody response4') `shouldBe` Just alice{
287 name = "Alice",
288 age = 5
289 }
291type PostApi =
292 ReqBody '[JSON] Person :> Post '[JSON] Integer
293 :<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
294postApi :: Proxy PostApi
295postApi = Proxy
297postSpec :: Spec
298postSpec = do
299 describe "Servant.API.Post and .ReqBody" $ do
300 with (return (serve postApi (return . age :<|> return . age))) $ do
301 let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
302 , "application/json;charset=utf-8")]
304 it "allows to POST a Person" $ do
305 post' "/" (encode alice) `shouldRespondWith` "42"{
306 matchStatus = 201
307 }
309 it "allows alternative routes if all have request bodies" $ do
310 post' "/bla" (encode alice) `shouldRespondWith` "42"{
311 matchStatus = 201
312 }
314 it "handles trailing '/' gracefully" $ do
315 post' "/bla/" (encode alice) `shouldRespondWith` "42"{
316 matchStatus = 201
317 }
319 it "correctly rejects invalid request bodies with status 400" $ do
320 post' "/" "some invalid body" `shouldRespondWith` 400
322 it "responds with 415 if the requested media type is unsupported" $ do
323 let post'' x = Test.Hspec.Wai.request methodPost x [(hContentType
324 , "application/nonsense")]
325 post'' "/" "anything at all" `shouldRespondWith` 415
327type HeaderApi a = Header "MyHeader" a :> Delete
328headerApi :: Proxy (HeaderApi a)
329headerApi = Proxy
331headerSpec :: Spec
332headerSpec = describe "Servant.API.Header" $ do
334 let expectsInt :: Maybe Int -> EitherT (Int,String) IO ()
335 expectsInt (Just x) = when (x /= 5) $ error "Expected 5"
336 expectsInt Nothing = error "Expected an int"
338 let expectsString :: Maybe String -> EitherT (Int,String) IO ()
339 expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
340 expectsString Nothing = error "Expected a string"
342 with (return (serve headerApi expectsInt)) $ do
343 let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"5")]
345 it "passes the header to the handler (Int)" $
346 delete' "/" "" `shouldRespondWith` 204
348 with (return (serve headerApi expectsString)) $ do
349 let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"more from you")]
351 it "passes the header to the handler (String)" $
352 delete' "/" "" `shouldRespondWith` 204
355type RawApi = "foo" :> Raw
356rawApi :: Proxy RawApi
357rawApi = Proxy
358rawApplication :: Show a => (Request -> a) -> Application
359rawApplication f request_ respond = respond $ responseLBS ok200 [] (cs $ show $ f request_)
361rawSpec :: Spec
362rawSpec = do
363 describe "Servant.API.Raw" $ do
364 it "runs applications" $ do
365 (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
366 response <- Network.Wai.Test.request defaultRequest{
367 pathInfo = ["foo"]
368 }
369 liftIO $ do
370 simpleBody response `shouldBe` "42"
372 it "gets the pathInfo modified" $ do
373 (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
374 response <- Network.Wai.Test.request defaultRequest{
375 pathInfo = ["foo", "bar"]
376 }
377 liftIO $ do
378 simpleBody response `shouldBe` cs (show ["bar" :: String])
381type AlternativeApi =
382 "foo" :> Get '[JSON] Person
383 :<|> "bar" :> Get '[JSON] Animal
384unionApi :: Proxy AlternativeApi
385unionApi = Proxy
387unionServer :: Server AlternativeApi
388unionServer =
389 return alice
390 :<|> return jerry
392unionSpec :: Spec
393unionSpec = do
394 describe "Servant.API.Alternative" $ do
395 with (return $ serve unionApi unionServer) $ do
396 it "unions endpoints" $ do
397 response <- get "/foo"
398 liftIO $ do
399 decode' (simpleBody response) `shouldBe`
400 Just alice
401 response_ <- get "/bar"
402 liftIO $ do
403 decode' (simpleBody response_) `shouldBe`
404 Just jerry
406-- | Test server error functionality.
407errorsSpec :: Spec
408errorsSpec = do
409 let he = HttpError status409 (Just "A custom error")
410 let ib = InvalidBody "The body is invalid"
411 let wm = WrongMethod
412 let nf = NotFound
414 describe "Servant.Server.Internal.RouteMismatch" $ do
415 it "HttpError > *" $ do
416 ib <> he `shouldBe` he
417 wm <> he `shouldBe` he
418 nf <> he `shouldBe` he
420 he <> ib `shouldBe` he
421 he <> wm `shouldBe` he
422 he <> nf `shouldBe` he
424 it "HE > InvalidBody > (WM,NF)" $ do
425 he <> ib `shouldBe` he
426 wm <> ib `shouldBe` ib
427 nf <> ib `shouldBe` ib
429 ib <> he `shouldBe` he
430 ib <> wm `shouldBe` ib
431 ib <> nf `shouldBe` ib
433 it "HE > IB > WrongMethod > NF" $ do
434 he <> wm `shouldBe` he
435 ib <> wm `shouldBe` ib
436 nf <> wm `shouldBe` wm
438 wm <> he `shouldBe` he
439 wm <> ib `shouldBe` ib
440 wm <> nf `shouldBe` wm
442 it "* > NotFound" $ do
443 he <> nf `shouldBe` he
444 ib <> nf `shouldBe` ib
445 wm <> nf `shouldBe` wm
447 nf <> he `shouldBe` he
448 nf <> ib `shouldBe` ib
449 nf <> wm `shouldBe` wm