git.iko.soy/servant-quickcheck
on master help sign in
Add ResponseEquality
commitc187be434dcd4b1a5459e354fd221dd1bc631dbe authorJulian K. Arni <jkarni@gmail.com> dateSat 23 Apr 2016, 12:05 (11 years ago) parentc1b9221
5 files changed+30−4
compare with master
unifiedsplit
servant-quickcheck.cabal+1 src/Servant/QuickCheck/Internal.hs+1 src/Servant/QuickCheck/Internal/Equality.hs+22 src/Servant/QuickCheck/Internal/QuickCheck.hs+5−3 test/Servant/QuickCheck/InternalSpec.hs+1−1
servant-quickcheck.cabal+1
@@ -24,6 +24,7 @@ library
2424 , Servant.QuickCheck.Internal.Predicates
2525 , Servant.QuickCheck.Internal.HasGenRequest
2626 , Servant.QuickCheck.Internal.QuickCheck
27+ , Servant.QuickCheck.Internal.Equality
2728 build-depends: base >=4.8 && <4.9
2829 , QuickCheck == 2.8.*
2930 , bytestring == 0.10.*
src/Servant/QuickCheck/Internal.hs+1
@@ -3,4 +3,5 @@ module Servant.QuickCheck.Internal (module X) where
33import Servant.QuickCheck.Internal.HasGenRequest as X
44import Servant.QuickCheck.Internal.Predicates as X
55import Servant.QuickCheck.Internal.QuickCheck as X
6+import Servant.QuickCheck.Internal.Equality as X
67import 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 (
2323 quickCheckWithResult, stdArgs)
2424import System.IO.Unsafe (unsafePerformIO)
2525import Test.QuickCheck.Monadic
26+import qualified Data.ByteString.Lazy as BSL
2627
2728import Servant.QuickCheck.Internal.HasGenRequest
2829import Servant.QuickCheck.Internal.Predicates
2930import Servant.QuickCheck.Internal.Benchmarking
31+import Servant.QuickCheck.Internal.Equality
3032
3133
3234-- | Start a servant application on an open port, run the provided function,
@@ -49,13 +51,13 @@ withServantServer api server t
4951-- Evidently, if the behaviour of the server is expected to be
5052-- non-deterministic, this function may produce spurious failures
5153serversEqual :: HasGenRequest a =>
52− Proxy a -> BaseUrl -> BaseUrl -> Args -> Expectation
53−serversEqual api burl1 burl2 args = do
54+ Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality BSL.ByteString -> Expectation
55+serversEqual api burl1 burl2 args req = do
5456 let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api
5557 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
5658 resp1 <- run $ httpLbs req1 defManager
5759 resp2 <- run $ httpLbs req2 defManager
58− assert $ resp1 == resp2
60+ assert $ getResponseEquality req resp1 resp2
5961 case r of
6062 Success {} -> return ()
6163 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
2525 it "considers equal servers equal" $ do
2626 withServantServer api server $ \burl1 ->
2727 withServantServer api server $ \burl2 -> do
28− serversEqual api burl1 burl2 stdArgs { maxSuccess = 10000 }
28+ serversEqual api burl1 burl2 stdArgs { maxSuccess = 10000 } bodyEquality
2929
3030
3131