From a5224276d5d2050e9fca942543dc7325d9488a75 Mon Sep 17 00:00:00 2001 From: Nick B Date: Mon, 6 Mar 2017 13:32:55 +0000 Subject: [PATCH 1/5] Fix multiple QueryParams * Add test API taking multiple `QueryParam`s * Add basic test using this API, generating an endpoint to ensure correct HTTP `one=foo&two=bar` query string generation is happening (that fails on `master`) * Fix (re)creation of query string to append `&` before the new parameter if there is already a built query string. Fixes #23. --- .../QuickCheck/Internal/HasGenRequest.hs | 6 +++--- test/Servant/QuickCheck/InternalSpec.hs | 21 +++++++++++++++++++ 2 files changed, 24 insertions(+), 3 deletions(-) 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 "" From 6be669716544e279fc248c0bc5e4d1d4fb6a1563 Mon Sep 17 00:00:00 2001 From: Nick B Date: Tue, 7 Mar 2017 21:25:11 +0000 Subject: [PATCH 2/5] QueryParams: fix ampersand, improve test * Simplify test API to use `()` - no awkward values at all. * The test asserts on _entire_ of resulting path now... * ...and fix the ampersand placement, but preserving the order of params left to right. The code also reads a bit better this way... --- src/Servant/QuickCheck/Internal/HasGenRequest.hs | 3 ++- test/Servant/QuickCheck/InternalSpec.hs | 7 +++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs index 68939d9..f1247fa 100644 --- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs +++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs @@ -92,8 +92,9 @@ instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b) new' <- new old' <- old return $ \burl -> let r = old' burl + newExpr = param <> "=" <> cs (toQueryParam new') qs = queryString r in r { - queryString = (if BS.null qs then "" else "&") <> qs <> param <> "=" <> cs (toQueryParam new') } + queryString = if BS.null qs then newExpr else newExpr <> "&" <> 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 993ddb6..d52acc8 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -4,7 +4,7 @@ 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 qualified Data.ByteString.Char8 as C import Prelude.Compat import Servant import Test.Hspec (Spec, context, describe, it, shouldBe, @@ -121,8 +121,7 @@ queryParamsSpec = describe "QueryParams" $ do gen = genRequest paramsAPI req = (unGen gen rng 0) burl qs = C.unpack $ queryString req - qs `shouldContain` ("one=") - qs `shouldContain` ("&two=") + qs `shouldBe` "one=&two=" ------------------------------------------------------------------------------ -- APIs @@ -135,7 +134,7 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String api :: Proxy API api = Proxy -type ParamsAPI = QueryParam "one" String :> QueryParam "two" String :> Get '[JSON] String +type ParamsAPI = QueryParam "one" String :> QueryParam "two" String :> Get '[JSON] () paramsAPI :: Proxy ParamsAPI paramsAPI = Proxy From a8459223edac80ea5fddbc38f887a8f6af69e523 Mon Sep 17 00:00:00 2001 From: Nick B Date: Tue, 7 Mar 2017 22:48:45 +0000 Subject: [PATCH 3/5] Use () for test QueryParam type too ...as suggested (thanks @jkarni) --- test/Servant/QuickCheck/InternalSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Servant/QuickCheck/InternalSpec.hs b/test/Servant/QuickCheck/InternalSpec.hs index d52acc8..3d38a87 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -121,7 +121,7 @@ queryParamsSpec = describe "QueryParams" $ do gen = genRequest paramsAPI req = (unGen gen rng 0) burl qs = C.unpack $ queryString req - qs `shouldBe` "one=&two=" + qs `shouldBe` "one=_&two=_" ------------------------------------------------------------------------------ -- APIs @@ -134,7 +134,7 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String api :: Proxy API api = Proxy -type ParamsAPI = QueryParam "one" String :> QueryParam "two" String :> Get '[JSON] () +type ParamsAPI = QueryParam "one" () :> QueryParam "two" () :> Get '[JSON] () paramsAPI :: Proxy ParamsAPI paramsAPI = Proxy From 77fa490b93f3dac2807662f70a95ffd734951227 Mon Sep 17 00:00:00 2001 From: Nick B Date: Tue, 7 Mar 2017 22:52:38 +0000 Subject: [PATCH 4/5] Fix QueryFlags too (#23) * Same logic / testing as for `QueryParam` * There's probably some de-duplication that could be done here one day... --- .../QuickCheck/Internal/HasGenRequest.hs | 6 ++++-- test/Servant/QuickCheck/InternalSpec.hs | 18 ++++++++++++++++++ 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs index f1247fa..378f743 100644 --- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs +++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs @@ -119,8 +119,10 @@ 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 + newExpr = param <> "=" + 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) diff --git a/test/Servant/QuickCheck/InternalSpec.hs b/test/Servant/QuickCheck/InternalSpec.hs index 3d38a87..98a3843 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -33,6 +33,7 @@ spec = do onlyJsonObjectSpec notLongerThanSpec queryParamsSpec + queryFlagsSpec serversEqualSpec :: Spec serversEqualSpec = describe "serversEqual" $ do @@ -123,6 +124,17 @@ queryParamsSpec = describe "QueryParams" $ do 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 ------------------------------------------------------------------------------ @@ -139,6 +151,12 @@ 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 "" From 2109326ad7ec3dc7743b8db9c43d2af6c2122254 Mon Sep 17 00:00:00 2001 From: Nick B Date: Fri, 10 Mar 2017 08:31:56 +0000 Subject: [PATCH 5/5] QueryFlags don't use = * Also, fix import for old `Servant` versions - _every_ version now needs `Data.Bytestring` (i.e. Servant version < 0.8, as per old lts in `stack.yaml`) --- src/Servant/QuickCheck/Internal/HasGenRequest.hs | 6 ++---- test/Servant/QuickCheck/InternalSpec.hs | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs index 378f743..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 @@ -120,9 +119,8 @@ instance (KnownSymbol x, HasGenRequest b) genRequest _ = do old' <- old return $ \burl -> let r = old' burl - newExpr = param <> "=" qs = queryString r in r { - queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs } + 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 98a3843..0e6c053 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -133,7 +133,7 @@ queryFlagsSpec = describe "QueryFlags" $ do gen = genRequest flagsAPI req = (unGen gen rng 0) burl qs = C.unpack $ queryString req - qs `shouldBe` "one=&two=" + qs `shouldBe` "one&two" ------------------------------------------------------------------------------ -- APIs