@@ -1,36 +1,40 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE QuasiQuotes #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE OverloadedStrings #-}
54{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE TypeOperators #-}
76
87module Servant.ServerSpec where
98
109
11−import Control.Monad (when)
12−import Control.Monad.Trans.Either (EitherT, left)
13−import Data.Aeson (ToJSON, FromJSON, encode, decode')
14−import Data.Char (toUpper)
15−import Data.Monoid ((<>))
16−import Data.Proxy (Proxy(Proxy))
17−import Data.String (fromString)
18−import Data.String.Conversions (cs)
19−import GHC.Generics (Generic)
20−import Network.HTTP.Types ( parseQuery, ok200, status409, methodPost
21− , methodDelete, hContentType)
22−import Network.Wai ( Application, Request, responseLBS, pathInfo
23− , queryString, rawQueryString )
24−import Network.Wai.Test (runSession, defaultRequest, simpleBody, request)
25−import Test.Hspec (Spec, describe, it, shouldBe)
26−import Test.Hspec.Wai ( liftIO, with, get, post, shouldRespondWith
27− , matchStatus, request )
28−
29−import Servant.API (JSON, Capture, Get, ReqBody, Post, QueryParam
30− , QueryParams, QueryFlag, MatrixParam, MatrixParams
31− , MatrixFlag, Raw, (:>), (:<|>)(..), Header, Delete )
32−import Servant.Server (Server, serve)
33−import Servant.Server.Internal (RouteMismatch(..))
10+import Control.Monad (when)
11+import Control.Monad.Trans.Either (EitherT, left)
12+import Data.Aeson (FromJSON, ToJSON, decode', encode)
13+import Data.Char (toUpper)
14+import Data.Monoid ((<>))
15+import Data.Proxy (Proxy (Proxy))
16+import Data.String (fromString)
17+import Data.String.Conversions (cs)
18+import GHC.Generics (Generic)
19+import Network.HTTP.Types (hContentType, methodDelete,
20+ methodPatch, methodPost, methodPut,
21+ ok200, parseQuery, status409)
22+import Network.Wai (Application, Request, pathInfo,
23+ queryString, rawQueryString,
24+ responseLBS)
25+import Network.Wai.Test (defaultRequest, request,
26+ runSession, simpleBody)
27+import Test.Hspec (Spec, describe, it, shouldBe)
28+import Test.Hspec.Wai (get, liftIO, matchStatus, post,
29+ request, shouldRespondWith, with)
30+
31+import Servant.API ((:<|>) (..), (:>), Capture, Delete,
32+ Get, Header, JSON, MatrixFlag,
33+ MatrixParam, MatrixParams, Patch,
34+ Post, Put, QueryFlag, QueryParam,
35+ QueryParams, Raw, ReqBody)
36+import Servant.Server (Server, serve)
37+import Servant.Server.Internal (RouteMismatch (..))
3438
3539
3640-- * test data types
@@ -69,9 +73,11 @@ spec :: Spec
6973spec = do
7074 captureSpec
7175 getSpec
76+ postSpec
77+ putSpec
78+ patchSpec
7279 queryParamSpec
7380 matrixParamSpec
74− postSpec
7581 headerSpec
7682 rawSpec
7783 unionSpec
@@ -105,13 +111,15 @@ captureSpec = do
105111
106112
107113type GetApi = Get '[JSON] Person
114+ :<|> "empty" :> Get '[] ()
108115getApi :: Proxy GetApi
109116getApi = Proxy
110117
111118getSpec :: Spec
112119getSpec = do
113120 describe "Servant.API.Get" $ do
114− with (return (serve getApi (return alice))) $ do
121+ let server = return alice :<|> return ()
122+ with (return $ serve getApi server) $ do
115123 it "allows to GET a Person" $ do
116124 response <- get "/"
117125 return response `shouldRespondWith` 200
@@ -121,6 +129,10 @@ getSpec = do
121129 it "throws 405 (wrong method) on POSTs" $ do
122130 post "/" "" `shouldRespondWith` 405
123131
132+ it "returns 204 if the type is '()'" $ do
133+ get "empty" `shouldRespondWith` ""{ matchStatus = 204 }
134+
135+
124136
125137type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
126138 :<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
@@ -291,13 +303,16 @@ matrixParamSpec = do
291303type PostApi =
292304 ReqBody '[JSON] Person :> Post '[JSON] Integer
293305 :<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
306+ :<|> "empty" :> Post '[] ()
307+
294308postApi :: Proxy PostApi
295309postApi = Proxy
296310
297311postSpec :: Spec
298312postSpec = do
299313 describe "Servant.API.Post and .ReqBody" $ do
300− with (return (serve postApi (return . age :<|> return . age))) $ do
314+ let server = return . age :<|> return . age :<|> return ()
315+ with (return $ serve postApi server) $ do
301316 let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
302317 , "application/json;charset=utf-8")]
303318
@@ -319,11 +334,98 @@ postSpec = do
319334 it "correctly rejects invalid request bodies with status 400" $ do
320335 post' "/" "some invalid body" `shouldRespondWith` 400
321336
337+ it "returns 204 if the type is '()'" $ do
338+ post' "empty" "" `shouldRespondWith` ""{ matchStatus = 204 }
339+
322340 it "responds with 415 if the requested media type is unsupported" $ do
323341 let post'' x = Test.Hspec.Wai.request methodPost x [(hContentType
324342 , "application/nonsense")]
325343 post'' "/" "anything at all" `shouldRespondWith` 415
326344
345+type PutApi =
346+ ReqBody '[JSON] Person :> Put '[JSON] Integer
347+ :<|> "bla" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
348+ :<|> "empty" :> Put '[] ()
349+
350+putApi :: Proxy PutApi
351+putApi = Proxy
352+
353+putSpec :: Spec
354+putSpec = do
355+ describe "Servant.API.Put and .ReqBody" $ do
356+ let server = return . age :<|> return . age :<|> return ()
357+ with (return $ serve putApi server) $ do
358+ let put' x = Test.Hspec.Wai.request methodPut x [(hContentType
359+ , "application/json;charset=utf-8")]
360+
361+ it "allows to put a Person" $ do
362+ put' "/" (encode alice) `shouldRespondWith` "42"{
363+ matchStatus = 200
364+ }
365+
366+ it "allows alternative routes if all have request bodies" $ do
367+ put' "/bla" (encode alice) `shouldRespondWith` "42"{
368+ matchStatus = 200
369+ }
370+
371+ it "handles trailing '/' gracefully" $ do
372+ put' "/bla/" (encode alice) `shouldRespondWith` "42"{
373+ matchStatus = 200
374+ }
375+
376+ it "correctly rejects invalid request bodies with status 400" $ do
377+ put' "/" "some invalid body" `shouldRespondWith` 400
378+
379+ it "returns 204 if the type is '()'" $ do
380+ put' "empty" "" `shouldRespondWith` ""{ matchStatus = 204 }
381+
382+ it "responds with 415 if the requested media type is unsupported" $ do
383+ let put'' x = Test.Hspec.Wai.request methodPut x [(hContentType
384+ , "application/nonsense")]
385+ put'' "/" "anything at all" `shouldRespondWith` 415
386+
387+type PatchApi =
388+ ReqBody '[JSON] Person :> Patch '[JSON] Integer
389+ :<|> "bla" :> ReqBody '[JSON] Person :> Patch '[JSON] Integer
390+ :<|> "empty" :> Patch '[] ()
391+
392+patchApi :: Proxy PatchApi
393+patchApi = Proxy
394+
395+patchSpec :: Spec
396+patchSpec = do
397+ describe "Servant.API.Patch and .ReqBody" $ do
398+ let server = return . age :<|> return . age :<|> return ()
399+ with (return $ serve patchApi server) $ do
400+ let patch' x = Test.Hspec.Wai.request methodPatch x [(hContentType
401+ , "application/json;charset=utf-8")]
402+
403+ it "allows to patch a Person" $ do
404+ patch' "/" (encode alice) `shouldRespondWith` "42"{
405+ matchStatus = 200
406+ }
407+
408+ it "allows alternative routes if all have request bodies" $ do
409+ patch' "/bla" (encode alice) `shouldRespondWith` "42"{
410+ matchStatus = 200
411+ }
412+
413+ it "handles trailing '/' gracefully" $ do
414+ patch' "/bla/" (encode alice) `shouldRespondWith` "42"{
415+ matchStatus = 200
416+ }
417+
418+ it "correctly rejects invalid request bodies with status 400" $ do
419+ patch' "/" "some invalid body" `shouldRespondWith` 400
420+
421+ it "returns 204 if the type is '()'" $ do
422+ patch' "empty" "" `shouldRespondWith` ""{ matchStatus = 204 }
423+
424+ it "responds with 415 if the requested media type is unsupported" $ do
425+ let patch'' x = Test.Hspec.Wai.request methodPatch x [(hContentType
426+ , "application/nonsense")]
427+ patch'' "/" "anything at all" `shouldRespondWith` 415
428+
327429type HeaderApi a = Header "MyHeader" a :> Delete
328430headerApi :: Proxy (HeaderApi a)
329431headerApi = Proxy