git.iko.soy/servant-quickcheck
on master help sign in
Merge pull request #24 from declension/23-fix-queryparams

Fix multiple QueryParams / QueryFlags

commitbe5909d30fc5e4fdab16382e933790b4dca346ea authorJulian Arni <jkarni@gmail.com> dateFri 10 Mar 2017, 15:31 (10 years ago) parent47391782109326
2 files changed+46−7
compare with master
unifiedsplit
src/Servant/QuickCheck/Internal/HasGenRequest.hs+8−7 test/Servant/QuickCheck/InternalSpec.hs+38
src/Servant/QuickCheck/Internal/HasGenRequest.hs+8−7
@@ -15,9 +15,8 @@ import Servant
1515import Servant.API.ContentTypes (AllMimeRender (..))
1616import Servant.Client (BaseUrl (..), Scheme (..))
1717import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)
18−#if MIN_VERSION_servant(0,8,0)
18+
1919import qualified Data.ByteString as BS
20−#endif
2120
2221
2322class HasGenRequest a where
@@ -91,9 +90,10 @@ instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
9190 genRequest _ = do
9291 new' <- new
9392 old' <- old
94− return $ \burl -> let r = old' burl in r {
95− queryString = queryString r
96− <> param <> "=" <> cs (toQueryParam new') }
93+ return $ \burl -> let r = old' burl
94+ newExpr = param <> "=" <> cs (toQueryParam new')
95+ qs = queryString r in r {
96+ queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs }
9797 where
9898 old = genRequest (Proxy :: Proxy b)
9999 param = cs $ symbolVal (Proxy :: Proxy x)
@@ -118,8 +118,9 @@ instance (KnownSymbol x, HasGenRequest b)
118118 => HasGenRequest (QueryFlag x :> b) where
119119 genRequest _ = do
120120 old' <- old
121− return $ \burl -> let r = old' burl in r {
122− queryString = queryString r <> param <> "=" }
121+ return $ \burl -> let r = old' burl
122+ qs = queryString r in r {
123+ queryString = if BS.null qs then param else param <> "&" <> qs }
123124 where
124125 old = genRequest (Proxy :: Proxy b)
125126 param = cs $ symbolVal (Proxy :: Proxy x)
test/Servant/QuickCheck/InternalSpec.hs+38
@@ -4,12 +4,16 @@ module Servant.QuickCheck.InternalSpec (spec) where
44import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
55import Control.Monad.IO.Class (liftIO)
66import qualified Data.ByteString as BS
7+import qualified Data.ByteString.Char8 as C
78import Prelude.Compat
89import Servant
910import Test.Hspec (Spec, context, describe, it, shouldBe,
1011 shouldContain)
1112import Test.Hspec.Core.Spec (Arg, Example, Result (..),
1213 defaultParams, evaluateExample)
14+import Test.QuickCheck.Gen (unGen)
15+import Test.QuickCheck.Random (mkQCGen)
16+import Network.HTTP.Client (queryString)
1317
1418#if MIN_VERSION_servant(0,8,0)
1519import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
@@ -28,6 +32,8 @@ spec = do
2832 isComprehensiveSpec
2933 onlyJsonObjectSpec
3034 notLongerThanSpec
35+ queryParamsSpec
36+ queryFlagsSpec
3137
3238serversEqualSpec :: Spec
3339serversEqualSpec = describe "serversEqual" $ do
@@ -107,6 +113,27 @@ isComprehensiveSpec = describe "HasGenRequest" $ do
107113 let _g = genRequest comprehensiveAPIWithoutRaw
108114 True `shouldBe` True -- This is a type-level check
109115
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"
110137
111138------------------------------------------------------------------------------
112139-- APIs
@@ -119,6 +146,17 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String
119146api :: Proxy API
120147api = Proxy
121148
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+
122160server :: IO (Server API)
123161server = do
124162 mvar <- newMVar ""