server: Add an ExperimentalFeatureFlag for Aggregation Predicates

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6523
GitOrigin-RevId: 76861a1bf0d9895901564935b0778e7bda75c6a9

server/src-lib/Hasura/GraphQL/Schema.hs

@@ -173,6 +173,31 @@ buildGQLContext ServerConfigCtx {..} sources allRemoteSchemas allActions customT
       )
     )
 
+buildSchemaOptions ::
+  (SQLGenCtx, Options.InferFunctionPermissions) ->
+  HashSet ExperimentalFeature ->
+  SchemaOptions
+buildSchemaOptions
+  ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput,
+    functionPermsCtx
+    )
+  expFeatures =
+    SchemaOptions
+      { soStringifyNumbers = stringifyNum,
+        soDangerousBooleanCollapse = dangerousBooleanCollapse,
+        soInferFunctionPermissions = functionPermsCtx,
+        soOptimizePermissionFilters = optimizePermissionFilters,
+        soIncludeUpdateManyFields =
+          if EFHideUpdateManyFields `Set.member` expFeatures
+            then Options.DontIncludeUpdateManyFields
+            else Options.IncludeUpdateManyFields,
+        soIncludeAggregationPredicates =
+          if EFHideAggregationPredicates `Set.member` expFeatures
+            then Options.Don'tIncludeAggregationPredicates
+            else Options.IncludeAggregationPredicates,
+        soBigQueryStringNumericInput = bigqueryStringNumericInput
+      }
+
 -- | Build the @QueryHasura@ context for a given role.
 buildRoleContext ::
   forall m.
@@ -191,21 +216,7 @@ buildRoleContext ::
       G.SchemaIntrospection
     )
 buildRoleContext options sources remotes actions customTypes role remoteSchemaPermsCtx expFeatures = do
-  let ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput,
-        functionPermsCtx
-        ) = options
-      schemaOptions =
-        SchemaOptions
-          { soStringifyNumbers = stringifyNum,
-            soDangerousBooleanCollapse = dangerousBooleanCollapse,
-            soInferFunctionPermissions = functionPermsCtx,
-            soOptimizePermissionFilters = optimizePermissionFilters,
-            soIncludeUpdateManyFields =
-              if EFHideUpdateManyFields `Set.member` expFeatures
-                then Options.DontIncludeUpdateManyFields
-                else Options.IncludeUpdateManyFields,
-            soBigQueryStringNumericInput = bigqueryStringNumericInput
-          }
+  let schemaOptions = buildSchemaOptions options expFeatures
       schemaContext =
         SchemaContext
           HasuraSchema
@@ -356,21 +367,7 @@ buildRelayRoleContext ::
   Set.HashSet ExperimentalFeature ->
   m (RoleContext GQLContext)
 buildRelayRoleContext options sources actions customTypes role expFeatures = do
-  let ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput,
-        functionPermsCtx
-        ) = options
-      schemaOptions =
-        SchemaOptions
-          { soStringifyNumbers = stringifyNum,
-            soDangerousBooleanCollapse = dangerousBooleanCollapse,
-            soInferFunctionPermissions = functionPermsCtx,
-            soOptimizePermissionFilters = optimizePermissionFilters,
-            soIncludeUpdateManyFields =
-              if EFHideUpdateManyFields `Set.member` expFeatures
-                then Options.DontIncludeUpdateManyFields
-                else Options.IncludeUpdateManyFields,
-            soBigQueryStringNumericInput = bigqueryStringNumericInput
-          }
+  let schemaOptions = buildSchemaOptions options expFeatures
       -- TODO: At the time of writing this, remote schema queries are not supported in relay.
       -- When they are supported, we should get do what `buildRoleContext` does. Since, they
       -- are not supported yet, we use `mempty` below for `RemoteSchemaMap`.

server/src-lib/Hasura/GraphQL/Schema/BoolExp/AggregationPredicates.hs

@@ -18,6 +18,8 @@ import Hasura.GraphQL.Parser qualified as P
 import Hasura.GraphQL.Schema.Backend
 import Hasura.GraphQL.Schema.BoolExp
 import Hasura.GraphQL.Schema.Common
+import Hasura.GraphQL.Schema.Options (IncludeAggregationPredicates (..))
+import Hasura.GraphQL.Schema.Options qualified as Options
 import Hasura.GraphQL.Schema.Parser
   ( InputFieldsParser,
     Kind (..),
@@ -52,6 +54,12 @@ defaultAggregationPredicatesParser ::
   TableInfo b ->
   SchemaT r m (Maybe (InputFieldsParser n [AggregationPredicatesImplementation b (UnpreparedValue b)]))
 defaultAggregationPredicatesParser aggFns si ti = runMaybeT do
+  -- Check in schema options whether we should include aggregation predicates
+  include <- retrieve Options.soIncludeAggregationPredicates
+  case include of
+    IncludeAggregationPredicates -> return ()
+    Don'tIncludeAggregationPredicates -> fails $ return Nothing
+
   arrayRelationships <- fails $ return $ nonEmpty $ tableArrayRelationships ti
   aggregationFunctions <- fails $ return $ nonEmpty aggFns
   roleName <- retrieve scRole

server/src-lib/Hasura/GraphQL/Schema/Options.hs

@@ -7,6 +7,7 @@ module Hasura.GraphQL.Schema.Options
     InferFunctionPermissions (..),
     RemoteSchemaPermissions (..),
     OptimizePermissionFilters (..),
+    IncludeAggregationPredicates (..),
     IncludeUpdateManyFields (..),
     BigQueryStringNumericInput (..),
   )
@@ -23,6 +24,7 @@ data SchemaOptions = SchemaOptions
     soInferFunctionPermissions :: InferFunctionPermissions,
     soOptimizePermissionFilters :: OptimizePermissionFilters,
     soIncludeUpdateManyFields :: IncludeUpdateManyFields,
+    soIncludeAggregationPredicates :: IncludeAggregationPredicates,
     soBigQueryStringNumericInput :: BigQueryStringNumericInput
   }
 
@@ -43,6 +45,14 @@ data IncludeUpdateManyFields
   | DontIncludeUpdateManyFields
   deriving (Eq, Show)
 
+-- | Should we include aggregation functions in where clauses?
+-- Because this has the potential to cause naming conflicts in graphql schema
+-- types, this flag allows users to toggle the feature off if it an upgrade breaks
+-- their setup.
+data IncludeAggregationPredicates
+  = IncludeAggregationPredicates
+  | Don'tIncludeAggregationPredicates
+
 -- | Should Boolean fields be collapsed to 'True' when a null value is
 -- given? This was the behaviour of Hasura V1, and is now discouraged.
 data DangerouslyCollapseBooleans

server/src-lib/Hasura/Server/Init/Env.hs

@@ -256,17 +256,14 @@ instance FromEnv (HashSet Server.Types.ExperimentalFeature) where
   fromEnv = fmap HashSet.fromList . traverse readAPI . Text.splitOn "," . Text.pack
     where
       readAPI si = case Text.toLower $ Text.strip si of
-        "inherited_roles" -> Right Server.Types.EFInheritedRoles
-        "streaming_subscriptions" -> Right Server.Types.EFStreamingSubscriptions
-        "optimize_permission_filters" -> Right Server.Types.EFOptimizePermissionFilters
-        "naming_convention" -> Right Server.Types.EFNamingConventions
-        "apollo_federation" -> Right Server.Types.EFApolloFederation
-        "hide_update_many_fields" -> Right Server.Types.EFHideUpdateManyFields
-        "bigquery_string_numeric_input" -> Right Server.Types.EFBigQueryStringNumericInput
+        key | Just (_, ef) <- find ((== key) . fst) experimentalFeatures -> Right ef
         _ ->
           Left $
             "Only expecting list of comma separated experimental features, options are:"
-              ++ "inherited_roles, streaming_subscriptions, hide_update_many_fields, optimize_permission_filters, naming_convention, apollo_federation, bigquery_string_numeric_input"
+              ++ intercalate ", " (map (Text.unpack . fst) experimentalFeatures)
+
+      experimentalFeatures :: [(Text, Server.Types.ExperimentalFeature)]
+      experimentalFeatures = [(Server.Types.experimentalFeatureKey ef, ef) | ef <- [minBound .. maxBound]]
 
 instance FromEnv Subscription.Options.BatchSize where
   fromEnv s = do

server/src-lib/Hasura/Server/Types.hs

@@ -1,5 +1,6 @@
 module Hasura.Server.Types
   ( ExperimentalFeature (..),
+    experimentalFeatureKey,
     InstanceId (..),
     generateInstanceId,
     MetadataDbId (..),
@@ -21,10 +22,11 @@ where
 
 import Data.Aeson
 import Data.HashSet qualified as Set
+import Data.Text (intercalate, unpack)
 import Database.PG.Query qualified as PG
 import Hasura.GraphQL.Schema.NamingCase
 import Hasura.GraphQL.Schema.Options qualified as Options
-import Hasura.Prelude
+import Hasura.Prelude hiding (intercalate)
 import Hasura.RQL.Types.Common
 import Hasura.RQL.Types.Metadata (MetadataDefaults)
 import Hasura.Server.Utils
@@ -79,30 +81,38 @@ data ExperimentalFeature
   | EFApolloFederation
   | EFHideUpdateManyFields
   | EFBigQueryStringNumericInput
-  deriving (Show, Eq, Generic)
+  | EFHideAggregationPredicates
+  deriving (Bounded, Enum, Eq, Generic, Show)
+
+experimentalFeatureKey :: ExperimentalFeature -> Text
+experimentalFeatureKey = \case
+  EFInheritedRoles -> "inherited_roles"
+  EFOptimizePermissionFilters -> "optimize_permission_filters"
+  EFNamingConventions -> "naming_convention"
+  EFStreamingSubscriptions -> "streaming_subscriptions"
+  EFApolloFederation -> "apollo_federation"
+  EFHideUpdateManyFields -> "hide_update_many_fields"
+  EFBigQueryStringNumericInput -> "bigquery_string_numeric_input"
+  EFHideAggregationPredicates -> "hide_aggregation_predicates"
 
 instance Hashable ExperimentalFeature
 
 instance FromJSON ExperimentalFeature where
   parseJSON = withText "ExperimentalFeature" $ \case
-    "inherited_roles" -> pure EFInheritedRoles
-    "optimize_permission_filters" -> pure EFOptimizePermissionFilters
-    "naming_convention" -> pure EFNamingConventions
-    "streaming_subscriptions" -> pure EFStreamingSubscriptions
-    "hide_update_many_fields" -> pure EFHideUpdateManyFields
-    "apollo_federation" -> pure EFApolloFederation
-    "bigquery_string_numeric_input" -> pure EFBigQueryStringNumericInput
-    _ -> fail "ExperimentalFeature can only be one of these value: inherited_roles, optimize_permission_filters, hide_update_many_fields, naming_convention, streaming_subscriptions apollo_federation, or bigquery_string_numeric_input"
+    k | Just (_, ef) <- find ((== k) . fst) experimentalFeatures -> return $ ef
+    _ ->
+      fail $
+        "ExperimentalFeature can only be one of these values: "
+          <> unpack (intercalate "," (map fst experimentalFeatures))
+    where
+      experimentalFeatures :: [(Text, ExperimentalFeature)]
+      experimentalFeatures =
+        [ (experimentalFeatureKey ef, ef)
+          | ef <- [minBound .. maxBound]
+        ]
 
 instance ToJSON ExperimentalFeature where
-  toJSON = \case
-    EFInheritedRoles -> "inherited_roles"
-    EFOptimizePermissionFilters -> "optimize_permission_filters"
-    EFNamingConventions -> "naming_convention"
-    EFStreamingSubscriptions -> "streaming_subscriptions"
-    EFApolloFederation -> "apollo_federation"
-    EFHideUpdateManyFields -> "hide_update_many_fields"
-    EFBigQueryStringNumericInput -> "bigquery_string_numeric_input"
+  toJSON = toJSON . experimentalFeatureKey
 
 data MaintenanceMode a = MaintenanceModeEnabled a | MaintenanceModeDisabled
   deriving (Show, Eq)

server/src-test/Hasura/GraphQL/Schema/BoolExp/AggregationPredicatesSpec.hs

@@ -5,6 +5,7 @@
 module Hasura.GraphQL.Schema.BoolExp.AggregationPredicatesSpec (spec) where
 
 import Data.Aeson.QQ (aesonQQ)
+import Data.Has (Has (..))
 import Data.HashMap.Strict qualified as HM
 import Data.Text.NonEmpty (nonEmptyTextQQ)
 import Hasura.Backends.Postgres.Instances.Schema ()
@@ -21,6 +22,7 @@ import Hasura.GraphQL.Schema.BoolExp.AggregationPredicates
   )
 import Hasura.GraphQL.Schema.Introspection (queryInputFieldsParserIntrospection)
 import Hasura.GraphQL.Schema.NamingCase (NamingCase (..))
+import Hasura.GraphQL.Schema.Options qualified as Options
 import Hasura.Prelude
 import Hasura.RQL.IR.BoolExp (GBoolExp (..), OpExpG (AEQ))
 import Hasura.RQL.IR.BoolExp.AggregationPredicates
@@ -224,6 +226,30 @@ spec = do
 
           -- Permissions aren't in scope for this test.
           actual {aggRowPermission = BoolAnd []} `shouldBe` expected
+
+    describe "When SchemaOptions dictate exclusion of aggregation predicates" do
+      it "Yields no parsers" do
+        let maybeParser =
+              runSchemaTest $
+                local
+                  ( modifier
+                      ( \so ->
+                          so
+                            { Options.soIncludeAggregationPredicates = Options.Don'tIncludeAggregationPredicates
+                            }
+                      )
+                  )
+                  $ defaultAggregationPredicatesParser @('Postgres 'Vanilla) @_ @_ @ParserTest
+                    [ FunctionSignature
+                        { fnName = "count",
+                          fnGQLName = [G.name|count|],
+                          fnArguments = ArgumentsStar,
+                          fnReturnType = PGInteger
+                        }
+                    ]
+                    sourceInfo
+                    albumTableInfo
+        (Unshowable maybeParser) `shouldSatisfy` (isNothing . unUnshowable)
   where
     albumTableInfo :: TableInfo ('Postgres 'Vanilla)
     albumTableInfo =

server/src-test/Test/Parser/Monad.hs

@@ -4,7 +4,7 @@
 -- more advanced tests, they might require implementations.
 module Test.Parser.Monad
   ( ParserTest (..),
-    SchemaEnvironment,
+    SchemaEnvironment (..),
     SchemaTest,
     runSchemaTest,
     notImplementedYet,
@@ -53,6 +53,19 @@ notImplementedYet thing =
 -- SchemaEnvironment: currently void. This is subject to change if we require
 -- more complex setup.
 data SchemaEnvironment = SchemaEnvironment
+  {seSchemaOptions :: SchemaOptions}
+
+defaultSchemaOptions :: SchemaOptions
+defaultSchemaOptions =
+  SchemaOptions
+    { soStringifyNumbers = Options.Don'tStringifyNumbers,
+      soDangerousBooleanCollapse = Options.Don'tDangerouslyCollapseBooleans,
+      soInferFunctionPermissions = Options.InferFunctionPermissions,
+      soOptimizePermissionFilters = Options.Don'tOptimizePermissionFilters,
+      soIncludeUpdateManyFields = Options.IncludeUpdateManyFields,
+      soIncludeAggregationPredicates = Options.IncludeAggregationPredicates,
+      soBigQueryStringNumericInput = Options.EnableBigQueryStringNumericInput
+    }
 
 instance Has NamingCase SchemaEnvironment where
   getter :: SchemaEnvironment -> NamingCase
@@ -64,18 +77,10 @@ instance Has NamingCase SchemaEnvironment where
 instance Has SchemaOptions SchemaEnvironment where
   getter :: SchemaEnvironment -> SchemaOptions
   getter =
-    const
-      SchemaOptions
-        { soStringifyNumbers = Options.Don'tStringifyNumbers,
-          soDangerousBooleanCollapse = Options.Don'tDangerouslyCollapseBooleans,
-          soInferFunctionPermissions = Options.InferFunctionPermissions,
-          soOptimizePermissionFilters = Options.Don'tOptimizePermissionFilters,
-          soIncludeUpdateManyFields = Options.IncludeUpdateManyFields,
-          soBigQueryStringNumericInput = Options.EnableBigQueryStringNumericInput
-        }
+    seSchemaOptions
 
   modifier :: (SchemaOptions -> SchemaOptions) -> SchemaEnvironment -> SchemaEnvironment
-  modifier = notImplementedYet "modifier<Has SchemaOptions SchemaEnvironment>"
+  modifier f env = env {seSchemaOptions = f (seSchemaOptions env)}
 
 instance Has SchemaContext SchemaEnvironment where
   getter :: SchemaEnvironment -> SchemaContext
@@ -117,7 +122,7 @@ instance Has CustomizeRemoteFieldName SchemaEnvironment where
 type SchemaTest = SchemaT SchemaEnvironment SchemaTestInternal
 
 runSchemaTest :: SchemaTest a -> a
-runSchemaTest = runSchemaTestInternal . flip runReaderT SchemaEnvironment . runSchemaT
+runSchemaTest = runSchemaTestInternal . flip runReaderT (SchemaEnvironment defaultSchemaOptions) . runSchemaT
 
 newtype SchemaTestInternal a = SchemaTestInternal {runSchemaTestInternal :: a}
   deriving stock (Functor)