Build introspection Schema ad-hoc at parsing time

In order to respond to GraphQL queries that make use of the introspection fields `__type` or `__schema`, we need two things:
- an overview of the relevant GraphQL type information, stored in a `Schema` object, and
- to have included the `__type` and `__schema` fields in the `query_root` that we generate.

It used to be necessary to do the above items in that order, since the `__type` and `__schema` fields (i.e. the respective `FieldParser`s) were generated _from_ a `Schema` object.

Thanks to recent refactorings in `Hasura.GraphQL.Schema.Introspect` (see hasura/graphql-engine-mono#2835 or hasura/graphql-engine@5760d9289c), the introspection fields _themselves_ are now `Schema`-agnostic, and simply return a function that takes a `Schema` object after parsing. For instance, the type of `schema`, corresponding to the `__schema` field, has literally changed as follows:
```diff
-schema :: MonadParse n => Schema -> FieldParser n (          J.Value)
+schema :: MonadParse n =>           FieldParser n (Schema -> J.Value)
 ```

This means that the introspection fields can be included in the GraphQL schema *before* we have generated a `Schema` object. In particular, rather than the current architecture of generating `Schema` at startup time for every role, we can instead generate `Schema` ad-hoc at query parsing time, only for those queries that make use of the introspection fields. This avoids us storing a `Schema` for every role for the lifetime of the server.

However: this introduces a functional change, as the code that generates the `Schema` object, and in particular the `accumulateTypeDefinitions` method, also does certain correctness checks, to prevent exposing a spec-incompliant GraphQL schema. If these correctness checks are being done at parsing time rather than startup time, then we catch certain errors only later on. For this reason, this PR adds an explicit run of this type accumulation at startup time. For efficiency reasons, and since this correctness check is not essential for correct operation of HGE, this is done for the admin role only.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3231
GitOrigin-RevId: 23701c548b785929b28667025436b6ce60bfe1cd

CHANGELOG.md

@@ -7,6 +7,7 @@
 
 - server: Webhook Transforms can now delete request/response bodies explicitly.
 - server: Fix truncation of session variables with variable length column types in MSSQL (#8158)
+- server: improve baseline memory consumption for typical workloads
 - server: fix parsing timestamp values in BigQuery backends (fix #8076)
 
 ## v2.3.0-beta.1

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

@@ -5,6 +5,7 @@ module Hasura.GraphQL.Parser
     parserType,
     runParser,
     bind,
+    bindField,
     bindFields,
     boolean,
     int,

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

@@ -857,6 +857,9 @@ instance HasTypeDefinitions (Definition (TypeInfo k)) where
 instance HasTypeDefinitions a => HasTypeDefinitions [a] where
   accumulateTypeDefinitions = traverse_ accumulateTypeDefinitions
 
+instance HasTypeDefinitions a => HasTypeDefinitions (Maybe a) where
+  accumulateTypeDefinitions = traverse_ accumulateTypeDefinitions
+
 instance HasTypeDefinitions TypeDefinitionsWrapper where
   accumulateTypeDefinitions (TypeDefinitionsWrapper x) = accumulateTypeDefinitions x
 

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

@@ -25,7 +25,6 @@ import Hasura.GraphQL.Parser
   )
 import Hasura.GraphQL.Parser qualified as P
 import Hasura.GraphQL.Parser.Class
-import Hasura.GraphQL.Parser.Directives (directivesInfo)
 import Hasura.GraphQL.Parser.Internal.Parser (FieldParser (..))
 import Hasura.GraphQL.Schema.Backend
 import Hasura.GraphQL.Schema.Common
@@ -210,6 +209,19 @@ buildRoleContext
           buildQueryParser queryFields queryRemotes allActionInfos customTypes mutationParserFrontend subscriptionParser
         queryParserBackend <-
           buildQueryParser queryFields queryRemotes allActionInfos customTypes mutationParserBackend subscriptionParser
+        -- In order to catch errors early, we attempt to generate the data
+        -- required for introspection, which ends up doing a few correctness
+        -- checks in the GraphQL schema.
+        void $
+          buildIntrospectionSchema
+            (P.parserType queryParserBackend)
+            (P.parserType <$> mutationParserBackend)
+            (P.parserType <$> subscriptionParser)
+        void $
+          buildIntrospectionSchema
+            (P.parserType queryParserFrontend)
+            (P.parserType <$> mutationParserFrontend)
+            (P.parserType <$> subscriptionParser)
 
         let frontendContext =
               GQLContext (finalizeParser queryParserFrontend) (finalizeParser <$> mutationParserFrontend)
@@ -601,6 +613,21 @@ buildQueryParser pgQueryFields remoteFields allActions customTypes mutationParse
   let allQueryFields = pgQueryFields <> fmap (fmap NotNamespaced) actionQueryFields <> fmap (fmap $ fmap RFRemote) remoteFields
   queryWithIntrospectionHelper allQueryFields mutationParser subscriptionParser
 
+-- | Builds a @Schema@ at query parsing time
+parseBuildIntrospectionSchema ::
+  MonadParse m =>
+  P.Type 'Output ->
+  Maybe (P.Type 'Output) ->
+  Maybe (P.Type 'Output) ->
+  m Schema
+parseBuildIntrospectionSchema q m s = qerrAsMonadParse $ buildIntrospectionSchema q m s
+
+qerrAsMonadParse :: MonadParse m => Except QErr a -> m a
+qerrAsMonadParse action =
+  case runExcept action of
+    Right a -> pure a
+    Left QErr {..} -> withPath (++ qePath) $ parseErrorWith qeCode qeError
+
 queryWithIntrospectionHelper ::
   forall n m.
   (MonadSchema n m, MonadError QErr m) =>
@@ -619,43 +646,16 @@ queryWithIntrospectionHelper basicQueryFP mutationP subscriptionP = do
       placeholderField = NotNamespaced (RFRaw $ JO.String placeholderText) <$ P.selection_ $$(G.litName "no_queries_available") (Just $ G.Description placeholderText) P.string
       fixedQueryFP = if null basicQueryFP then [placeholderField] else basicQueryFP
   basicQueryP <- queryRootFromFields fixedQueryFP
-  let directives = directivesInfo @n
+  let buildIntrospectionResponse printResponseFromSchema = do
-  -- We extract the types from the ordinary GraphQL schema (excluding introspection)
+        partialSchema <-
-  allBasicTypes <-
+          parseBuildIntrospectionSchema
-    collectTypes $
+            (P.parserType basicQueryP)
-      catMaybes
+            (P.parserType <$> mutationP)
-        [ Just $ P.TypeDefinitionsWrapper $ P.parserType basicQueryP,
+            (P.parserType <$> subscriptionP)
-          Just $ P.TypeDefinitionsWrapper $ P.diArguments =<< directives,
+        pure $ NotNamespaced $ RFRaw $ printResponseFromSchema partialSchema
-          P.TypeDefinitionsWrapper . P.parserType <$> mutationP,
+      introspection = [schema, typeIntrospection] <&> (`P.bindField` buildIntrospectionResponse)
-          P.TypeDefinitionsWrapper . P.parserType <$> subscriptionP
-        ]
-  let introspection = [schema, typeIntrospection]
       {-# INLINE introspection #-}
-
+      partialQueryFields = fixedQueryFP ++ introspection
-  -- TODO: it may be worth looking at whether we can stop collecting
-  -- introspection types monadically.  They are independent of the user schema;
-  -- the types here are always the same and specified by the GraphQL spec
-
-  -- Pull all the introspection types out (__Type, __Schema, etc)
-  allIntrospectionTypes <- collectTypes (map fDefinition introspection)
-
-  let allTypes =
-        Map.unions
-          [ allBasicTypes,
-            Map.filterWithKey (\name _info -> name /= P.getName queryRoot) allIntrospectionTypes
-          ]
-      partialSchema =
-        Schema
-          { sDescription = Nothing,
-            sTypes = allTypes,
-            sQueryType = P.parserType basicQueryP,
-            sMutationType = P.parserType <$> mutationP,
-            sSubscriptionType = P.parserType <$> subscriptionP,
-            sDirectives = directives
-          }
-  let buildIntrospectionResponse fromSchema = NotNamespaced $ RFRaw $ fromSchema partialSchema
-      partialQueryFields =
-        fixedQueryFP ++ (fmap buildIntrospectionResponse <$> introspection)
   P.safeSelectionSet queryRoot Nothing partialQueryFields <&> fmap (flattenNamespaces . fmap typenameToNamespacedRawRF)
 
 queryRootFromFields ::
@@ -666,20 +666,6 @@ queryRootFromFields ::
 queryRootFromFields fps =
   P.safeSelectionSet queryRoot Nothing fps <&> fmap (flattenNamespaces . fmap typenameToNamespacedRawRF)
 
-collectTypes ::
-  forall m a.
-  (MonadError QErr m, P.HasTypeDefinitions a) =>
-  a ->
-  m (HashMap G.Name (P.Definition P.SomeTypeInfo))
-collectTypes x =
-  P.collectTypeDefinitions x
-    `onLeft` \(P.ConflictingDefinitions (type1, origin1) (_type2, origins)) ->
-      -- See Note [Collecting types from the GraphQL schema]
-      throw500 $
-        "Found conflicting definitions for " <> P.getName type1 <<> ".  The definition at " <> origin1
-          <<> " differs from the the definition at " <> commaSeparated origins
-          <<> "."
-
 -- | Prepare the parser for subscriptions. Every postgres query field is
 -- exposed as a subscription along with fields to get the status of
 -- asynchronous actions.

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

@@ -1,7 +1,8 @@
 {-# LANGUAGE ApplicativeDo #-}
 
 module Hasura.GraphQL.Schema.Introspect
-  ( schema,
+  ( buildIntrospectionSchema,
+    schema,
     typeIntrospection,
   )
 where
@@ -13,10 +14,14 @@ import Data.HashMap.Strict qualified as Map
 import Data.HashMap.Strict.InsOrd qualified as OMap
 import Data.List.NonEmpty qualified as NE
 import Data.Text qualified as T
+import Data.Text.Extended
 import Data.Vector qualified as V
+import Hasura.Base.Error
 import Hasura.GraphQL.Parser (FieldParser, Kind (..), Parser, Schema (..))
 import Hasura.GraphQL.Parser qualified as P
 import Hasura.GraphQL.Parser.Class
+import Hasura.GraphQL.Parser.Directives
+import Hasura.GraphQL.Parser.Internal.Parser (FieldParser (..))
 import Hasura.Prelude
 import Language.GraphQL.Draft.Printer qualified as GP
 import Language.GraphQL.Draft.Syntax qualified as G
@@ -143,6 +148,115 @@ there is no deeper meaning to the application of do notation than ease of
 reading.
 -}
 
+{- Note [What introspection exposes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+NB: By "introspection query", we mean a query making use of the __type or
+__schema top-level fields.
+
+It would be very convenient if we could simply build up our desired GraphQL
+schema, without regard for introspection. Ideally, we would then extract the
+data required for introspection from this complete GraphQL schema. There are,
+however, some complications:
+
+1. Of course, we _do_ need to include the introspection fields themselves into
+   the query_root, so that we can deal with introspection queries
+   appropriately. So we can't avoid thinking about introspection entirely while
+   constructing the GraphQL schema.
+
+2. The GraphQL specification says that although we must always expose __type and
+   __schema fields as part of the query_root, they must not be visible fields of
+   the query_root object type. See
+   http://spec.graphql.org/June2018/#sec-Schema-Introspection
+
+At this point, one might naively attempt to generate two GraphQL schemas:
+
+- One without the __type and __schema fields, from which we generate the data
+  required for responding to introspection queries.
+- One with the __type and __schema fields, which is used to actually respond to
+  queries.
+
+However, this is also not GraphQL-compliant!
+
+The problem here is that while __type and __schema are not visible fields of the
+query root object, their *types*, __Type and __Schema respectively, *must be*
+exposed through __type introspection, even though those types never appear as
+(transitive) members of the query/mutation/subscription root fields.
+
+So in order to gather the data required for introspection, we follow the
+following recipe:
+
+A. Collect type information from the introspection-free GraphQL schema
+
+B. Collect type information from the introspection-only GraphQL schema
+
+C. Stitch together the results of (A) and (B). In particular, the query_root
+from (A) is used, and all types from (A) and (B) are used, except for the
+query_root obtained in (B). -}
+
+-- | Builds a @Schema@ from GraphQL types for the query_root, mutation_root and
+-- subscription_root.
+--
+-- See Note [What introspection exposes]
+buildIntrospectionSchema ::
+  MonadError QErr m =>
+  P.Type 'Output ->
+  Maybe (P.Type 'Output) ->
+  Maybe (P.Type 'Output) ->
+  m P.Schema
+buildIntrospectionSchema queryRoot' mutationRoot' subscriptionRoot' = do
+  let -- The only directives that we currently expose over introspection are our
+      -- statically defined ones.  So, for instance, we don't correctly expose
+      -- directives from remote schemas.
+      directives = directivesInfo @(P.ParseT Identity)
+      -- The __schema and __type introspection fields
+      introspection = [schema @(P.ParseT Identity), typeIntrospection]
+      {-# INLINE introspection #-}
+
+  -- Collect type information of all non-introspection fields
+  allBasicTypes <-
+    collectTypes
+      [ P.TypeDefinitionsWrapper queryRoot',
+        P.TypeDefinitionsWrapper mutationRoot',
+        P.TypeDefinitionsWrapper subscriptionRoot',
+        P.TypeDefinitionsWrapper $ P.diArguments =<< directives
+      ]
+
+  -- TODO: it may be worth looking at whether we can stop collecting
+  -- introspection types monadically.  They are independent of the user schema;
+  -- the types here are always the same and specified by the GraphQL spec
+
+  -- Pull all the introspection types out (__Type, __Schema, etc)
+  allIntrospectionTypes <- collectTypes (map fDefinition introspection)
+
+  let allTypes =
+        Map.unions
+          [ allBasicTypes,
+            Map.filterWithKey (\name _info -> name /= P.getName queryRoot') allIntrospectionTypes
+          ]
+  pure $
+    P.Schema
+      { sDescription = Nothing,
+        sTypes = allTypes,
+        sQueryType = queryRoot',
+        sMutationType = mutationRoot',
+        sSubscriptionType = subscriptionRoot',
+        sDirectives = directives
+      }
+
+collectTypes ::
+  forall m a.
+  (MonadError QErr m, P.HasTypeDefinitions a) =>
+  a ->
+  m (HashMap G.Name (P.Definition P.SomeTypeInfo))
+collectTypes x =
+  P.collectTypeDefinitions x
+    `onLeft` \(P.ConflictingDefinitions (type1, origin1) (_type2, origins)) ->
+      -- See Note [Collecting types from the GraphQL schema]
+      throw500 $
+        "Found conflicting definitions for " <> P.getName type1 <<> ".  The definition at " <> origin1
+          <<> " differs from the the definition at " <> commaSeparated origins
+          <<> "."
+
 -- | Generate a __type introspection parser
 typeIntrospection ::
   forall n.
@@ -153,15 +267,13 @@ typeIntrospection = do
   let nameArg :: P.InputFieldsParser n Text
       nameArg = P.field $$(G.litName "name") Nothing P.string
   ~(nameText, printer) <- P.subselection $$(G.litName "__type") Nothing nameArg typeField
-  -- We pass around the GraphQL schema information under the name `fakeSchema`,
+  -- We pass around the GraphQL schema information under the name `partialSchema`,
   -- because the GraphQL spec forces us to expose a hybrid between the
   -- specification of valid queries (including introspection) and an
-  -- introspection-free GraphQL schema.  The introspection fields __type and
+  -- introspection-free GraphQL schema.  See Note [What introspection exposes].
-  -- __schema are not exposed as part of query_root, but the types of those
+  pure $ \partialSchema -> fromMaybe J.Null $ do
-  -- fields must be.  Hasura.GraphQL.Schema is responsible for organising this.
-  pure $ \fakeSchema -> fromMaybe J.Null $ do
     name <- G.mkName nameText
-    P.Definition n d (P.SomeTypeInfo i) <- Map.lookup name $ sTypes fakeSchema
+    P.Definition n d (P.SomeTypeInfo i) <- Map.lookup name $ sTypes partialSchema
     Just $ printer $ SomeType $ P.TNamed P.Nullable $ P.Definition n d i
 
 -- | Generate a __schema introspection parser.
@@ -575,18 +687,18 @@ schemaSet =
   let description :: FieldParser n (Schema -> J.Value)
       description =
         P.selection_ $$(G.litName "description") Nothing P.string
-          $> \fakeSchema -> case sDescription fakeSchema of
+          $> \partialSchema -> case sDescription partialSchema of
             Nothing -> J.Null
             Just s -> J.String $ G.unDescription s
       types :: FieldParser n (Schema -> J.Value)
       types = do
         printer <- P.subselection_ $$(G.litName "types") Nothing typeField
         return $
-          \fakeSchema ->
+          \partialSchema ->
             J.Array $
               V.fromList $
                 map (printer . schemaTypeToSomeType) $
-                  sortOn P.dName $ Map.elems $ sTypes fakeSchema
+                  sortOn P.dName $ Map.elems $ sTypes partialSchema
         where
           schemaTypeToSomeType ::
             P.Definition P.SomeTypeInfo ->
@@ -596,23 +708,23 @@ schemaSet =
       queryType :: FieldParser n (Schema -> J.Value)
       queryType = do
         printer <- P.subselection_ $$(G.litName "queryType") Nothing typeField
-        return $ \fakeSchema -> printer $ SomeType $ sQueryType fakeSchema
+        return $ \partialSchema -> printer $ SomeType $ sQueryType partialSchema
       mutationType :: FieldParser n (Schema -> J.Value)
       mutationType = do
         printer <- P.subselection_ $$(G.litName "mutationType") Nothing typeField
-        return $ \fakeSchema -> case sMutationType fakeSchema of
+        return $ \partialSchema -> case sMutationType partialSchema of
           Nothing -> J.Null
           Just tp -> printer $ SomeType tp
       subscriptionType :: FieldParser n (Schema -> J.Value)
       subscriptionType = do
         printer <- P.subselection_ $$(G.litName "subscriptionType") Nothing typeField
-        return $ \fakeSchema -> case sSubscriptionType fakeSchema of
+        return $ \partialSchema -> case sSubscriptionType partialSchema of
           Nothing -> J.Null
           Just tp -> printer $ SomeType tp
       directives :: FieldParser n (Schema -> J.Value)
       directives = do
         printer <- P.subselection_ $$(G.litName "directives") Nothing directiveSet
-        return $ \fakeSchema -> J.array $ map printer $ sDirectives fakeSchema
+        return $ \partialSchema -> J.array $ map printer $ sDirectives partialSchema
    in applyPrinter
         <$> P.selectionSet
           $$(G.litName "__Schema")