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