git.iko.soy/typeable/servant
on master help sign in
servant-mock: support for response headers
commit14aac5fc9f9623ca466fb706e15b8d03579581a4 authorSönke Hahn <soenkehahn@gmail.com> dateMon 18 Jan 2016, 13:22 (11 years ago) parent3fdaffa
4 files changed+55−6
compare with master
unifiedsplit
servant-mock/servant-mock.cabal+3−1 servant-mock/src/Servant/Mock.hs+9−2 servant-mock/test/Servant/MockSpec.hs+42−2 servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+1−1
servant-mock/servant-mock.cabal+3−1
@@ -63,4 +63,6 @@ test-suite spec
6363 servant,
6464 servant-server,
6565 servant-mock,
66− aeson
66+ aeson,
67+ bytestring-conversion,
68+ wai
servant-mock/src/Servant/Mock.hs+9−2
@@ -7,6 +7,9 @@
77{-# LANGUAGE TypeFamilies #-}
88{-# LANGUAGE TypeOperators #-}
99{-# OPTIONS_GHC -fno-warn-orphans #-}
10+
11+#include "overlapping-compat.h"
12+
1013-- |
1114-- Module : Servant.Mock
1215-- Copyright : 2015 Alp Mestanogullari
@@ -144,6 +147,12 @@ instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes
144147 => HasMock (Verb method status ctypes a) where
145148 mock _ = mockArbitrary
146149
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+
147156instance HasMock Raw where
148157 mock _ = \_req respond -> do
149158 bdy <- genBody
@@ -165,5 +174,3 @@ instance Arbitrary (HList '[]) where
165174instance (Arbitrary a, Arbitrary (HList hs))
166175 => Arbitrary (HList (Header h a ': hs)) where
167176 arbitrary = HCons <$> fmap Header arbitrary <*> arbitrary
168−
169−
servant-mock/test/Servant/MockSpec.hs+42−2
@@ -1,5 +1,4 @@
11{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveAnyClass #-}
32{-# LANGUAGE DeriveGeneric #-}
43{-# LANGUAGE OverloadedStrings #-}
54{-# LANGUAGE TypeOperators #-}
@@ -7,8 +6,11 @@
76module Servant.MockSpec where
87
98import Data.Aeson as Aeson
9+import Data.ByteString.Conversion.To
1010import Data.Proxy
11+import Data.String
1112import GHC.Generics
13+import Network.Wai
1214import Servant.API
1315import Test.Hspec hiding (pending)
1416import Test.Hspec.Wai
@@ -23,11 +25,24 @@ _ = mock comprehensiveAPI
2325data Body
2426 = Body
2527 | ArbitraryBody
26− deriving (Generic, ToJSON)
28+ deriving (Generic)
29+
30+instance ToJSON Body
2731
2832instance Arbitrary Body where
2933 arbitrary = return ArbitraryBody
3034
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+
3146spec :: Spec
3247spec = do
3348 describe "mock" $ do
@@ -40,3 +55,28 @@ spec = do
4055 get "/" `shouldRespondWith` 200{
4156 matchBody = Just $ Aeson.encode ArbitraryBody
4257 }
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 =
2222-- Raw :<|>
2323 RemoteHost :> GET :<|>
2424 ReqBody '[JSON] Int :> GET :<|>
25−-- Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
25+ Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
2626 "foo" :> GET :<|>
2727 Vault :> GET :<|>
2828 Verb 'POST 204 '[JSON] () :<|>