Skip to content

Commit

Permalink
Fix multiple QueryParams
Browse files Browse the repository at this point in the history
 * 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 haskell-servant#23.
  • Loading branch information
declension committed Mar 6, 2017
1 parent 4739178 commit a522427
Show file tree
Hide file tree
Showing 2 changed files with 24 additions and 3 deletions.
6 changes: 3 additions & 3 deletions src/Servant/QuickCheck/Internal/HasGenRequest.hs
Expand Up @@ -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)
Expand Down
21 changes: 21 additions & 0 deletions test/Servant/QuickCheck/InternalSpec.hs
Expand Up @@ -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)
Expand All @@ -28,6 +32,7 @@ spec = do
isComprehensiveSpec
onlyJsonObjectSpec
notLongerThanSpec
queryParamsSpec

serversEqualSpec :: Spec
serversEqualSpec = describe "serversEqual" $ do
Expand Down Expand Up @@ -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
Expand All @@ -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 ""
Expand Down

0 comments on commit a522427

Please sign in to comment.