c187be4 · servant-quickcheck

servant-quickcheck.cabal+1

compare with master

unifiedsplit

@@ -24,6 +24,7 @@ library

24 , Servant.QuickCheck.Internal.Predicates

25 , Servant.QuickCheck.Internal.HasGenRequest

26 , Servant.QuickCheck.Internal.QuickCheck

27+ , Servant.QuickCheck.Internal.Equality

27 build-depends: base >=4.8 && <4.9

28 build-depends: base >=4.8 && <4.9

28 , QuickCheck == 2.8.*

29 , QuickCheck == 2.8.*

29 , bytestring == 0.10.*

30 , bytestring == 0.10.*

src/Servant/QuickCheck/Internal.hs+1

@@ -3,4 +3,5 @@ module Servant.QuickCheck.Internal (module X) where

3import Servant.QuickCheck.Internal.HasGenRequest as X

4import Servant.QuickCheck.Internal.Predicates as X

5import Servant.QuickCheck.Internal.QuickCheck as X

6+import Servant.QuickCheck.Internal.Equality as X

6import Servant.QuickCheck.Internal.Benchmarking as X

7import Servant.QuickCheck.Internal.Benchmarking as X

src/Servant/QuickCheck/Internal/Equality.hsnew file+22

@@ -0,0 +1,22 @@

1+module Servant.QuickCheck.Internal.Equality where

2+

3+import Network.HTTP.Client

4+import Data.Function (on)

5+

6+-- | Often the normal equality of responses is not what we want. For example,

7+-- if responses contain a @Date@ header with the time of the response,

8+-- responses will fail to be equal even though they morally are. This datatype

9+-- represents other means of checking equality

10+newtype ResponseEquality b

11+ = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }

12+

13+instance Monoid (ResponseEquality b) where

14+ mempty = ResponseEquality $ \_ _ -> True

15+ ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->

16+ a x y && b x y

17+

18+allEquality :: Eq b => ResponseEquality b

19+allEquality = ResponseEquality (==)

20+

21+bodyEquality :: Eq b => ResponseEquality b

22+bodyEquality = ResponseEquality ((==) `on` responseBody)

src/Servant/QuickCheck/Internal/QuickCheck.hs+5−3

@@ -23,10 +23,12 @@ import Test.QuickCheck (Args (..), Property, forAll, Result (

23 quickCheckWithResult, stdArgs)

24import System.IO.Unsafe (unsafePerformIO)

25import Test.QuickCheck.Monadic

26+import qualified Data.ByteString.Lazy as BSL

26

27

27import Servant.QuickCheck.Internal.HasGenRequest

28import Servant.QuickCheck.Internal.HasGenRequest

28import Servant.QuickCheck.Internal.Predicates

29import Servant.QuickCheck.Internal.Predicates

29import Servant.QuickCheck.Internal.Benchmarking

30import Servant.QuickCheck.Internal.Benchmarking

31+import Servant.QuickCheck.Internal.Equality

30

32

31

33

32-- | Start a servant application on an open port, run the provided function,

34-- | Start a servant application on an open port, run the provided function,

@@ -49,13 +51,13 @@ withServantServer api server t

49-- Evidently, if the behaviour of the server is expected to be

51-- Evidently, if the behaviour of the server is expected to be

50-- non-deterministic, this function may produce spurious failures

52-- non-deterministic, this function may produce spurious failures

51serversEqual :: HasGenRequest a =>

53serversEqual :: HasGenRequest a =>

52− Proxy a -> BaseUrl -> BaseUrl -> Args -> Expectation

54+ Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality BSL.ByteString -> Expectation

53−serversEqual api burl1 burl2 args = do

55+serversEqual api burl1 burl2 args req = do

54 let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api

56 let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api

55 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do

57 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do

56 resp1 <- run $ httpLbs req1 defManager

58 resp1 <- run $ httpLbs req1 defManager

57 resp2 <- run $ httpLbs req2 defManager

59 resp2 <- run $ httpLbs req2 defManager

58− assert $ resp1 == resp2

60+ assert $ getResponseEquality req resp1 resp2

59 case r of

61 case r of

60 Success {} -> return ()

62 Success {} -> return ()

61 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"

63 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"

test/Servant/QuickCheck/InternalSpec.hs+1−1

@@ -25,7 +25,7 @@ serversEqualSpec = describe "serversEqual" $ do

25 it "considers equal servers equal" $ do

26 withServantServer api server $ \burl1 ->

27 withServantServer api server $ \burl2 -> do

28− serversEqual api burl1 burl2 stdArgs { maxSuccess = 10000 }

28+ serversEqual api burl1 burl2 stdArgs { maxSuccess = 10000 } bodyEquality

29

30

31