mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-08-16 22:00:32 +03:00
Add ResponseEquality
This commit is contained in:
parent
c1b92215c3
commit
c187be434d
@ -24,6 +24,7 @@ library
|
||||
, Servant.QuickCheck.Internal.Predicates
|
||||
, Servant.QuickCheck.Internal.HasGenRequest
|
||||
, Servant.QuickCheck.Internal.QuickCheck
|
||||
, Servant.QuickCheck.Internal.Equality
|
||||
build-depends: base >=4.8 && <4.9
|
||||
, QuickCheck == 2.8.*
|
||||
, bytestring == 0.10.*
|
||||
|
@ -3,4 +3,5 @@ module Servant.QuickCheck.Internal (module X) where
|
||||
import Servant.QuickCheck.Internal.HasGenRequest as X
|
||||
import Servant.QuickCheck.Internal.Predicates as X
|
||||
import Servant.QuickCheck.Internal.QuickCheck as X
|
||||
import Servant.QuickCheck.Internal.Equality as X
|
||||
import Servant.QuickCheck.Internal.Benchmarking as X
|
||||
|
22
src/Servant/QuickCheck/Internal/Equality.hs
Normal file
22
src/Servant/QuickCheck/Internal/Equality.hs
Normal file
@ -0,0 +1,22 @@
|
||||
module Servant.QuickCheck.Internal.Equality where
|
||||
|
||||
import Network.HTTP.Client
|
||||
import Data.Function (on)
|
||||
|
||||
-- | Often the normal equality of responses is not what we want. For example,
|
||||
-- if responses contain a @Date@ header with the time of the response,
|
||||
-- responses will fail to be equal even though they morally are. This datatype
|
||||
-- represents other means of checking equality
|
||||
newtype ResponseEquality b
|
||||
= ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
|
||||
|
||||
instance Monoid (ResponseEquality b) where
|
||||
mempty = ResponseEquality $ \_ _ -> True
|
||||
ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
|
||||
a x y && b x y
|
||||
|
||||
allEquality :: Eq b => ResponseEquality b
|
||||
allEquality = ResponseEquality (==)
|
||||
|
||||
bodyEquality :: Eq b => ResponseEquality b
|
||||
bodyEquality = ResponseEquality ((==) `on` responseBody)
|
@ -23,10 +23,12 @@ import Test.QuickCheck (Args (..), Property, forAll, Result (
|
||||
quickCheckWithResult, stdArgs)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Test.QuickCheck.Monadic
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
|
||||
import Servant.QuickCheck.Internal.HasGenRequest
|
||||
import Servant.QuickCheck.Internal.Predicates
|
||||
import Servant.QuickCheck.Internal.Benchmarking
|
||||
import Servant.QuickCheck.Internal.Equality
|
||||
|
||||
|
||||
-- | Start a servant application on an open port, run the provided function,
|
||||
@ -49,13 +51,13 @@ withServantServer api server t
|
||||
-- Evidently, if the behaviour of the server is expected to be
|
||||
-- non-deterministic, this function may produce spurious failures
|
||||
serversEqual :: HasGenRequest a =>
|
||||
Proxy a -> BaseUrl -> BaseUrl -> Args -> Expectation
|
||||
serversEqual api burl1 burl2 args = do
|
||||
Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality BSL.ByteString -> Expectation
|
||||
serversEqual api burl1 burl2 args req = do
|
||||
let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api
|
||||
r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
|
||||
resp1 <- run $ httpLbs req1 defManager
|
||||
resp2 <- run $ httpLbs req2 defManager
|
||||
assert $ resp1 == resp2
|
||||
assert $ getResponseEquality req resp1 resp2
|
||||
case r of
|
||||
Success {} -> return ()
|
||||
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
||||
|
@ -25,7 +25,7 @@ serversEqualSpec = describe "serversEqual" $ do
|
||||
it "considers equal servers equal" $ do
|
||||
withServantServer api server $ \burl1 ->
|
||||
withServantServer api server $ \burl2 -> do
|
||||
serversEqual api burl1 burl2 stdArgs { maxSuccess = 10000 }
|
||||
serversEqual api burl1 burl2 stdArgs { maxSuccess = 10000 } bodyEquality
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user