ilyakooo0/servant-quickcheck
1
0
Fork 0
mirror of https://github.com/ilyakooo0/servant-quickcheck.git synced 2024-09-11 18:37:09 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #24 from declension/23-fix-queryparams

Browse Source 
Fix multiple QueryParams / QueryFlags
This commit is contained in:
Julian Arni 2017-03-10 15:31:39 -06:00 committed by GitHub
commit be5909d30f
2 changed files with 46 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Servant/QuickCheck/Internal/HasGenRequest.hs
View File

@ -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)

38
test/Servant/QuickCheck/InternalSpec.hs
View File

@ -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 ""