graphql-engine/server/src-test/Test/Aeson/Utils.hs
David Overton 9921823915 GDC-189 custom aggregations
>

## Description
->

This PR allows DC agents to define custom aggregate functions for their scalar types.

### Related Issues
->

GDC-189

### Solution and Design
>

We added a new property `aggregate_functions` to the scalar types capabilities. This allows the agent author to specify a set of aggregate functions supported by each scalar type, along with the function's result type.

During GraphQL schema generation, the custom aggregate functions are available via a new method `getCustomAggregateOperators` on the `Backend` type class.
Custom functions are merged with the builtin aggregate functions when building GraphQL schemas for table aggregate fields and for `order_by` operators on array relations.

### Steps to test and verify
>

• Codec tests for aggregate function capabilities have been added to the unit tests.
• Some custom aggregate operators have been added to the reference agent and are used in a new test in `api-tests`.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6199
GitOrigin-RevId: e9c0d1617af93847c1493671fdbb794f573bde0c
2022-10-27 00:44:06 +00:00

98 lines
3.0 KiB
Haskell

-- | Some helper functions for testing Aeson instances
module Test.Aeson.Utils
( 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.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
testToFromJSON :: (HasCallStack, Eq a, Show a, FromJSON a, ToJSON a) => a -> Value -> Spec
testToFromJSON a v = do
it "parses from JSON" $
parseEither parseJSON v `shouldBe` Right a
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 :: (HasCallStack, Eq a, Show a, FromJSON a, ToJSON a) => Gen a -> Spec
jsonRoundTrip gen =
it "JSON roundtrips" $
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, 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
]