mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-09-11 18:37:09 +03:00
Merge pull request #24 from declension/23-fix-queryparams
Fix multiple QueryParams / QueryFlags
This commit is contained in:
commit
be5909d30f
@ -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)
|
||||
|
@ -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 ""
|
||||
|
Loading…
Reference in New Issue
Block a user