Refactor type name customization

Source typename customization (hasura/graphql-engine@aac64f2c81) introduced a mechanism to change certain names in the GraphQL schema that is exposed. In particular it allows last-minute modification of:
1. the names of some types, and
2. the names of some root fields.

The above two items are assigned distinct customization algorithms, and at times both algorithms are in scope. So a need to distinguish them is needed.

In the original design, this was addressed by introducing a newtype wrapper `Typename` around GraphQL `Name`s, dedicated to the names of types. However, in the majority of the codebase, type names are also represented by `Name`. For this reason, it was unavoidable to allow for easy conversion. This was supported by a `HasName Typename` instance, as well as by publishing the constructors of `Typename`.

This means that the type safety that newtypes can add is lost. In particular, it is now very easy to confuse type name customization with root field name customization.

This refactors the above design by instead introducing newtypes around the customization operations:
```haskell
newtype MkTypename = MkTypename {runMkTypename :: Name -> Name}
  deriving (Semigroup, Monoid) via (Endo Name)

newtype MkRootFieldName = MkRootFieldName {runMkRootFieldName :: Name -> Name}
  deriving (Semigroup, Monoid) via (Endo Name)
```
The `Monoid` instance allows easy composition of customization operations, piggybacking off of the type of `Endo`maps.

This design allows safe co-existence of the two customization algorithms, while avoiding the syntactic overhead of packing and unpacking newtypes.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2989
GitOrigin-RevId: da3a353a9b003ee40c8d0a1e02872e99d2edd3ca

server/src-lib/Hasura/Backends/BigQuery/Instances/Schema.hs

@@ -208,7 +208,7 @@ bqColumnParser columnType (G.Nullability isNullable) =
       BigQuery.DatetimeScalarType -> pure $ possiblyNullable scalarType $ BigQuery.DatetimeValue . BigQuery.Datetime <$> P.string
       BigQuery.GeographyScalarType -> pure $ possiblyNullable scalarType $ BigQuery.GeographyValue . BigQuery.Geography <$> P.string
       BigQuery.TimestampScalarType -> do
-        let schemaType = P.Nullable . P.TNamed $ P.mkDefinition (P.Typename stringScalar) Nothing P.TIScalar
+        let schemaType = P.Nullable . P.TNamed $ P.mkDefinition stringScalar Nothing P.TIScalar
         pure $
           possiblyNullable scalarType $
             Parser
@@ -291,7 +291,7 @@ bqComparisonExps = P.memoize 'comparisonExps $ \columnType -> do
   typedParser <- columnParser columnType (G.Nullability False)
   nullableTextParser <- columnParser (ColumnScalar @'BigQuery BigQuery.StringScalarType) (G.Nullability True)
   -- textParser <- columnParser (ColumnScalar @'BigQuery BigQuery.StringScalarType) (G.Nullability False)
-  let name = P.Typename $ P.getName typedParser <> $$(G.litName "_BigQuery_comparison_exp")
+  let name = P.getName typedParser <> $$(G.litName "_BigQuery_comparison_exp")
       desc =
         G.Description $
           "Boolean expression to compare columns of type "

server/src-lib/Hasura/Backends/MSSQL/Instances/Schema.hs

@@ -275,7 +275,7 @@ msColumnParser columnType (G.Nullability isNullable) =
         MSSQL.BitType -> pure $ ODBC.BoolValue <$> P.boolean
         _ -> do
           name <- MSSQL.mkMSSQLScalarTypeName scalarType
-          let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition (P.Typename name) Nothing P.TIScalar
+          let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition name Nothing P.TIScalar
           pure $
             Parser
               { pType = schemaType,
@@ -358,7 +358,7 @@ msComparisonExps = P.memoize 'comparisonExps \columnType -> do
       textListParser = fmap openValueOrigin <$> P.list textParser
 
   -- field info
-  let name = P.Typename $ P.getName typedParser <> $$(G.litName "_MSSQL_comparison_exp")
+  let name = P.getName typedParser <> $$(G.litName "_MSSQL_comparison_exp")
       desc =
         G.Description $
           "Boolean expression to compare columns of type "

server/src-lib/Hasura/Backends/MySQL/Instances/Schema.hs

@@ -185,7 +185,7 @@ columnParser' columnType (G.Nullability isNullable) =
       MySQL.Timestamp -> pure $ possiblyNullable scalarType $ MySQL.TimestampValue <$> P.string
       _ -> do
         name <- MySQL.mkMySQLScalarTypeName scalarType
-        let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition (P.Typename name) Nothing P.TIScalar
+        let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition name Nothing P.TIScalar
         pure $
           Parser
             { pType = schemaType,
@@ -261,7 +261,7 @@ comparisonExps' = P.memoize 'comparisonExps $ \columnType -> do
   typedParser <- columnParser columnType (G.Nullability False)
   nullableTextParser <- columnParser (ColumnScalar @'MySQL MySQL.VarChar) (G.Nullability True)
   textParser <- columnParser (ColumnScalar @'MySQL MySQL.VarChar) (G.Nullability False)
-  let name = P.Typename $ P.getName typedParser <> $$(G.litName "_MySQL_comparison_exp")
+  let name = P.getName typedParser <> $$(G.litName "_MySQL_comparison_exp")
       desc =
         G.Description $
           "Boolean expression to compare columns of type "

server/src-lib/Hasura/Backends/Postgres/Instances/Schema.hs

@@ -213,7 +213,7 @@ columnParser columnType (G.Nullability isNullable) =
         -- not accept strings.
         --
         -- TODO: introduce new dedicated scalars for Postgres column types.
-        name <- P.Typename <$> mkScalarTypeName scalarType
+        name <- mkScalarTypeName scalarType
         let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition name Nothing P.TIScalar
         pure $
           Parser
@@ -313,7 +313,7 @@ comparisonExps = P.memoize 'comparisonExps \columnType -> do
   -- `ltxtquery` represents a full-text-search-like pattern for matching `ltree` values.
   ltxtqueryParser <- columnParser (ColumnScalar PGLtxtquery) (G.Nullability False)
   maybeCastParser <- castExp columnType
-  let name = P.Typename $ P.getName typedParser <> $$(G.litName "_comparison_exp")
+  let name = P.getName typedParser <> $$(G.litName "_comparison_exp")
       desc =
         G.Description $
           "Boolean expression to compare columns of type "
@@ -564,7 +564,7 @@ comparisonExps = P.memoize 'comparisonExps \columnType -> do
         targetName <- mkScalarTypeName targetScalar
         targetOpExps <- comparisonExps $ ColumnScalar targetScalar
         let field = P.fieldOptional targetName Nothing $ (targetScalar,) <$> targetOpExps
-        pure $ P.object (P.Typename sourceName) Nothing $ M.fromList . maybeToList <$> field
+        pure $ P.object sourceName Nothing $ M.fromList . maybeToList <$> field
 
 geographyWithinDistanceInput ::
   forall pgKind m n r.
@@ -581,7 +581,7 @@ geographyWithinDistanceInput = do
   booleanParser <- columnParser (ColumnScalar PGBoolean) (G.Nullability True)
   floatParser <- columnParser (ColumnScalar PGFloat) (G.Nullability False)
   pure $
-    P.object (P.Typename $$(G.litName "st_d_within_geography_input")) Nothing $
+    P.object $$(G.litName "st_d_within_geography_input") Nothing $
       DWithinGeogOp <$> (mkParameter <$> P.field $$(G.litName "distance") Nothing floatParser)
         <*> (mkParameter <$> P.field $$(G.litName "from") Nothing geographyParser)
         <*> (mkParameter <$> P.fieldWithDefault $$(G.litName "use_spheroid") Nothing (G.VBoolean True) booleanParser)
@@ -594,7 +594,7 @@ geometryWithinDistanceInput = do
   geometryParser <- columnParser (ColumnScalar PGGeometry) (G.Nullability False)
   floatParser <- columnParser (ColumnScalar PGFloat) (G.Nullability False)
   pure $
-    P.object (P.Typename $$(G.litName "st_d_within_input")) Nothing $
+    P.object $$(G.litName "st_d_within_input") Nothing $
       DWithinGeomOp <$> (mkParameter <$> P.field $$(G.litName "distance") Nothing floatParser)
         <*> (mkParameter <$> P.field $$(G.litName "from") Nothing geometryParser)
 
@@ -606,7 +606,7 @@ intersectsNbandGeomInput = do
   geometryParser <- columnParser (ColumnScalar PGGeometry) (G.Nullability False)
   integerParser <- columnParser (ColumnScalar PGInteger) (G.Nullability False)
   pure $
-    P.object (P.Typename $$(G.litName "st_intersects_nband_geom_input")) Nothing $
+    P.object $$(G.litName "st_intersects_nband_geom_input") Nothing $
       STIntersectsNbandGeommin <$> (mkParameter <$> P.field $$(G.litName "nband") Nothing integerParser)
         <*> (mkParameter <$> P.field $$(G.litName "geommin") Nothing geometryParser)
 
@@ -618,7 +618,7 @@ intersectsGeomNbandInput = do
   geometryParser <- columnParser (ColumnScalar PGGeometry) (G.Nullability False)
   integerParser <- columnParser (ColumnScalar PGInteger) (G.Nullability False)
   pure $
-    P.object (P.Typename $$(G.litName "st_intersects_geom_nband_input")) Nothing $
+    P.object $$(G.litName "st_intersects_geom_nband_input") Nothing $
       STIntersectsGeomminNband
         <$> (mkParameter <$> P.field $$(G.litName "geommin") Nothing geometryParser)
         <*> (fmap mkParameter <$> P.fieldOptional $$(G.litName "nband") Nothing integerParser)

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

@@ -97,7 +97,7 @@ customizeNamespace (Just namespace) fromParsedSelection mkNamespaceTypename fiel
     parser :: Parser 'Output n (NamespacedField a)
     parser =
       Namespaced . OMap.mapWithKey fromParsedSelection
-        <$> P.selectionSet (mkNamespaceTypename namespace) Nothing fieldParsers
+        <$> P.selectionSet (runMkTypename mkNamespaceTypename namespace) Nothing fieldParsers
 customizeNamespace Nothing _ _ fieldParsers =
   -- No namespace so just wrap the field parser results in @NotNamespaced@.
   fmap NotNamespaced <$> fieldParsers

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

@@ -255,7 +255,7 @@ fieldWithDefault name description defaultValue parser =
 
 enum ::
   MonadParse m =>
-  Typename ->
+  Name ->
   Maybe Description ->
   NonEmpty (Definition EnumValueInfo, a) ->
   Parser 'Both m a
@@ -289,7 +289,7 @@ enum name description values =
 -- the spec.
 object ::
   MonadParse m =>
-  Typename ->
+  Name ->
   Maybe Description ->
   InputFieldsParser m a ->
   Parser 'Input m a

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

@@ -122,7 +122,7 @@ multiple parser = parser {pType = Nullable $ TList $ pType parser}
 -- | A variant of 'selectionSetObject' which doesn't implement any interfaces
 selectionSet ::
   MonadParse m =>
-  Typename ->
+  Name ->
   Maybe Description ->
   [FieldParser m a] ->
   Parser 'Output m (OMap.InsOrdHashMap Name (ParsedSelection a))
@@ -130,7 +130,7 @@ selectionSet name desc fields = selectionSetObject name desc fields []
 
 safeSelectionSet ::
   (MonadError QErr n, MonadParse m) =>
-  Typename ->
+  Name ->
   Maybe Description ->
   [FieldParser m a] ->
   n (Parser 'Output m (OMap.InsOrdHashMap Name (ParsedSelection a)))
@@ -147,7 +147,7 @@ safeSelectionSet name desc fields
 -- See also Note [Selectability of tables].
 selectionSetObject ::
   MonadParse m =>
-  Typename ->
+  Name ->
   Maybe Description ->
   -- | Fields of this object, including any fields that are required from the
   -- interfaces that it implements.  Note that we can't derive those fields from
@@ -208,7 +208,7 @@ selectionSetObject name description parsers implementsInterfaces =
 
 selectionSetInterface ::
   (MonadParse n, Traversable t) =>
-  Typename ->
+  Name ->
   Maybe Description ->
   -- | Fields defined in this interface
   [FieldParser n a] ->
@@ -239,7 +239,7 @@ selectionSetInterface name description fields objectImplementations =
 
 selectionSetUnion ::
   (MonadParse n, Traversable t) =>
-  Typename ->
+  Name ->
   Maybe Description ->
   -- | The member object types.
   t (Parser 'Output n b) ->

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

@@ -87,8 +87,8 @@ uuid = mkScalar name Nothing \case
     name = $$(litName "uuid")
 
 json, jsonb :: MonadParse m => Parser 'Both m A.Value
-json = jsonScalar (Typename $$(litName "json")) Nothing
+json = jsonScalar $$(litName "json") Nothing
-jsonb = jsonScalar (Typename $$(litName "jsonb")) Nothing
+jsonb = jsonScalar $$(litName "jsonb") Nothing
 
 -- | Additional validation on integers. We do keep the same type name in the schema for backwards
 -- compatibility.
@@ -130,7 +130,7 @@ bigInt = mkScalar intScalar Nothing \case
 -- explicit use of the Parser constructor.
 unsafeRawScalar ::
   MonadParse n =>
-  Typename ->
+  Name ->
   Maybe Description ->
   Parser 'Both n (InputValue Variable)
 unsafeRawScalar name description =
@@ -141,7 +141,7 @@ unsafeRawScalar name description =
 
 -- | Creates a parser that transforms its input into a JSON value. 'valueToJSON'
 -- does properly unpack variables.
-jsonScalar :: MonadParse m => Typename -> Maybe Description -> Parser 'Both m A.Value
+jsonScalar :: MonadParse m => Name -> Maybe Description -> Parser 'Both m A.Value
 jsonScalar name description =
   Parser
     { pType = schemaType,
@@ -165,7 +165,7 @@ mkScalar name description parser =
       pParser = peelVariable (toGraphQLType schemaType) >=> parser
     }
   where
-    schemaType = NonNullable $ TNamed $ mkDefinition (Typename name) description TIScalar
+    schemaType = NonNullable $ TNamed $ mkDefinition name description TIScalar
 
 convertWith ::
   MonadParse m =>

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

@@ -6,8 +6,7 @@ module Hasura.GraphQL.Parser.Schema
     type (<:) (..),
 
     -- * Types
-    Typename (..),
+    MkTypename (..),
-    MkTypename,
     mkTypename,
     withTypenameCustomization,
     Type (..),
@@ -32,7 +31,6 @@ module Hasura.GraphQL.Parser.Schema
     UnionInfo (..),
 
     -- * Definitions
-    DefinitionName,
     Definition (..),
     mkDefinition,
     addDefinitionUnique,
@@ -63,6 +61,7 @@ import Data.HashMap.Strict.Extended qualified as Map
 import Data.HashSet qualified as Set
 import Data.Hashable (Hashable (..))
 import Data.List.NonEmpty qualified as NE
+import Data.Monoid
 import Data.Text qualified as T
 import Data.Text.Extended
 import Hasura.Incremental (Cacheable)
@@ -82,25 +81,20 @@ class HasName a where
 instance HasName Name where
   getName = id
 
--- | newtype wrapper to allow us to distinguish type names from other GraphQL names.
+-- | Type name customization
-newtype Typename = Typename {unTypename :: Name} deriving (Eq, Ord, Show, HasName, J.ToJSON)
+newtype MkTypename = MkTypename {runMkTypename :: Name -> Name}
+  deriving (Semigroup, Monoid) via (Endo Name)
 
-instance ToTxt Typename where
+-- | Inject a new @MkTypename@ customization function into the environment.
-  toTxt = toTxt . getName
-
--- | Function to turn a @Name@ into a @Typename@ while possibly applying some customizations.
-type MkTypename = Name -> Typename
-
--- | Inject a new @Typename@ customization function into the environment.
 -- This can be used by schema-building code (with @MonadBuildSchema@ constraint) to ensure
--- the correct typename customizations are applied.
+-- the correct type name customizations are applied.
 withTypenameCustomization :: forall m r a. (MonadReader r m, Has MkTypename r) => MkTypename -> m a -> m a
 withTypenameCustomization = local . set hasLens
 
--- | Apply the typename customization function from the current environment.
+-- | Apply the type name customization function from the current environment.
-mkTypename :: (MonadReader r m, Has MkTypename r) => Name -> m Typename
+mkTypename :: (MonadReader r m, Has MkTypename r) => Name -> m Name
 mkTypename name =
-  ($ name) <$> asks getter
+  ($ name) . runMkTypename <$> asks getter
 
 -- | GraphQL types are divided into two classes: input types and output types.
 -- The GraphQL spec does not use the word “kind” to describe these classes, but
@@ -566,15 +560,6 @@ data SomeTypeInfo = forall k. SomeTypeInfo (TypeInfo k)
 instance Eq SomeTypeInfo where
   SomeTypeInfo a == SomeTypeInfo b = eqTypeInfo a b
 
-type family DefinitionName a where
-  DefinitionName (TypeInfo k) = Typename
-  DefinitionName SomeTypeInfo = Typename
-  DefinitionName InterfaceInfo = Typename
-  DefinitionName ObjectInfo = Typename
-  DefinitionName InputFieldInfo = Name
-  DefinitionName FieldInfo = Name
-  DefinitionName EnumValueInfo = Name
-
 data Definition a = Definition
   { dName :: Name,
     -- | A unique identifier used to break cycles in mutually-recursive type
@@ -594,8 +579,8 @@ instance Hashable a => Hashable (Definition a) where
   hashWithSalt salt Definition {..} =
     salt `hashWithSalt` dName `hashWithSalt` dInfo
 
-mkDefinition :: HasName (DefinitionName a) => DefinitionName a -> Maybe Description -> a -> Definition a
+mkDefinition :: Name -> Maybe Description -> a -> Definition a
-mkDefinition name description info = Definition (getName name) Nothing description info
+mkDefinition name description info = Definition name Nothing description info
 
 instance Eq a => Eq (Definition a) where
   (==) = eq1

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

@@ -81,8 +81,8 @@ validateSchemaCustomizationsConsistent remoteSchemaCustomizer (RemoteSchemaIntro
       G.TypeDefinitionInterface G.InterfaceTypeDefinition {..} ->
         for_ _itdPossibleTypes $ \typeName ->
           for_ _itdFieldsDefinition $ \G.FieldDefinition {..} -> do
-            let interfaceCustomizedFieldName = customizeFieldName _itdName _fldName
+            let interfaceCustomizedFieldName = runCustomizeRemoteFieldName customizeFieldName _itdName _fldName
-                typeCustomizedFieldName = customizeFieldName typeName _fldName
+                typeCustomizedFieldName = runCustomizeRemoteFieldName customizeFieldName typeName _fldName
             when (interfaceCustomizedFieldName /= typeCustomizedFieldName) $
               throwRemoteSchema $
                 "Remote schema customization inconsistency: field name mapping for field "
@@ -109,11 +109,11 @@ validateSchemaCustomizationsDistinct remoteSchemaCustomizer (RemoteSchemaIntrosp
   traverse_ validateFieldMappingsAreDistinct typeDefinitions
   where
     customizeTypeName = remoteSchemaCustomizeTypeName remoteSchemaCustomizer
-    customizeFieldName = remoteSchemaCustomizeFieldName remoteSchemaCustomizer
+    customizeFieldName = runCustomizeRemoteFieldName (remoteSchemaCustomizeFieldName remoteSchemaCustomizer)
 
     validateTypeMappingsAreDistinct :: m ()
     validateTypeMappingsAreDistinct = do
-      let dups = duplicates $ (customizeTypeName . typeDefinitionName) <$> typeDefinitions
+      let dups = duplicates $ (runMkTypename customizeTypeName . typeDefinitionName) <$> typeDefinitions
       unless (Set.null dups) $
         throwRemoteSchema $
           "Type name mappings are not distinct; the following types appear more than once: "

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

@@ -246,15 +246,15 @@ buildRoleContext
           (,,)
             <$> customizeFields
               sourceCustomization
-              (mkTypename . (<> $$(G.litName "_query")))
+              (mkTypename <> P.MkTypename (<> $$(G.litName "_query")))
               (buildQueryFields sourceName sourceConfig validTables validFunctions queryTagsConfig)
             <*> customizeFields
               sourceCustomization
-              (mkTypename . (<> $$(G.litName "_mutation_frontend")))
+              (mkTypename <> P.MkTypename (<> $$(G.litName "_mutation_frontend")))
               (buildMutationFields Frontend sourceName sourceConfig validTables validFunctions queryTagsConfig)
             <*> customizeFields
               sourceCustomization
-              (mkTypename . (<> $$(G.litName "_mutation_backend")))
+              (mkTypename <> P.MkTypename (<> $$(G.litName "_mutation_backend")))
               (buildMutationFields Backend sourceName sourceConfig validTables validFunctions queryTagsConfig)
 
 buildRelayRoleContext ::
@@ -331,15 +331,15 @@ buildRelayRoleContext
           (,,)
             <$> customizeFields
               sourceCustomization
-              (mkTypename . (<> $$(G.litName "_query")))
+              (mkTypename <> P.MkTypename (<> $$(G.litName "_query")))
               (buildRelayQueryFields sourceName sourceConfig validTables validFunctions queryTagsConfig)
             <*> customizeFields
               sourceCustomization
-              (mkTypename . (<> $$(G.litName "_mutation_frontend")))
+              (mkTypename <> P.MkTypename (<> $$(G.litName "_mutation_frontend")))
               (buildMutationFields Frontend sourceName sourceConfig validTables validFunctions queryTagsConfig)
             <*> customizeFields
               sourceCustomization
-              (mkTypename . (<> $$(G.litName "_mutation_backend")))
+              (mkTypename <> P.MkTypename (<> $$(G.litName "_mutation_backend")))
               (buildMutationFields Backend sourceName sourceConfig validTables validFunctions queryTagsConfig)
 
 buildFullestDBSchema ::
@@ -387,11 +387,11 @@ buildFullestDBSchema queryContext sources allActionInfos nonObjectCustomTypes =
         (,)
           <$> customizeFields
             sourceCustomization
-            (mkTypename . (<> $$(G.litName "_query")))
+            (mkTypename <> P.MkTypename (<> $$(G.litName "_query")))
             (buildQueryFields sourceName sourceConfig validTables validFunctions queryTagsConfig)
           <*> customizeFields
             sourceCustomization
-            (mkTypename . (<> $$(G.litName "_mutation_frontend")))
+            (mkTypename <> P.MkTypename (<> $$(G.litName "_mutation_frontend")))
             (buildMutationFields Frontend sourceName sourceConfig validTables validFunctions queryTagsConfig)
 
 -- The `unauthenticatedContext` is used when the user queries the graphql-engine
@@ -785,14 +785,14 @@ mkRootField sourceName sourceConfig queryTagsConfig inj =
 takeExposedAs :: FunctionExposedAs -> FunctionCache b -> FunctionCache b
 takeExposedAs x = Map.filter ((== x) . _fiExposedAs)
 
-subscriptionRoot :: P.Typename
+subscriptionRoot :: G.Name
-subscriptionRoot = P.Typename $$(G.litName "subscription_root")
+subscriptionRoot = $$(G.litName "subscription_root")
 
-mutationRoot :: P.Typename
+mutationRoot :: G.Name
-mutationRoot = P.Typename $$(G.litName "mutation_root")
+mutationRoot = $$(G.litName "mutation_root")
 
-queryRoot :: P.Typename
+queryRoot :: G.Name
-queryRoot = P.Typename $$(G.litName "query_root")
+queryRoot = $$(G.litName "query_root")
 
 finalizeParser :: Parser 'Output (P.ParseT Identity) a -> ParserFn a
 finalizeParser parser = runIdentity . P.runParseT . P.runParser parser
@@ -821,7 +821,7 @@ runMonadSchema ::
   ConcreteSchemaT m a ->
   m a
 runMonadSchema roleName queryContext pgSources m =
-  P.runSchemaT m `runReaderT` (roleName, pgSources, queryContext, P.Typename, id, const id)
+  P.runSchemaT m `runReaderT` (roleName, pgSources, queryContext, mempty, mempty, mempty)
 
 -- | Whether the request is sent with `x-hasura-use-backend-only-permissions` set to `true`.
 data Scenario = Backend | Frontend deriving (Enum, Show, Eq)

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

@@ -318,7 +318,7 @@ actionInputArguments nonObjectTypeMap arguments = do
                     `onNothing` throw500 "object type for a field found in custom input object type"
                 (fieldName,) <$> argumentParser fieldName fieldDesc fieldType nonObjectFieldType
             pure $
-              P.object (P.Typename objectName) objectDesc $
+              P.object objectName objectDesc $
                 J.Object <$> inputFieldsToObject inputFieldsParsers
 
 mkArgumentInputFieldParser ::
@@ -358,9 +358,9 @@ customScalarParser = \case
         | _stdName == floatScalar -> J.toJSON <$> P.float
         | _stdName == stringScalar -> J.toJSON <$> P.string
         | _stdName == boolScalar -> J.toJSON <$> P.boolean
-        | otherwise -> P.jsonScalar (P.Typename _stdName) _stdDescription
+        | otherwise -> P.jsonScalar _stdName _stdDescription
   ASTReusedScalar name pgScalarType ->
-    let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition (P.Typename name) Nothing P.TIScalar
+    let schemaType = P.NonNullable $ P.TNamed $ P.mkDefinition name Nothing P.TIScalar
      in P.Parser
           { pType = schemaType,
             pParser =
@@ -385,4 +385,4 @@ customEnumParser (EnumTypeDefinition typeName description enumValues) =
                   valueName
                   (_evdDescription enumValue)
                   P.EnumValueInfo
-   in P.enum (P.Typename enumName) description enumValueDefinitions
+   in P.enum enumName description enumValueDefinitions

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

@@ -312,7 +312,7 @@ typeField =
           _ -> J.Null
    in applyPrinter
         <$> P.selectionSet
-          (P.Typename $$(G.litName "__Type"))
+          $$(G.litName "__Type")
           Nothing
           [ kind,
             name,
@@ -360,7 +360,7 @@ inputValue =
             _ -> J.Null
    in applyPrinter
         <$> P.selectionSet
-          (P.Typename $$(G.litName "__InputValue"))
+          $$(G.litName "__InputValue")
           Nothing
           [ name,
             description,
@@ -400,7 +400,7 @@ enumValue =
           $> const J.Null
    in applyPrinter
         <$> P.selectionSet
-          (P.Typename $$(G.litName "__EnumValue"))
+          $$(G.litName "__EnumValue")
           Nothing
           [ name,
             description,
@@ -426,7 +426,7 @@ typeKind ::
   Parser 'Both n ()
 typeKind =
   P.enum
-    (P.Typename $$(G.litName "__TypeKind"))
+    $$(G.litName "__TypeKind")
     Nothing
     ( NE.fromList
         [ mkDefinition $$(G.litName "ENUM"),
@@ -486,7 +486,7 @@ fieldField =
           $> const J.Null
    in applyPrinter
         <$> P.selectionSet
-          (P.Typename $$(G.litName "__Field"))
+          $$(G.litName "__Field")
           Nothing
           [ name,
             description,
@@ -533,7 +533,7 @@ directiveSet =
           $> const J.Null
    in applyPrinter
         <$> P.selectionSet
-          (P.Typename $$(G.litName "__Directive"))
+          $$(G.litName "__Directive")
           Nothing
           [ name,
             description,
@@ -605,7 +605,7 @@ schemaSet fakeSchema =
         return $ J.array $ map printer $ sDirectives fakeSchema
    in selectionSetToJSON . fmap (P.handleTypename nameAsJSON)
         <$> P.selectionSet
-          (P.Typename $$(G.litName "__Schema"))
+          $$(G.litName "__Schema")
           Nothing
           [ description,
             types,

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

@@ -15,7 +15,6 @@ import Hasura.GraphQL.Parser
   )
 import Hasura.GraphQL.Parser qualified as P
 import Hasura.GraphQL.Parser.Class
-import Hasura.GraphQL.Parser.Schema (Typename (..))
 import Hasura.GraphQL.Schema.Backend
 import Hasura.GraphQL.Schema.Common
 import Hasura.GraphQL.Schema.Table
@@ -176,7 +175,7 @@ orderByAggregation sourceName tableInfo selectPermissions = memoizeOn 'orderByAg
       InputFieldsParser n (Maybe [IR.OrderByItemG b (IR.AnnotatedAggregateOrderBy b)])
     parseOperator mkTypename operator tableGQLName columns =
       let opText = G.unName operator
-          objectName = mkTypename $ tableGQLName <> $$(G.litName "_") <> operator <> $$(G.litName "_order_by")
+          objectName = P.runMkTypename mkTypename $ tableGQLName <> $$(G.litName "_") <> operator <> $$(G.litName "_order_by")
           objectDesc = Just $ G.Description $ "order by " <> opText <> "() on columns of table " <>> tableName
        in P.fieldOptional operator Nothing (P.object objectName objectDesc columns)
             `mapField` map (\(col, info) -> mkOrderByItemG (IR.AAOOp opText col) info)
@@ -186,7 +185,7 @@ orderByOperator ::
   (BackendSchema b, MonadParse n) =>
   Parser 'Both n (Maybe (BasicOrderType b, NullsOrderType b))
 orderByOperator =
-  P.nullable $ P.enum (Typename $$(G.litName "order_by")) (Just "column ordering options") $ orderByOperators @b
+  P.nullable $ P.enum $$(G.litName "order_by") (Just "column ordering options") $ orderByOperators @b
 
 mkOrderByItemG :: forall b a. a -> (BasicOrderType b, NullsOrderType b) -> IR.OrderByItemG b a
 mkOrderByItemG column (orderType, nullsOrder) =

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

@@ -349,7 +349,7 @@ remoteFieldScalarParser customizeTypename (G.ScalarTypeDefinition description na
           _ -> pure (Altered False, QueryVariable <$> v)
     }
   where
-    customizedTypename = customizeTypename name
+    customizedTypename = runMkTypename customizeTypename name
     schemaType = NonNullable $ TNamed $ mkDefinition customizedTypename description TIScalar
     gType = toGraphQLType schemaType
 
@@ -368,7 +368,7 @@ remoteFieldEnumParser customizeTypename (G.EnumTypeDefinition desc name _directi
           ( mkDefinition (G.unEnumValue enumName) enumDesc P.EnumValueInfo,
             G.VEnum enumName
           )
-   in fmap (Altered False,) $ P.enum (customizeTypename name) desc $ NE.fromList enumValDefns
+   in fmap (Altered False,) $ P.enum (runMkTypename customizeTypename name) desc $ NE.fromList enumValDefns
 
 -- | remoteInputObjectParser returns an input parser for a given 'G.InputObjectTypeDefinition'
 --
@@ -897,7 +897,7 @@ remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do
   argsParser <- argumentsParser argsDefn sdoc
   customizeTypename <- asks getter
   customizeFieldName <- asks getter
-  let customizedFieldName = customizeFieldName parentTypeName fieldName
+  let customizedFieldName = runCustomizeRemoteFieldName customizeFieldName parentTypeName fieldName
   case typeDefn of
     G.TypeDefinitionObject objTypeDefn -> do
       remoteSchemaObjFields <- remoteSchemaObject sdoc objTypeDefn
@@ -975,15 +975,12 @@ customizeRemoteNamespace remoteSchemaInfo@RemoteSchemaInfo {..} rootTypeName fie
         -- In P.selectionSet we lose the resultCustomizer from __typename fields so we need to put it back
         let resultCustomizer = modifyFieldByName alias $ customizeTypeNameString $ _rscCustomizeTypeName rsCustomizer
          in RemoteFieldG remoteSchemaInfo resultCustomizer $ G.Field (Just alias) $$(G.litName "__typename") mempty mempty mempty
-    mkNamespaceTypename = Typename . const (remoteSchemaCustomizeTypeName rsCustomizer rootTypeName)
+    mkNamespaceTypename = MkTypename $ const $ runMkTypename (remoteSchemaCustomizeTypeName rsCustomizer) rootTypeName
 
 type MonadBuildRemoteSchema r m n = (MonadSchema n m, MonadError QErr m, MonadReader r m, Has MkTypename r, Has CustomizeRemoteFieldName r)
 
 runMonadBuildRemoteSchema :: Monad m => SchemaT n (ReaderT (MkTypename, CustomizeRemoteFieldName) m) a -> m a
-runMonadBuildRemoteSchema m = flip runReaderT (Typename, idFieldCustomizer) $ runSchemaT m
+runMonadBuildRemoteSchema m = flip runReaderT (mempty, mempty) $ runSchemaT m
-  where
-    idFieldCustomizer :: CustomizeRemoteFieldName
-    idFieldCustomizer = const id
 
 withRemoteSchemaCustomization ::
   forall m r a.
@@ -992,5 +989,5 @@ withRemoteSchemaCustomization ::
   m a ->
   m a
 withRemoteSchemaCustomization remoteSchemaCustomizer =
-  withTypenameCustomization (Typename . remoteSchemaCustomizeTypeName remoteSchemaCustomizer)
+  withTypenameCustomization (remoteSchemaCustomizeTypeName remoteSchemaCustomizer)
     . withRemoteFieldNameCustomization (remoteSchemaCustomizeFieldName remoteSchemaCustomizer)

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

@@ -504,7 +504,7 @@ tableConnectionSelectionSet sourceName tableInfo selectPermissions = memoizeOn '
               hasPreviousPageField
             ]
        in P.nonNullableParser $
-            P.selectionSet (P.Typename $$(G.litName "PageInfo")) Nothing allFields
+            P.selectionSet $$(G.litName "PageInfo") Nothing allFields
               <&> parsedSelectionsToFields IR.PageInfoTypename
 
     tableEdgesSelectionSet ::
@@ -1037,7 +1037,7 @@ tableAggregationFields sourceName tableInfo selectPermissions = memoizeOn 'table
       FieldParser n (IR.AggregateField b)
     parseAggOperator mkTypename operator tableGQLName columns =
       let opText = G.unName operator
-          setName = mkTypename $ tableGQLName <> $$(G.litName "_") <> operator <> $$(G.litName "_fields")
+          setName = P.runMkTypename mkTypename $ tableGQLName <> $$(G.litName "_") <> operator <> $$(G.litName "_fields")
           setDesc = Just $ G.Description $ "aggregate " <> opText <> " on columns"
           subselectionParser =
             P.selectionSet setName setDesc columns
@@ -1674,7 +1674,7 @@ nodePG = memoizeOn 'nodePG () do
       pure $ (source,sourceConfig,selectPermissions,tablePkeyColumns,) <$> annotatedFieldsParser
   pure $
     P.selectionSetInterface
-      (P.Typename $$(G.litName "Node"))
+      $$(G.litName "Node")
       (Just nodeInterfaceDescription)
       [idField]
       tables

server/src-lib/Hasura/RQL/Types/RemoteSchema.hs

@@ -55,12 +55,13 @@ import Data.Text.Extended
 import Data.Text.NonEmpty
 import Database.PG.Query qualified as Q
 import Hasura.Base.Error
-import Hasura.GraphQL.Parser.Schema (Variable)
+import Hasura.GraphQL.Parser.Schema
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Headers (HeaderConf (..))
 import Hasura.RQL.Types.Common
 import Hasura.RQL.Types.ResultCustomization
+import Hasura.RQL.Types.SourceCustomization
 import Hasura.Session
 import Language.GraphQL.Draft.Printer qualified as G
 import Language.GraphQL.Draft.Syntax qualified as G
@@ -191,12 +192,12 @@ instance Hashable RemoteSchemaCustomizer
 
 $(J.deriveJSON hasuraJSON ''RemoteSchemaCustomizer)
 
-remoteSchemaCustomizeTypeName :: RemoteSchemaCustomizer -> G.Name -> G.Name
+remoteSchemaCustomizeTypeName :: RemoteSchemaCustomizer -> MkTypename
-remoteSchemaCustomizeTypeName RemoteSchemaCustomizer {..} typeName =
+remoteSchemaCustomizeTypeName RemoteSchemaCustomizer {..} = MkTypename $ \typeName ->
   Map.lookupDefault typeName typeName _rscCustomizeTypeName
 
-remoteSchemaCustomizeFieldName :: RemoteSchemaCustomizer -> G.Name -> G.Name -> G.Name
+remoteSchemaCustomizeFieldName :: RemoteSchemaCustomizer -> CustomizeRemoteFieldName
-remoteSchemaCustomizeFieldName RemoteSchemaCustomizer {..} typeName fieldName =
+remoteSchemaCustomizeFieldName RemoteSchemaCustomizer {..} = CustomizeRemoteFieldName $ \typeName fieldName ->
   Map.lookup typeName _rscCustomizeFieldName >>= Map.lookup fieldName & fromMaybe fieldName
 
 hasTypeOrFieldCustomizations :: RemoteSchemaCustomizer -> Bool

server/src-lib/Hasura/RQL/Types/ResultCustomization.hs

@@ -18,59 +18,53 @@ import Language.GraphQL.Draft.Syntax qualified as G
 -- | Mapping that can be provided to a ResultCustomizer
 -- to map top-level field aliases that were not available at field parse time.
 -- E.g. for aliases created in the remote server query for remote joins.
-newtype AliasMapping = AliasMapping {unAliasMapping :: Endo G.Name}
+newtype AliasMapping = AliasMapping {unAliasMapping :: G.Name -> G.Name}
-  deriving (Semigroup, Monoid)
+  deriving (Semigroup, Monoid) via (Endo G.Name)
 
 -- | AliasMapping that maps a single field name to an alias
 singletonAliasMapping :: G.Name -> G.Name -> AliasMapping
-singletonAliasMapping fieldName alias = AliasMapping $
+singletonAliasMapping fieldName alias = AliasMapping $ \fieldName' ->
-  Endo $ \fieldName' ->
+  if fieldName == fieldName'
-    if fieldName == fieldName' then alias else fieldName'
+    then alias
+    else fieldName'
 
 -- | Function to modify JSON values returned from the remote server
 -- e.g. to map values of __typename fields to customized type names.
 -- The customizer uses Maybe to allow short-circuiting subtrees
 -- where no customizations are needed.
-newtype ResultCustomizer = ResultCustomizer {unResultCustomizer :: Maybe (AliasMapping -> Endo JO.Value)}
+newtype ResultCustomizer = ResultCustomizer {unResultCustomizer :: AliasMapping -> JO.Value -> JO.Value}
-  deriving (Semigroup, Monoid)
+  deriving (Semigroup, Monoid) via (AliasMapping -> Endo JO.Value)
 
 -- | Apply a ResultCustomizer to a JSON value
 applyResultCustomizer :: ResultCustomizer -> JO.Value -> JO.Value
-applyResultCustomizer = maybe id (appEndo . ($ mempty)) . unResultCustomizer
+applyResultCustomizer = ($ mempty) . unResultCustomizer
 
 -- | Apply an AliasMapping to a ResultCustomizer.
 applyAliasMapping :: AliasMapping -> ResultCustomizer -> ResultCustomizer
 applyAliasMapping aliasMapping (ResultCustomizer m) =
-  ResultCustomizer $
+  ResultCustomizer $ m . (<> aliasMapping)
-    m <&> \g aliasMapping' -> g $ aliasMapping' <> aliasMapping
 
 -- | Take a ResultCustomizer for a JSON subtree, and a fieldName,
 -- and produce a ResultCustomizer for a parent object or array of objects
 -- that applies the subtree customizer to the subtree at the given fieldName.
 modifyFieldByName :: G.Name -> ResultCustomizer -> ResultCustomizer
-modifyFieldByName fieldName (ResultCustomizer m) =
+modifyFieldByName fieldName ResultCustomizer {..} =
-  ResultCustomizer $
+  ResultCustomizer $ \AliasMapping {..} ->
-    m <&> \g aliasMapping ->
+    let applyCustomizer = unResultCustomizer mempty
-      Endo $
+        modifyFieldByName' = \case
-        let Endo f = g mempty -- AliasMapping is only applied to the top level so use mempty for nested customizers
+          JO.Object o -> JO.Object $ JO.adjust applyCustomizer (G.unName $ unAliasMapping fieldName) o
-            modifyFieldByName' = \case
+          JO.Array a -> JO.Array $ modifyFieldByName' <$> a
-              JO.Object o -> JO.Object $ JO.adjust f (G.unName $ (appEndo $ unAliasMapping aliasMapping) fieldName) o
+          v -> v
-              JO.Array a -> JO.Array $ modifyFieldByName' <$> a
+     in modifyFieldByName'
-              v -> v
-         in modifyFieldByName'
 
 -- | Create a RemoteResultCustomizer that applies the typeNameMap
 -- to a JSON string value, e.g. for use in customizing a __typename field value.
 customizeTypeNameString :: HashMap G.Name G.Name -> ResultCustomizer
+customizeTypeNameString typeNameMap | Map.null typeNameMap = mempty
 customizeTypeNameString typeNameMap =
-  if Map.null typeNameMap
+  ResultCustomizer $ \_aliasMapping -> \case
-    then mempty
+    JO.String t -> JO.String $ G.unName $ customizeTypeName $ G.unsafeMkName t
-    else ResultCustomizer $
+      where
-      Just $
+        customizeTypeName :: G.Name -> G.Name
-        const $
+        customizeTypeName typeName = Map.lookupDefault typeName typeName typeNameMap
-          Endo $ \case
+    v -> v
-            JO.String t -> JO.String $ G.unName $ customizeTypeName $ G.unsafeMkName t
-            v -> v
-  where
-    customizeTypeName :: G.Name -> G.Name
-    customizeTypeName typeName = Map.lookupDefault typeName typeName typeNameMap

server/src-lib/Hasura/RQL/Types/SourceCustomization.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Hasura.RQL.Types.SourceCustomization
-  ( SourceTypeCustomization,
+  ( MkTypename (..),
+    SourceTypeCustomization,
     RootFieldsCustomization (..),
     mkCustomizedTypename,
     emptySourceCustomization,
@@ -11,7 +12,7 @@ module Hasura.RQL.Types.SourceCustomization
     SourceCustomization (..),
     withSourceCustomization,
     MkRootFieldName,
-    CustomizeRemoteFieldName,
+    CustomizeRemoteFieldName (..),
     withRemoteFieldNameCustomization,
   )
 where
@@ -19,6 +20,7 @@ where
 import Control.Lens
 import Data.Aeson.Extended
 import Data.Has
+import Data.Monoid
 import Hasura.GraphQL.Parser.Schema
 import Hasura.Incremental.Internal.Dependency (Cacheable)
 import Hasura.Prelude
@@ -60,15 +62,15 @@ instance FromJSON SourceTypeCustomization where
 emptySourceTypeCustomization :: SourceTypeCustomization
 emptySourceTypeCustomization = SourceTypeCustomization Nothing Nothing
 
-mkCustomizedTypename :: Maybe SourceTypeCustomization -> G.Name -> Typename
+mkCustomizedTypename :: Maybe SourceTypeCustomization -> MkTypename
-mkCustomizedTypename Nothing = Typename
+mkCustomizedTypename Nothing = mempty
 mkCustomizedTypename (Just SourceTypeCustomization {..}) =
-  Typename . applyPrefixSuffix _stcPrefix _stcSuffix
+  MkTypename (applyPrefixSuffix _stcPrefix _stcSuffix)
 
-mkCustomizedFieldName :: Maybe RootFieldsCustomization -> G.Name -> G.Name
+mkCustomizedFieldName :: Maybe RootFieldsCustomization -> MkRootFieldName
-mkCustomizedFieldName Nothing = id
+mkCustomizedFieldName Nothing = mempty
 mkCustomizedFieldName (Just RootFieldsCustomization {..}) =
-  applyPrefixSuffix _rootfcPrefix _rootfcSuffix
+  MkRootFieldName (applyPrefixSuffix _rootfcPrefix _rootfcSuffix)
 
 applyPrefixSuffix :: Maybe G.Name -> Maybe G.Name -> G.Name -> G.Name
 applyPrefixSuffix Nothing Nothing name = name
@@ -100,7 +102,8 @@ getSourceTypeCustomization :: SourceCustomization -> SourceTypeCustomization
 getSourceTypeCustomization = fromMaybe emptySourceTypeCustomization . _scTypeNames
 
 -- | Function to apply root field name customizations.
-type MkRootFieldName = G.Name -> G.Name
+newtype MkRootFieldName = MkRootFieldName {runMkRootFieldName :: G.Name -> G.Name}
+  deriving (Semigroup, Monoid) via (Endo G.Name)
 
 -- | Inject a new root field name customization function into the environment.
 -- This can be used by schema-building code (with @MonadBuildSchema@ constraint) to ensure
@@ -111,7 +114,7 @@ withRootFieldNameCustomization = local . set hasLens
 -- | Apply the root field name customization function from the current environment.
 mkRootFieldName :: (MonadReader r m, Has MkRootFieldName r) => G.Name -> m G.Name
 mkRootFieldName name =
-  ($ name) <$> asks getter
+  ($ name) . runMkRootFieldName <$> asks getter
 
 -- | Inject typename and root field name customizations from @SourceCustomization@ into
 -- the environment.
@@ -125,7 +128,10 @@ withSourceCustomization SourceCustomization {..} =
   withTypenameCustomization (mkCustomizedTypename _scTypeNames)
     . withRootFieldNameCustomization (mkCustomizedFieldName _scRootFields)
 
-type CustomizeRemoteFieldName = G.Name -> G.Name -> G.Name
+newtype CustomizeRemoteFieldName = CustomizeRemoteFieldName
+  { runCustomizeRemoteFieldName :: G.Name -> G.Name -> G.Name
+  }
+  deriving (Semigroup, Monoid) via (G.Name -> Endo G.Name)
 
 withRemoteFieldNameCustomization :: forall m r a. (MonadReader r m, Has CustomizeRemoteFieldName r) => CustomizeRemoteFieldName -> m a -> m a
 withRemoteFieldNameCustomization = local . set hasLens