mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-19 05:21:47 +03:00
9a59204525
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7310 GitOrigin-RevId: aaff93e6288ca933770d9ecfa6c5350ebf8177b3
107 lines
3.3 KiB
Haskell
107 lines
3.3 KiB
Haskell
-- | Some helper functions for testing Aeson instances
|
|
module Test.Aeson.Utils
|
|
( testFromJSON,
|
|
testToFromJSON,
|
|
validateToJSONOpenApi,
|
|
testToFromJSONToSchema,
|
|
jsonRoundTrip,
|
|
jsonProperties,
|
|
validateAgainstOpenApiSchema,
|
|
jsonOpenApiProperties,
|
|
genKeyMap,
|
|
genObject,
|
|
genValue,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson
|
|
import Data.Aeson.Key qualified as K
|
|
import Data.Aeson.KeyMap qualified as KM
|
|
import Data.Aeson.Types (parseEither)
|
|
import Data.OpenApi
|
|
import Data.Typeable (Proxy (..), Typeable, typeRep)
|
|
import Data.Vector qualified as Vec
|
|
import Hasura.Prelude
|
|
import Hedgehog
|
|
import Hedgehog.Gen qualified as Gen
|
|
import Hedgehog.Internal.Range
|
|
import Test.Hspec
|
|
import Test.Hspec.Hedgehog
|
|
|
|
showType :: forall a. (Typeable a) => String
|
|
showType = show $ typeRep (Proxy :: Proxy a)
|
|
|
|
testFromJSON :: (HasCallStack, Eq a, Show a, FromJSON a) => a -> Value -> Spec
|
|
testFromJSON a v = do
|
|
it "parses from JSON" $
|
|
parseEither parseJSON v `shouldBe` Right a
|
|
|
|
testToFromJSON :: (HasCallStack, Eq a, Show a, FromJSON a, ToJSON a) => a -> Value -> Spec
|
|
testToFromJSON a v = do
|
|
testFromJSON a v
|
|
it "encodes to JSON" $
|
|
toJSON a `shouldBe` v
|
|
|
|
validateToJSONOpenApi :: (HasCallStack, ToJSON a, ToSchema a) => a -> Spec
|
|
validateToJSONOpenApi a = do
|
|
it "value validates against OpenAPI schema" $
|
|
validatePrettyToJSON a `shouldBe` Nothing
|
|
|
|
testToFromJSONToSchema :: (HasCallStack, Eq a, Show a, FromJSON a, ToJSON a, ToSchema a) => a -> Value -> Spec
|
|
testToFromJSONToSchema a v = do
|
|
testToFromJSON a v
|
|
validateToJSONOpenApi a
|
|
|
|
jsonRoundTrip :: forall a. (HasCallStack, Typeable a, Eq a, Show a, FromJSON a, ToJSON a) => Gen a -> Spec
|
|
jsonRoundTrip gen =
|
|
it ("JSON roundtrips " <> showType @a) $
|
|
hedgehog $ do
|
|
a <- forAll gen
|
|
tripping a toJSON (parseEither parseJSON)
|
|
|
|
jsonEncodingEqualsValue :: (HasCallStack, Show a, ToJSON a) => Gen a -> Spec
|
|
jsonEncodingEqualsValue gen =
|
|
it "JSON encoding equals value" $
|
|
hedgehog $ do
|
|
a <- forAll gen
|
|
let encoded = encode a
|
|
decoded = decode encoded :: Maybe Value
|
|
decoded === Just (toJSON a)
|
|
|
|
jsonProperties :: (HasCallStack, Typeable a, Eq a, Show a, FromJSON a, ToJSON a) => Gen a -> Spec
|
|
jsonProperties gen = do
|
|
jsonRoundTrip gen
|
|
jsonEncodingEqualsValue gen
|
|
|
|
validateAgainstOpenApiSchema :: (HasCallStack, Show a, ToJSON a, ToSchema a) => Gen a -> Spec
|
|
validateAgainstOpenApiSchema gen = do
|
|
it "ToJSON validates against OpenAPI schema" $
|
|
hedgehog $ do
|
|
a <- forAll gen
|
|
validatePrettyToJSON a === Nothing
|
|
|
|
jsonOpenApiProperties :: (HasCallStack, Eq a, Show a, FromJSON a, ToJSON a, ToSchema a) => Gen a -> Spec
|
|
jsonOpenApiProperties gen = do
|
|
jsonProperties gen
|
|
validateAgainstOpenApiSchema gen
|
|
|
|
genKeyMap :: MonadGen m => m value -> m (KM.KeyMap value)
|
|
genKeyMap genKMValue =
|
|
KM.fromList . map (first K.fromText) <$> Gen.list (linear 0 5) ((,) <$> Gen.text (linear 0 5) Gen.unicode <*> genKMValue)
|
|
|
|
genObject :: MonadGen m => m Object
|
|
genObject = genKeyMap genValue
|
|
|
|
genValue :: MonadGen m => m Value
|
|
genValue =
|
|
Gen.recursive
|
|
Gen.choice
|
|
[ Object <$> genObject,
|
|
Array . Vec.fromList <$> Gen.list (linear 0 5) genValue
|
|
]
|
|
[ String <$> Gen.text (linear 0 5) Gen.unicode,
|
|
Number . realToFrac <$> Gen.realFrac_ @_ @Double (linearFrac 0 20),
|
|
Bool <$> Gen.bool,
|
|
pure Null
|
|
]
|