diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs index d71ac93..68939d9 100644 --- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs +++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs @@ -91,9 +91,9 @@ 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 + qs = queryString r in r { + queryString = (if BS.null qs then "" else "&") <> qs <> param <> "=" <> cs (toQueryParam new') } 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..993ddb6 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,7 @@ spec = do isComprehensiveSpec onlyJsonObjectSpec notLongerThanSpec + queryParamsSpec serversEqualSpec :: Spec serversEqualSpec = describe "serversEqual" $ do @@ -107,6 +112,17 @@ 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 `shouldContain` ("one=") + qs `shouldContain` ("&two=") ------------------------------------------------------------------------------ -- APIs @@ -119,6 +135,11 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String api :: Proxy API api = Proxy +type ParamsAPI = QueryParam "one" String :> QueryParam "two" String :> Get '[JSON] String + +paramsAPI :: Proxy ParamsAPI +paramsAPI = Proxy + server :: IO (Server API) server = do mvar <- newMVar ""