git.iko.soy/servant-quickcheck
on master help sign in
Merge pull request #24 from declension/23-fix-queryparams
be5909dJulian Arni
src/Servant/QuickCheck/Internal/HasGenRequest.hs+8−7
compare with master
unifiedsplit
@@ -15,9 +15,8 @@ import Servant
15import Servant.API.ContentTypes (AllMimeRender (..))
15import Servant.API.ContentTypes (AllMimeRender (..))
16import Servant.Client (BaseUrl (..), Scheme (..))
16import Servant.Client (BaseUrl (..), Scheme (..))
17import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)
17import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)
18−#if MIN_VERSION_servant(0,8,0)
18+
19import qualified Data.ByteString as BS
19import qualified Data.ByteString as BS
20−#endif
21
20
22
21
23class HasGenRequest a where
22class HasGenRequest a where
@@ -91,9 +90,10 @@ instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
91 genRequest _ = do
90 genRequest _ = do
92 new' <- new
91 new' <- new
93 old' <- old
92 old' <- old
94− return $ \burl -> let r = old' burl in r {
93+ return $ \burl -> let r = old' burl
95− queryString = queryString r
96− <> param <> "=" <> cs (toQueryParam new') }
94+ newExpr = param <> "=" <> cs (toQueryParam new')
95+ qs = queryString r in r {
96+ queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs }
97 where
97 where
98 old = genRequest (Proxy :: Proxy b)
98 old = genRequest (Proxy :: Proxy b)
99 param = cs $ symbolVal (Proxy :: Proxy x)
99 param = cs $ symbolVal (Proxy :: Proxy x)
@@ -118,8 +118,9 @@ instance (KnownSymbol x, HasGenRequest b)
118 => HasGenRequest (QueryFlag x :> b) where
118 => HasGenRequest (QueryFlag x :> b) where
119 genRequest _ = do
119 genRequest _ = do
120 old' <- old
120 old' <- old
121− return $ \burl -> let r = old' burl in r {
121+ return $ \burl -> let r = old' burl
122+ qs = queryString r in r {
122− queryString = queryString r <> param <> "=" }
123+ queryString = if BS.null qs then param else param <> "&" <> qs }
123 where
124 where
124 old = genRequest (Proxy :: Proxy b)
125 old = genRequest (Proxy :: Proxy b)
125 param = cs $ symbolVal (Proxy :: Proxy x)
126 param = cs $ symbolVal (Proxy :: Proxy x)
test/Servant/QuickCheck/InternalSpec.hs+38
@@ -4,12 +4,16 @@ module Servant.QuickCheck.InternalSpec (spec) where
4import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
4import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
5import Control.Monad.IO.Class (liftIO)
5import Control.Monad.IO.Class (liftIO)
6import qualified Data.ByteString as BS
6import qualified Data.ByteString as BS
7+import qualified Data.ByteString.Char8 as C
7import Prelude.Compat
8import Prelude.Compat
8import Servant
9import Servant
9import Test.Hspec (Spec, context, describe, it, shouldBe,
10import Test.Hspec (Spec, context, describe, it, shouldBe,
10 shouldContain)
11 shouldContain)
11import Test.Hspec.Core.Spec (Arg, Example, Result (..),
12import Test.Hspec.Core.Spec (Arg, Example, Result (..),
12 defaultParams, evaluateExample)
13 defaultParams, evaluateExample)
14+import Test.QuickCheck.Gen (unGen)
15+import Test.QuickCheck.Random (mkQCGen)
16+import Network.HTTP.Client (queryString)
13
17
14#if MIN_VERSION_servant(0,8,0)
18#if MIN_VERSION_servant(0,8,0)
15import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
19import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
@@ -28,6 +32,8 @@ spec = do
28 isComprehensiveSpec
32 isComprehensiveSpec
29 onlyJsonObjectSpec
33 onlyJsonObjectSpec
30 notLongerThanSpec
34 notLongerThanSpec
35+ queryParamsSpec
36+ queryFlagsSpec
31
37
32serversEqualSpec :: Spec
38serversEqualSpec :: Spec
33serversEqualSpec = describe "serversEqual" $ do
39serversEqualSpec = describe "serversEqual" $ do
@@ -107,6 +113,27 @@ isComprehensiveSpec = describe "HasGenRequest" $ do
107 let _g = genRequest comprehensiveAPIWithoutRaw
113 let _g = genRequest comprehensiveAPIWithoutRaw
108 True `shouldBe` True -- This is a type-level check
114 True `shouldBe` True -- This is a type-level check
109
115
116+queryParamsSpec :: Spec
117+queryParamsSpec = describe "QueryParams" $ do
118+
119+ it "reduce to an HTTP query string correctly" $ do
120+ let rng = mkQCGen 0
121+ burl = BaseUrl Http "localhost" 80 ""
122+ gen = genRequest paramsAPI
123+ req = (unGen gen rng 0) burl
124+ qs = C.unpack $ queryString req
125+ qs `shouldBe` "one=_&two=_"
126+
127+queryFlagsSpec :: Spec
128+queryFlagsSpec = describe "QueryFlags" $ do
129+
130+ it "reduce to an HTTP query string correctly" $ do
131+ let rng = mkQCGen 0
132+ burl = BaseUrl Http "localhost" 80 ""
133+ gen = genRequest flagsAPI
134+ req = (unGen gen rng 0) burl
135+ qs = C.unpack $ queryString req
136+ qs `shouldBe` "one&two"
110
137
111------------------------------------------------------------------------------
138------------------------------------------------------------------------------
112-- APIs
139-- APIs
@@ -119,6 +146,17 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String
119api :: Proxy API
146api :: Proxy API
120api = Proxy
147api = Proxy
121
148
149+type ParamsAPI = QueryParam "one" () :> QueryParam "two" () :> Get '[JSON] ()
150+
151+paramsAPI :: Proxy ParamsAPI
152+paramsAPI = Proxy
153+
154+type FlagsAPI = QueryFlag "one" :> QueryFlag "two" :> Get '[JSON] ()
155+
156+flagsAPI :: Proxy FlagsAPI
157+flagsAPI = Proxy
158+
159+
122server :: IO (Server API)
160server :: IO (Server API)
123server = do
161server = do
124 mvar <- newMVar ""
162 mvar <- newMVar ""