git.iko.soy/servant-quickcheck
on master help sign in
Create jsonEqaulity function and add some tests for similar JSON values but slightly different whitespace, ordering
commit482656b35e61d55f314e369e036c8e13b7a7223e authorErik Aker <eraker@gmail.com> dateSun 16 Jul 2017, 08:51 (9 years ago) parente7206ec
4 files changed+67
compare with master
unifiedsplit
servant-quickcheck.cabal+1 src/Servant/QuickCheck.hs+1 src/Servant/QuickCheck/Internal/Equality.hs+25 test/Servant/QuickCheck/InternalSpec.hs+40
servant-quickcheck.cabal+1
@@ -84,6 +84,7 @@ test-suite spec
8484 other-modules: Servant.QuickCheck.InternalSpec
8585 build-depends: base == 4.*
8686 , base-compat
87+ , aeson
8788 , servant-quickcheck
8889 , bytestring
8990 , hspec
src/Servant/QuickCheck.hs+1
@@ -49,6 +49,7 @@ module Servant.QuickCheck
4949 -- represents other means of checking equality
5050 -- *** Useful @ResponseEquality@s
5151 , bodyEquality
52+ , jsonEquality
5253 , allEquality
5354 -- ** Response equality type
5455 , ResponseEquality(..)
src/Servant/QuickCheck/Internal/Equality.hs+25
@@ -1,5 +1,8 @@
11module Servant.QuickCheck.Internal.Equality where
22
3+import Data.Aeson (Value, decode, decodeStrict)
4+import Data.ByteString (ByteString)
5+import qualified Data.ByteString.Lazy as LB
36import Data.Function (on)
47import Network.HTTP.Client (Response, responseBody)
58import Prelude.Compat
@@ -23,3 +26,25 @@ allEquality = ResponseEquality (==)
2326-- /Since 0.0.0.0/
2427bodyEquality :: Eq b => ResponseEquality b
2528bodyEquality = ResponseEquality ((==) `on` responseBody)
29+
30+jsonEquality :: (JsonEq b) => ResponseEquality b
31+jsonEquality = ResponseEquality (jsonEq `on` responseBody)
32+
33+class JsonEq a where
34+ decode' :: a -> Maybe Value
35+ jsonEq :: a -> a -> Bool
36+ jsonEq first second = compareDecodedResponses (decode' first) (decode' second)
37+
38+instance JsonEq LB.ByteString where
39+ decode' = decode
40+
41+instance JsonEq ByteString where
42+ decode' = decodeStrict
43+
44+compareDecodedResponses :: Maybe Value -> Maybe Value -> Bool
45+compareDecodedResponses resp1 resp2 =
46+ case resp1 of
47+ Nothing -> False -- if decoding fails we assume failure
48+ (Just r1) -> case resp2 of
49+ Nothing -> False -- another decode failure
50+ (Just r2) -> r1 == r2
test/Servant/QuickCheck/InternalSpec.hs+40
@@ -69,6 +69,28 @@ serversEqualSpec = describe "serversEqual" $ do
6969 show err `shouldContain` "Body: 2"
7070 show err `shouldContain` "Path: /failplz"
7171
72+ context "when JSON is equal but looks a bit different as a ByteString" $ do
73+
74+ it "considers equal JSON apis equal regardless of ordering or whitespace" $ do
75+ withServantServerAndContext jsonApi ctx jsonServer1 $ \burl1 ->
76+ withServantServerAndContext jsonApi ctx jsonServer2 $ \burl2 ->
77+ serversEqual jsonApi burl1 burl2 args jsonEquality
78+
79+ it "sees when JSON apis are not equal regardless of ordering or whitespace" $ do
80+ Right (Failure _ err) <- withServantServer jsonApi jsonServer2 $ \burl1 ->
81+ withServantServer jsonApi jsonServer3 $ \burl2 -> do
82+ safeEvalExample $ serversEqual jsonApi burl1 burl2 args jsonEquality
83+ show err `shouldContain` "Server equality failed"
84+ show err `shouldContain` "Path: /jsonComparison"
85+
86+ it "sees when JSON apis are not equal due to different keys but same values" $ do
87+ Right (Failure _ err) <- withServantServer jsonApi jsonServer2 $ \burl1 ->
88+ withServantServer jsonApi jsonServer4 $ \burl2 -> do
89+ safeEvalExample $ serversEqual jsonApi burl1 burl2 args jsonEquality
90+ show err `shouldContain` "Server equality failed"
91+ show err `shouldContain` "Path: /jsonComparison"
92+
93+
7294serverSatisfiesSpec :: Spec
7395serverSatisfiesSpec = describe "serverSatisfies" $ do
7496
@@ -262,6 +284,24 @@ octetAPI = Proxy
262284serverOctetAPI :: IO (Server OctetAPI)
263285serverOctetAPI = return $ return "blah"
264286
287+type JsonApi = "jsonComparison" :> Get '[OctetStream] BS.ByteString
288+
289+jsonApi :: Proxy JsonApi
290+jsonApi = Proxy
291+
292+jsonServer1 :: IO (Server JsonApi)
293+jsonServer1 = return $ return "{ \"b\": [\"b\"], \"a\": 1 }" -- whitespace, ordering different
294+
295+jsonServer2 :: IO (Server JsonApi)
296+jsonServer2 = return $ return "{\"a\": 1,\"b\":[\"b\"]}"
297+
298+jsonServer3 :: IO (Server JsonApi)
299+jsonServer3 = return $ return "{\"a\": 2, \"b\": [\"b\"]}"
300+
301+jsonServer4 :: IO (Server JsonApi)
302+jsonServer4 = return $ return "{\"c\": 1, \"d\": [\"b\"]}"
303+
304+
265305ctx :: Context '[BasicAuthCheck ()]
266306ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
267307------------------------------------------------------------------------------