git.iko.soy/servant
on master help sign in
servant-mock: support for response headers
14aac5fSönke Hahn
servant-mock/servant-mock.cabal+3−1
compare with master
unifiedsplit
@@ -63,4 +63,6 @@ test-suite spec
63 servant,
63 servant,
64 servant-server,
64 servant-server,
65 servant-mock,
65 servant-mock,
66− aeson
66+ aeson,
67+ bytestring-conversion,
68+ wai
servant-mock/src/Servant/Mock.hs+9−2
@@ -7,6 +7,9 @@
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE TypeOperators #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
10+
11+#include "overlapping-compat.h"
12+
10-- |
13-- |
11-- Module : Servant.Mock
14-- Module : Servant.Mock
12-- Copyright : 2015 Alp Mestanogullari
15-- Copyright : 2015 Alp Mestanogullari
@@ -144,6 +147,12 @@ instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes
144 => HasMock (Verb method status ctypes a) where
147 => HasMock (Verb method status ctypes a) where
145 mock _ = mockArbitrary
148 mock _ = mockArbitrary
146
149
150+instance OVERLAPPING_
151+ (GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),
152+ Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
153+ => HasMock (Verb method status ctypes (Headers headerTypes a)) where
154+ mock _ = mockArbitrary
155+
147instance HasMock Raw where
156instance HasMock Raw where
148 mock _ = \_req respond -> do
157 mock _ = \_req respond -> do
149 bdy <- genBody
158 bdy <- genBody
@@ -165,5 +174,3 @@ instance Arbitrary (HList '[]) where
165instance (Arbitrary a, Arbitrary (HList hs))
174instance (Arbitrary a, Arbitrary (HList hs))
166 => Arbitrary (HList (Header h a ': hs)) where
175 => Arbitrary (HList (Header h a ': hs)) where
167 arbitrary = HCons <$> fmap Header arbitrary <*> arbitrary
176 arbitrary = HCons <$> fmap Header arbitrary <*> arbitrary
168−
169−
servant-mock/test/Servant/MockSpec.hs+42−2
@@ -1,5 +1,4 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeOperators #-}
@@ -7,8 +6,11 @@
7module Servant.MockSpec where
6module Servant.MockSpec where
8
7
9import Data.Aeson as Aeson
8import Data.Aeson as Aeson
9+import Data.ByteString.Conversion.To
10import Data.Proxy
10import Data.Proxy
11+import Data.String
11import GHC.Generics
12import GHC.Generics
13+import Network.Wai
12import Servant.API
14import Servant.API
13import Test.Hspec hiding (pending)
15import Test.Hspec hiding (pending)
14import Test.Hspec.Wai
16import Test.Hspec.Wai
@@ -23,11 +25,24 @@ _ = mock comprehensiveAPI
23data Body
25data Body
24 = Body
26 = Body
25 | ArbitraryBody
27 | ArbitraryBody
26− deriving (Generic, ToJSON)
28+ deriving (Generic)
29+
30+instance ToJSON Body
27
31
28instance Arbitrary Body where
32instance Arbitrary Body where
29 arbitrary = return ArbitraryBody
33 arbitrary = return ArbitraryBody
30
34
35+data TestHeader
36+ = TestHeader
37+ | ArbitraryHeader
38+ deriving (Show)
39+
40+instance ToByteString TestHeader where
41+ builder = fromString . show
42+
43+instance Arbitrary TestHeader where
44+ arbitrary = return ArbitraryHeader
45+
31spec :: Spec
46spec :: Spec
32spec = do
47spec = do
33 describe "mock" $ do
48 describe "mock" $ do
@@ -40,3 +55,28 @@ spec = do
40 get "/" `shouldRespondWith` 200{
55 get "/" `shouldRespondWith` 200{
41 matchBody = Just $ Aeson.encode ArbitraryBody
56 matchBody = Just $ Aeson.encode ArbitraryBody
42 }
57 }
58+
59+ context "response headers" $ do
60+ let withHeader :: Proxy (Get '[JSON] (Headers '[Header "foo" TestHeader] Body))
61+ withHeader = Proxy
62+ withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
63+ withoutHeader = Proxy
64+ toApp :: HasMock api => Proxy api -> IO Application
65+ toApp api = return $ serve api (mock api)
66+ with (toApp withHeader) $ do
67+ it "serves arbitrary response bodies" $ do
68+ get "/" `shouldRespondWith` 200{
69+ matchHeaders = return $ MatchHeader $ \ h ->
70+ if h == [("Content-Type", "application/json"), ("foo", "ArbitraryHeader")]
71+ then Nothing
72+ else Just ("headers not correct\n")
73+ }
74+
75+ with (toApp withoutHeader) $ do
76+ it "works for no additional headers" $ do
77+ get "/" `shouldRespondWith` 200{
78+ matchHeaders = return $ MatchHeader $ \ h ->
79+ if h == [("Content-Type", "application/json")]
80+ then Nothing
81+ else Just ("headers not correct\n")
82+ }
servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+1−1
@@ -22,7 +22,7 @@ type ComprehensiveAPI =
22-- Raw :<|>
22-- Raw :<|>
23 RemoteHost :> GET :<|>
23 RemoteHost :> GET :<|>
24 ReqBody '[JSON] Int :> GET :<|>
24 ReqBody '[JSON] Int :> GET :<|>
25−-- Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
25+ Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
26 "foo" :> GET :<|>
26 "foo" :> GET :<|>
27 Vault :> GET :<|>
27 Vault :> GET :<|>
28 Verb 'POST 204 '[JSON] () :<|>
28 Verb 'POST 204 '[JSON] () :<|>