mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-08-17 06:10:27 +03:00
Create jsonEqaulity function and add some tests for similar JSON values but slightly different whitespace, ordering
This commit is contained in:
parent
e7206ec875
commit
482656b35e
@ -84,6 +84,7 @@ test-suite spec
|
||||
other-modules: Servant.QuickCheck.InternalSpec
|
||||
build-depends: base == 4.*
|
||||
, base-compat
|
||||
, aeson
|
||||
, servant-quickcheck
|
||||
, bytestring
|
||||
, hspec
|
||||
|
@ -49,6 +49,7 @@ module Servant.QuickCheck
|
||||
-- represents other means of checking equality
|
||||
-- *** Useful @ResponseEquality@s
|
||||
, bodyEquality
|
||||
, jsonEquality
|
||||
, allEquality
|
||||
-- ** Response equality type
|
||||
, ResponseEquality(..)
|
||||
|
@ -1,5 +1,8 @@
|
||||
module Servant.QuickCheck.Internal.Equality where
|
||||
|
||||
import Data.Aeson (Value, decode, decodeStrict)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Function (on)
|
||||
import Network.HTTP.Client (Response, responseBody)
|
||||
import Prelude.Compat
|
||||
@ -23,3 +26,25 @@ allEquality = ResponseEquality (==)
|
||||
-- /Since 0.0.0.0/
|
||||
bodyEquality :: Eq b => ResponseEquality b
|
||||
bodyEquality = ResponseEquality ((==) `on` responseBody)
|
||||
|
||||
jsonEquality :: (JsonEq b) => ResponseEquality b
|
||||
jsonEquality = ResponseEquality (jsonEq `on` responseBody)
|
||||
|
||||
class JsonEq a where
|
||||
decode' :: a -> Maybe Value
|
||||
jsonEq :: a -> a -> Bool
|
||||
jsonEq first second = compareDecodedResponses (decode' first) (decode' second)
|
||||
|
||||
instance JsonEq LB.ByteString where
|
||||
decode' = decode
|
||||
|
||||
instance JsonEq ByteString where
|
||||
decode' = decodeStrict
|
||||
|
||||
compareDecodedResponses :: Maybe Value -> Maybe Value -> Bool
|
||||
compareDecodedResponses resp1 resp2 =
|
||||
case resp1 of
|
||||
Nothing -> False -- if decoding fails we assume failure
|
||||
(Just r1) -> case resp2 of
|
||||
Nothing -> False -- another decode failure
|
||||
(Just r2) -> r1 == r2
|
||||
|
@ -69,6 +69,28 @@ serversEqualSpec = describe "serversEqual" $ do
|
||||
show err `shouldContain` "Body: 2"
|
||||
show err `shouldContain` "Path: /failplz"
|
||||
|
||||
context "when JSON is equal but looks a bit different as a ByteString" $ do
|
||||
|
||||
it "considers equal JSON apis equal regardless of ordering or whitespace" $ do
|
||||
withServantServerAndContext jsonApi ctx jsonServer1 $ \burl1 ->
|
||||
withServantServerAndContext jsonApi ctx jsonServer2 $ \burl2 ->
|
||||
serversEqual jsonApi burl1 burl2 args jsonEquality
|
||||
|
||||
it "sees when JSON apis are not equal regardless of ordering or whitespace" $ do
|
||||
Right (Failure _ err) <- withServantServer jsonApi jsonServer2 $ \burl1 ->
|
||||
withServantServer jsonApi jsonServer3 $ \burl2 -> do
|
||||
safeEvalExample $ serversEqual jsonApi burl1 burl2 args jsonEquality
|
||||
show err `shouldContain` "Server equality failed"
|
||||
show err `shouldContain` "Path: /jsonComparison"
|
||||
|
||||
it "sees when JSON apis are not equal due to different keys but same values" $ do
|
||||
Right (Failure _ err) <- withServantServer jsonApi jsonServer2 $ \burl1 ->
|
||||
withServantServer jsonApi jsonServer4 $ \burl2 -> do
|
||||
safeEvalExample $ serversEqual jsonApi burl1 burl2 args jsonEquality
|
||||
show err `shouldContain` "Server equality failed"
|
||||
show err `shouldContain` "Path: /jsonComparison"
|
||||
|
||||
|
||||
serverSatisfiesSpec :: Spec
|
||||
serverSatisfiesSpec = describe "serverSatisfies" $ do
|
||||
|
||||
@ -262,6 +284,24 @@ octetAPI = Proxy
|
||||
serverOctetAPI :: IO (Server OctetAPI)
|
||||
serverOctetAPI = return $ return "blah"
|
||||
|
||||
type JsonApi = "jsonComparison" :> Get '[OctetStream] BS.ByteString
|
||||
|
||||
jsonApi :: Proxy JsonApi
|
||||
jsonApi = Proxy
|
||||
|
||||
jsonServer1 :: IO (Server JsonApi)
|
||||
jsonServer1 = return $ return "{ \"b\": [\"b\"], \"a\": 1 }" -- whitespace, ordering different
|
||||
|
||||
jsonServer2 :: IO (Server JsonApi)
|
||||
jsonServer2 = return $ return "{\"a\": 1,\"b\":[\"b\"]}"
|
||||
|
||||
jsonServer3 :: IO (Server JsonApi)
|
||||
jsonServer3 = return $ return "{\"a\": 2, \"b\": [\"b\"]}"
|
||||
|
||||
jsonServer4 :: IO (Server JsonApi)
|
||||
jsonServer4 = return $ return "{\"c\": 1, \"d\": [\"b\"]}"
|
||||
|
||||
|
||||
ctx :: Context '[BasicAuthCheck ()]
|
||||
ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
|
||||
------------------------------------------------------------------------------
|
||||
|
Loading…
Reference in New Issue
Block a user