diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs index d71ac93..010842f 100644 --- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs +++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs @@ -15,9 +15,8 @@ import Servant import Servant.API.ContentTypes (AllMimeRender (..)) import Servant.Client (BaseUrl (..), Scheme (..)) import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof) -#if MIN_VERSION_servant(0,8,0) + import qualified Data.ByteString as BS -#endif class HasGenRequest a where @@ -91,9 +90,10 @@ instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b) genRequest _ = do new' <- new old' <- old - return $ \burl -> let r = old' burl in r { - queryString = queryString r - <> param <> "=" <> cs (toQueryParam new') } + return $ \burl -> let r = old' burl + newExpr = param <> "=" <> cs (toQueryParam new') + qs = queryString r in r { + queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs } where old = genRequest (Proxy :: Proxy b) param = cs $ symbolVal (Proxy :: Proxy x) @@ -118,8 +118,9 @@ instance (KnownSymbol x, HasGenRequest b) => HasGenRequest (QueryFlag x :> b) where genRequest _ = do old' <- old - return $ \burl -> let r = old' burl in r { - queryString = queryString r <> param <> "=" } + return $ \burl -> let r = old' burl + qs = queryString r in r { + queryString = if BS.null qs then param else param <> "&" <> qs } where old = genRequest (Proxy :: Proxy b) param = cs $ symbolVal (Proxy :: Proxy x) diff --git a/test/Servant/QuickCheck/InternalSpec.hs b/test/Servant/QuickCheck/InternalSpec.hs index 54c5159..0e6c053 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -4,12 +4,16 @@ module Servant.QuickCheck.InternalSpec (spec) where import Control.Concurrent.MVar (newMVar, readMVar, swapMVar) import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C import Prelude.Compat import Servant import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain) import Test.Hspec.Core.Spec (Arg, Example, Result (..), defaultParams, evaluateExample) +import Test.QuickCheck.Gen (unGen) +import Test.QuickCheck.Random (mkQCGen) +import Network.HTTP.Client (queryString) #if MIN_VERSION_servant(0,8,0) import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw) @@ -28,6 +32,8 @@ spec = do isComprehensiveSpec onlyJsonObjectSpec notLongerThanSpec + queryParamsSpec + queryFlagsSpec serversEqualSpec :: Spec serversEqualSpec = describe "serversEqual" $ do @@ -107,6 +113,27 @@ isComprehensiveSpec = describe "HasGenRequest" $ do let _g = genRequest comprehensiveAPIWithoutRaw True `shouldBe` True -- This is a type-level check +queryParamsSpec :: Spec +queryParamsSpec = describe "QueryParams" $ do + + it "reduce to an HTTP query string correctly" $ do + let rng = mkQCGen 0 + burl = BaseUrl Http "localhost" 80 "" + gen = genRequest paramsAPI + req = (unGen gen rng 0) burl + qs = C.unpack $ queryString req + qs `shouldBe` "one=_&two=_" + +queryFlagsSpec :: Spec +queryFlagsSpec = describe "QueryFlags" $ do + + it "reduce to an HTTP query string correctly" $ do + let rng = mkQCGen 0 + burl = BaseUrl Http "localhost" 80 "" + gen = genRequest flagsAPI + req = (unGen gen rng 0) burl + qs = C.unpack $ queryString req + qs `shouldBe` "one&two" ------------------------------------------------------------------------------ -- APIs @@ -119,6 +146,17 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String api :: Proxy API api = Proxy +type ParamsAPI = QueryParam "one" () :> QueryParam "two" () :> Get '[JSON] () + +paramsAPI :: Proxy ParamsAPI +paramsAPI = Proxy + +type FlagsAPI = QueryFlag "one" :> QueryFlag "two" :> Get '[JSON] () + +flagsAPI :: Proxy FlagsAPI +flagsAPI = Proxy + + server :: IO (Server API) server = do mvar <- newMVar ""