Refactor remote schema customization

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2771
GitOrigin-RevId: 0c90136f956df3f4552140e6ca3d2f4766f8b3f5

server/graphql-engine.cabal

@@ -816,7 +816,6 @@ test-suite graphql-engine-tests
     Hasura.GraphQL.NamespaceSpec
     Hasura.GraphQL.Parser.DirectivesTest
     Hasura.GraphQL.Parser.TestUtils
-    Hasura.GraphQL.RemoteServerSpec
     Hasura.GraphQL.Schema.RemoteTest
     Hasura.IncrementalSpec
     Hasura.RQL.IR.Generator

server/src-lib/Hasura/GraphQL/Execute/Mutation.hs

@@ -128,7 +128,7 @@ convertMutationSelectionSet
               pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins
         RFRemote remoteField -> do
           RemoteFieldG remoteSchemaInfo resultCustomizer resolvedRemoteField <- runVariableCache $ resolveRemoteField userInfo remoteField
-          pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation $ getRemoteFieldSelectionSet resolvedRemoteField
+          pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation [G.SelectionField resolvedRemoteField]
         RFAction action -> do
           let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionMutation action
           (actionName, _fch) <- pure $ case noRelsDBAST of

server/src-lib/Hasura/GraphQL/Execute/Query.hs

@@ -114,7 +114,7 @@ convertQuerySelSet
               pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins
         RFRemote rf -> do
           RemoteFieldG remoteSchemaInfo resultCustomizer remoteField <- runVariableCache $ for rf $ resolveRemoteVariable userInfo
-          pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeQuery $ getRemoteFieldSelectionSet remoteField
+          pure $ buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeQuery [G.SelectionField remoteField]
         RFAction action -> do
           let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionQuery action
           (actionExecution, actionName, fch) <- pure $ case noRelsDBAST of

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

@@ -212,10 +212,10 @@ resolveRemoteVariable userInfo = \case
 
 -- | TODO: Documentation.
 resolveRemoteField ::
-  (MonadError QErr m, Traversable f) =>
+  (MonadError QErr m) =>
   UserInfo ->
-  RemoteFieldG f RemoteSchemaVariable ->
+  RemoteFieldG RemoteSchemaVariable ->
-  StateT RemoteJSONVariableMap m (RemoteFieldG f Variable)
+  StateT RemoteJSONVariableMap m (RemoteFieldG Variable)
 resolveRemoteField userInfo = traverse (resolveRemoteVariable userInfo)
 
 -- | TODO: Documentation.

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

@@ -8,12 +8,15 @@ module Hasura.GraphQL.Namespace
     NamespacedFieldMap,
     flattenNamespaces,
     unflattenNamespaces,
+    customizeNamespace,
   )
 where
 
 import Data.Aeson qualified as J
 import Data.HashMap.Strict.InsOrd qualified as OMap
 import Data.Text.Extended
+import Hasura.GraphQL.Parser
+import Hasura.GraphQL.Parser qualified as P
 import Hasura.Prelude
 import Language.GraphQL.Draft.Syntax qualified as G
 
@@ -76,3 +79,25 @@ unflattenNamespaces = OMap.foldlWithKey' insert mempty
       Just ns -> OMap.insertWith merge ns (Namespaced $ (OMap.singleton _rfaAlias v)) m
     merge (Namespaced m) (Namespaced m') = Namespaced (OMap.union m' m) -- Note: order of arguments to OMap.union to preserve ordering
     merge v _ = v
+
+-- | Wrap the field parser results in @NamespacedField@
+customizeNamespace ::
+  forall n a.
+  (MonadParse n) =>
+  Maybe G.Name ->
+  (G.Name -> P.ParsedSelection a -> a) ->
+  P.MkTypename ->
+  [FieldParser n a] ->
+  [FieldParser n (NamespacedField a)]
+customizeNamespace (Just namespace) fromParsedSelection mkNamespaceTypename fieldParsers =
+  -- Source or remote schema has a namespace field so wrap the parsers
+  -- in a new namespace field parser.
+  [P.subselection_ namespace Nothing parser]
+  where
+    parser :: Parser 'Output n (NamespacedField a)
+    parser =
+      Namespaced . OMap.mapWithKey fromParsedSelection
+        <$> P.selectionSet (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/RemoteServer.hs

@@ -24,10 +24,8 @@ import Data.HashSet qualified as Set
 import Data.List.Extended (duplicates)
 import Data.Text qualified as T
 import Data.Text.Extended (dquoteList, (<<>))
-import Data.Tuple (swap)
 import Hasura.Base.Error
 import Hasura.GraphQL.Parser.Collect ()
-import Hasura.GraphQL.Parser.Monad qualified as P
 -- Needed for GHCi and HLS due to TH in cyclically dependent modules (see https://gitlab.haskell.org/ghc/ghc/-/issues/1012)
 import Hasura.GraphQL.Schema.Remote (buildRemoteParser)
 import Hasura.GraphQL.Transport.HTTP.Protocol
@@ -165,8 +163,7 @@ fetchRemoteSchema env manager _rscName rsDef@ValidatedRemoteSchemaDef {..} = do
 
   let _rscInfo = RemoteSchemaInfo {..}
   -- Check that the parsed GraphQL type info is valid by running the schema generation
-  (piQuery, piMutation, piSubscription) <-
+  _rscParsed <- buildRemoteParser _rscIntroOriginal _rscInfo
-    P.runSchemaT @m @(P.ParseT Identity) $ buildRemoteParser _rscIntroOriginal _rscInfo
 
   -- The 'rawIntrospectionResult' contains the 'Bytestring' response of
   -- the introspection result of the remote server. We store this in the
@@ -175,7 +172,6 @@ fetchRemoteSchema env manager _rscName rsDef@ValidatedRemoteSchemaDef {..} = do
   return
     RemoteSchemaCtx
       { _rscPermissions = mempty,
-        _rscParsed = ParsedIntrospection {..},
         ..
       }
   where
@@ -458,7 +454,7 @@ execRemoteGQ env manager userInfo reqHdrs rsdef gqlReq@GQLReq {..} = do
     userInfoToHdrs = sessionVariablesToHeaders $ _uiSession userInfo
 
 identityCustomizer :: RemoteSchemaCustomizer
-identityCustomizer = RemoteSchemaCustomizer Nothing mempty mempty mempty mempty
+identityCustomizer = RemoteSchemaCustomizer Nothing mempty mempty
 
 typeDefinitionName :: G.TypeDefinition a b -> G.Name
 typeDefinitionName = \case
@@ -473,8 +469,6 @@ getCustomizer :: IntrospectionResult -> Maybe RemoteSchemaCustomization -> Remot
 getCustomizer _ Nothing = identityCustomizer
 getCustomizer IntrospectionResult {..} (Just RemoteSchemaCustomization {..}) = RemoteSchemaCustomizer {..}
   where
-    mapMap f = Map.fromList . map f . Map.toList
-    invertMap = mapMap swap -- key collisions are checked for later in validateSchemaCustomizations
     rootTypeNames =
       if isNothing _rscRootFieldsNamespace
         then catMaybes [Just irQueryRoot, irMutationRoot, irSubscriptionRoot]
@@ -518,14 +512,9 @@ getCustomizer IntrospectionResult {..} (Just RemoteSchemaCustomization {..}) = R
           let customizationMap = Map.fromList $ map (\rfc -> (_rfcParentType rfc, rfc)) fieldNameCustomizations
            in Map.intersectionWith mkFieldRenameMap customizationMap typeFieldMap
 
-    mapLookup :: (Eq a, Hashable a) => HashMap a a -> a -> a
-    mapLookup m a = fromMaybe a $ Map.lookup a m
-
     _rscNamespaceFieldName = _rscRootFieldsNamespace
     _rscCustomizeTypeName = typeRenameMap
     _rscCustomizeFieldName = fieldRenameMap
-    _rscDecustomizeTypeName = invertMap typeRenameMap
-    _rscDecustomizeFieldName = mapMap (mapLookup typeRenameMap *** invertMap) fieldRenameMap
 
 throwRemoteSchema ::
   QErrM m =>

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

@@ -153,24 +153,8 @@ customizeFields ::
   P.MkTypename ->
   f [FieldParser n (RootField db remote action JO.Value)] ->
   f [FieldParser n (NamespacedField (RootField db remote action JO.Value))]
-customizeFields sourceCustomization =
+customizeFields SourceCustomization {..} =
-  fmap . customizeNamespace sourceCustomization
+  fmap . customizeNamespace (_rootfcNamespace =<< _scRootFields) (const typenameToRawRF)
-
-customizeNamespace ::
-  forall n db remote action.
-  (MonadParse n) =>
-  SourceCustomization ->
-  P.MkTypename ->
-  [FieldParser n (RootField db remote action JO.Value)] ->
-  [FieldParser n (NamespacedField (RootField db remote action JO.Value))]
-customizeNamespace SourceCustomization {_scRootFields = Just RootFieldsCustomization {_rootfcNamespace = Just namespace}} mkNamespaceTypename fieldParsers =
-  [P.subselection_ namespace Nothing parser]
-  where
-    parser :: Parser 'Output n (NamespacedField (RootField db remote action JO.Value))
-    parser =
-      Namespaced . fmap typenameToRawRF
-        <$> P.selectionSet (mkNamespaceTypename namespace) Nothing fieldParsers
-customizeNamespace _ _ fieldParsers = fmap NotNamespaced <$> fieldParsers
 
 buildRoleContext ::
   forall m.
@@ -236,12 +220,12 @@ buildRoleContext
     where
       getQueryRemotes ::
         [ParsedIntrospection] ->
-        [P.FieldParser (P.ParseT Identity) RemoteField]
+        [P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)]
       getQueryRemotes = concatMap piQuery
 
       getMutationRemotes ::
         [ParsedIntrospection] ->
-        [P.FieldParser (P.ParseT Identity) RemoteField]
+        [P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)]
       getMutationRemotes = concatMap (concat . piMutation)
 
       buildSource ::
@@ -422,14 +406,14 @@ unauthenticatedContext ::
     MonadIO m,
     MonadUnique m
   ) =>
-  [P.FieldParser (P.ParseT Identity) RemoteField] ->
+  [P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)] ->
-  [P.FieldParser (P.ParseT Identity) RemoteField] ->
+  [P.FieldParser (P.ParseT Identity) (NamespacedField RemoteField)] ->
   RemoteSchemaPermsCtx ->
   m GQLContext
 unauthenticatedContext adminQueryRemotes adminMutationRemotes remoteSchemaPermsCtx = P.runSchemaT $ do
   let isRemoteSchemaPermsEnabled = remoteSchemaPermsCtx == RemoteSchemaPermsEnabled
-      queryFields = bool (fmap (fmap $ NotNamespaced . RFRemote) adminQueryRemotes) [] isRemoteSchemaPermsEnabled
+      queryFields = bool (fmap (fmap $ fmap RFRemote) adminQueryRemotes) [] isRemoteSchemaPermsEnabled
-      mutationFields = bool (fmap (fmap $ NotNamespaced . RFRemote) adminMutationRemotes) [] isRemoteSchemaPermsEnabled
+      mutationFields = bool (fmap (fmap $ fmap RFRemote) adminMutationRemotes) [] isRemoteSchemaPermsEnabled
   mutationParser <-
     whenMaybe (not $ null mutationFields) $
       P.safeSelectionSet mutationRoot (Just $ G.Description "mutation root") mutationFields
@@ -452,9 +436,7 @@ buildRoleBasedRemoteSchemaParser roleName remoteSchemaCache = do
     for remoteSchemaIntroInfos $ \RemoteSchemaCtx {..} ->
       for (Map.lookup roleName _rscPermissions) $ \introspectRes -> do
         let customizer = rsCustomizer _rscInfo
-        (queryParsers, mutationParsers, subscriptionParsers) <-
+        parsedIntrospection <- buildRemoteParser introspectRes _rscInfo
-          P.runSchemaT @m @(P.ParseT Identity) $ buildRemoteParser introspectRes _rscInfo
-        let parsedIntrospection = ParsedIntrospection queryParsers mutationParsers subscriptionParsers
         return (_rscName, RemoteRelationshipQueryContext introspectRes parsedIntrospection customizer)
   return $ catMaybes remoteSchemaPerms
 
@@ -629,10 +611,11 @@ buildQueryParser ::
     MonadRole r m,
     Has QueryContext r,
     Has P.MkTypename r,
-    Has MkRootFieldName r
+    Has MkRootFieldName r,
+    Has CustomizeRemoteFieldName r
   ) =>
   [P.FieldParser n (NamespacedField (QueryRootField UnpreparedValue))] ->
-  [P.FieldParser n RemoteField] ->
+  [P.FieldParser n (NamespacedField RemoteField)] ->
   [ActionInfo] ->
   NonObjectTypeMap ->
   Maybe (Parser 'Output n (RootFieldMap (MutationRootField UnpreparedValue))) ->
@@ -640,7 +623,7 @@ buildQueryParser ::
   m (Parser 'Output n (RootFieldMap (QueryRootField UnpreparedValue)))
 buildQueryParser pgQueryFields remoteFields allActions nonObjectCustomTypes mutationParser subscriptionParser = do
   actionQueryFields <- concat <$> traverse (buildActionQueryFields nonObjectCustomTypes) allActions
-  let allQueryFields = pgQueryFields <> fmap (fmap NotNamespaced) (actionQueryFields <> map (fmap RFRemote) remoteFields)
+  let allQueryFields = pgQueryFields <> fmap (fmap NotNamespaced) actionQueryFields <> fmap (fmap $ fmap RFRemote) remoteFields
   queryWithIntrospectionHelper allQueryFields mutationParser subscriptionParser
 
 queryWithIntrospectionHelper ::
@@ -730,7 +713,8 @@ buildSubscriptionParser ::
     MonadRole r m,
     Has QueryContext r,
     Has P.MkTypename r,
-    Has MkRootFieldName r
+    Has MkRootFieldName r,
+    Has CustomizeRemoteFieldName r
   ) =>
   [P.FieldParser n (NamespacedField (QueryRootField UnpreparedValue))] ->
   [ActionInfo] ->
@@ -749,9 +733,10 @@ buildMutationParser ::
     MonadRole r m,
     Has QueryContext r,
     Has P.MkTypename r,
-    Has MkRootFieldName r
+    Has MkRootFieldName r,
+    Has CustomizeRemoteFieldName r
   ) =>
-  [P.FieldParser n RemoteField] ->
+  [P.FieldParser n (NamespacedField RemoteField)] ->
   [ActionInfo] ->
   NonObjectTypeMap ->
   [P.FieldParser n (NamespacedField (MutationRootField UnpreparedValue))] ->
@@ -761,7 +746,7 @@ buildMutationParser allRemotes allActions nonObjectCustomTypes mutationFields =
   let mutationFieldsParser =
         mutationFields
           <> (fmap NotNamespaced <$> actionParsers)
-          <> (fmap (NotNamespaced . RFRemote) <$> allRemotes)
+          <> (fmap (fmap RFRemote) <$> allRemotes)
   whenMaybe (not $ null mutationFieldsParser) $
     P.safeSelectionSet mutationRoot (Just $ G.Description "mutation root") mutationFieldsParser
       <&> fmap (flattenNamespaces . fmap typenameToNamespacedRawRF)
@@ -820,7 +805,8 @@ type ConcreteSchemaT m a =
           SourceCache,
           QueryContext,
           P.MkTypename,
-          MkRootFieldName
+          MkRootFieldName,
+          CustomizeRemoteFieldName
         )
         m
     )
@@ -835,7 +821,7 @@ runMonadSchema ::
   ConcreteSchemaT m a ->
   m a
 runMonadSchema roleName queryContext pgSources m =
-  flip runReaderT (roleName, pgSources, queryContext, P.Typename, id) $ P.runSchemaT m
+  P.runSchemaT m `runReaderT` (roleName, pgSources, queryContext, P.Typename, id, const id)
 
 -- | 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/Backend.hs

@@ -64,7 +64,8 @@ type MonadBuildSchema b r m n =
     MonadRole r m,
     Has QueryContext r,
     Has MkTypename r,
-    Has MkRootFieldName r
+    Has MkRootFieldName r,
+    Has CustomizeRemoteFieldName r
   )
 
 -- | This type class is responsible for generating the schema of a backend.

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

@@ -4,49 +4,67 @@
 module Hasura.GraphQL.Schema.Remote
   ( buildRemoteParser,
     remoteField,
-    customizeFieldParser,
+    makeResultCustomizer,
+    withRemoteSchemaCustomization,
   )
 where
 
-import Control.Lens.Extended
+import Control.Monad.Unique
-  ( Lens',
+import Data.Has
-    set,
-    use,
-    (%=),
-    (^.),
-    _1,
-    _2,
-    _3,
-    _4,
-  )
-import Control.Monad.State.Lazy qualified as Lazy
 import Data.HashMap.Strict qualified as Map
 import Data.HashMap.Strict.InsOrd qualified as OMap
 import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
 import Data.List.NonEmpty qualified as NE
 import Data.Monoid (Any (..))
-import Data.Parser.JSONPath
-import Data.Text qualified as T
 import Data.Text.Extended
 import Data.Type.Equality
 import Hasura.Base.Error
+import Hasura.GraphQL.Namespace
 import Hasura.GraphQL.Parser as P
 import Hasura.GraphQL.Parser.Internal.Parser qualified as P
 import Hasura.GraphQL.Parser.Internal.TypeChecking qualified as P
 import Hasura.Prelude
-import Hasura.RQL.Types.Common (stringScalar)
 import Hasura.RQL.Types.RemoteSchema
 import Hasura.RQL.Types.ResultCustomization
-import Hasura.RQL.Types.SchemaCache (IntrospectionResult (IntrospectionResult, irMutationRoot, irQueryRoot, irSubscriptionRoot))
+import Hasura.RQL.Types.SchemaCache (IntrospectionResult (IntrospectionResult, irMutationRoot, irQueryRoot, irSubscriptionRoot), ParsedIntrospectionG (..))
+import Hasura.RQL.Types.SourceCustomization
 import Language.GraphQL.Draft.Syntax qualified as G
 
 --------------------------------------------------------------------------------
 -- Top level function
 
--- TODO return ParsedIntrospection ?
 buildRemoteParser ::
   forall m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  (MonadIO m, MonadUnique m, MonadError QErr m, MonadParse n) =>
+  IntrospectionResult ->
+  RemoteSchemaInfo ->
+  m (ParsedIntrospectionG n)
+buildRemoteParser introspectionResult remoteSchemaInfo@RemoteSchemaInfo {..} = do
+  (rawQueryParsers, rawMutationParsers, rawSubscriptionParsers) <-
+    runMonadBuildRemoteSchema $
+      withRemoteSchemaCustomization rsCustomizer $
+        buildRawRemoteParser introspectionResult remoteSchemaInfo
+  pure $
+    ParsedIntrospection
+      (customizeRemoteNamespace remoteSchemaInfo (irQueryRoot introspectionResult) rawQueryParsers)
+      (customizeRemoteNamespace remoteSchemaInfo <$> irMutationRoot introspectionResult <*> rawMutationParsers)
+      (customizeRemoteNamespace remoteSchemaInfo <$> irSubscriptionRoot introspectionResult <*> rawSubscriptionParsers)
+
+makeResultCustomizer :: RemoteSchemaCustomizer -> G.Field G.NoFragments a -> ResultCustomizer
+makeResultCustomizer remoteSchemaCustomizer G.Field {..} =
+  modifyFieldByName (fromMaybe _fName _fAlias) $
+    if _fName == $$(G.litName "__typename")
+      then customizeTypeNameString (_rscCustomizeTypeName remoteSchemaCustomizer)
+      else foldMap resultCustomizerFromSelection _fSelectionSet
+  where
+    resultCustomizerFromSelection :: G.Selection G.NoFragments a -> ResultCustomizer
+    resultCustomizerFromSelection = \case
+      G.SelectionField fld -> makeResultCustomizer remoteSchemaCustomizer fld
+      G.SelectionInlineFragment G.InlineFragment {..} -> foldMap resultCustomizerFromSelection _ifSelectionSet
+
+buildRawRemoteParser ::
+  forall r m n.
+  MonadBuildRemoteSchema r m n =>
   IntrospectionResult ->
   RemoteSchemaInfo ->
   -- | parsers for, respectively: queries, mutations, and subscriptions
@@ -55,45 +73,27 @@ buildRemoteParser ::
       Maybe [P.FieldParser n RemoteField],
       Maybe [P.FieldParser n RemoteField]
     )
-buildRemoteParser introspectionResult remoteSchemaInfo = do
+buildRawRemoteParser (IntrospectionResult sdoc queryRoot mutationRoot subscriptionRoot) info = do
-  (rawQueryParsers, rawMutationParsers, rawSubscriptionParsers) <- buildRawRemoteParser introspectionResult remoteSchemaInfo
-  pure $
-    evalMemoState $ do
-      queryParsers <- customizeFieldParsers remoteSchemaInfo (irQueryRoot introspectionResult) rawQueryParsers
-      mutationParsers <- sequence $ customizeFieldParsers remoteSchemaInfo <$> irMutationRoot introspectionResult <*> rawMutationParsers
-      subscriptionParsers <- sequence $ customizeFieldParsers remoteSchemaInfo <$> irSubscriptionRoot introspectionResult <*> rawSubscriptionParsers
-      pure (queryParsers, mutationParsers, subscriptionParsers)
-
-buildRawRemoteParser ::
-  forall m n.
-  (MonadSchema n m, MonadError QErr m) =>
-  IntrospectionResult ->
-  RemoteSchemaInfo ->
-  -- | parsers for, respectively: queries, mutations, and subscriptions
-  m
-    ( [P.FieldParser n RawRemoteField],
-      Maybe [P.FieldParser n RawRemoteField],
-      Maybe [P.FieldParser n RawRemoteField]
-    )
-buildRawRemoteParser (IntrospectionResult sdoc queryRoot mutationRoot subscriptionRoot) info@RemoteSchemaInfo {..} = do
   queryT <- makeParsers queryRoot
   mutationT <- makeNonQueryRootFieldParser mutationRoot $$(G.litName "Mutation")
   subscriptionT <- makeNonQueryRootFieldParser subscriptionRoot $$(G.litName "Subscription")
   return (queryT, mutationT, subscriptionT)
   where
-    makeFieldParser :: G.FieldDefinition RemoteSchemaInputValueDefinition -> m (P.FieldParser n RawRemoteField)
+    makeFieldParser :: G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> m (P.FieldParser n RemoteField)
-    makeFieldParser fieldDef = do
+    makeFieldParser rootTypeName fieldDef =
-      fldParser <- remoteFieldFromDefinition sdoc fieldDef
+      fmap makeRemoteField <$> remoteFieldFromDefinition sdoc rootTypeName fieldDef
-      pure $ RemoteFieldG info mempty <$> fldParser
 
-    makeParsers :: G.Name -> m [P.FieldParser n RawRemoteField]
+    makeRemoteField :: G.Field G.NoFragments RemoteSchemaVariable -> RemoteField
+    makeRemoteField fld = RemoteFieldG info (makeResultCustomizer (rsCustomizer info) fld) fld
+
+    makeParsers :: G.Name -> m [P.FieldParser n RemoteField]
     makeParsers rootName =
       case lookupType sdoc rootName of
         Just (G.TypeDefinitionObject o) ->
-          traverse makeFieldParser $ G._otdFieldsDefinition o
+          traverse (makeFieldParser rootName) $ G._otdFieldsDefinition o
         _ -> throw400 Unexpected $ rootName <<> " has to be an object type"
 
-    makeNonQueryRootFieldParser :: Maybe G.Name -> G.Name -> m (Maybe [P.FieldParser n RawRemoteField])
+    makeNonQueryRootFieldParser :: Maybe G.Name -> G.Name -> m (Maybe [P.FieldParser n RemoteField])
     makeNonQueryRootFieldParser userProvidedRootName defaultRootName =
       case userProvidedRootName of
         Just _rootName -> traverse makeParsers userProvidedRootName
@@ -234,8 +234,8 @@ newtype Altered = Altered {getAltered :: Bool}
 -- presets. Presets might force the evaluation of variables that would otherwise be transmitted
 -- unmodified.
 inputValueDefinitionParser ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.InputValueDefinition ->
   m (InputFieldsParser n (Maybe (Altered, G.Value RemoteSchemaVariable)))
@@ -276,12 +276,13 @@ inputValueDefinitionParser schemaDoc (G.InputValueDefinition desc name fieldType
       G.TypeNamed nullability typeName ->
         case lookupType schemaDoc typeName of
           Nothing -> throw400 RemoteSchemaError $ "Could not find type with name " <>> typeName
-          Just typeDef ->
+          Just typeDef -> do
+            customizeTypename <- asks getter
             case typeDef of
               G.TypeDefinitionScalar scalarTypeDefn ->
-                pure $ mkInputFieldsParser $ doNullability nullability $ Just <$> remoteFieldScalarParser scalarTypeDefn
+                pure $ mkInputFieldsParser $ doNullability nullability $ Just <$> remoteFieldScalarParser customizeTypename scalarTypeDefn
               G.TypeDefinitionEnum defn ->
-                pure $ mkInputFieldsParser $ doNullability nullability $ Just <$> remoteFieldEnumParser defn
+                pure $ mkInputFieldsParser $ doNullability nullability $ Just <$> remoteFieldEnumParser customizeTypename defn
               G.TypeDefinitionObject _ ->
                 throw400 RemoteSchemaError "expected input type, but got output type"
               G.TypeDefinitionInputObject defn -> do
@@ -327,35 +328,47 @@ inputValueDefinitionParser schemaDoc (G.InputValueDefinition desc name fieldType
 -- were a query variable of its own. To avoid ending up with one such variable per scalar in the
 -- query, we also track alterations, to apply optimizations.
 -- See Note [Variable expansion in remote schema input parsers] for more information.
+--
+-- If the value contains a variable with a customized type name then we need to consider it to be
+-- altered to ensure that the original type name is passed to the remote server.
 remoteFieldScalarParser ::
   MonadParse n =>
+  MkTypename ->
   G.ScalarTypeDefinition ->
   P.Parser 'Both n (Altered, G.Value RemoteSchemaVariable)
-remoteFieldScalarParser (G.ScalarTypeDefinition description name _directives) =
+remoteFieldScalarParser customizeTypename (G.ScalarTypeDefinition description name _directives) =
   P.Parser
     { pType = schemaType,
-      pParser = \inputValue ->
+      pParser = \case
-        (Altered False,) <$> case inputValue of
+        JSONValue v ->
-          JSONValue v -> pure $ G.VVariable $ RemoteJSONValue gType v
+          pure $ (Altered $ G.getBaseType gType /= name, G.VVariable $ RemoteJSONValue (mkRemoteGType gType) v)
-          GraphQLValue v -> for v \var -> do
+        GraphQLValue v -> case v of
+          G.VVariable var -> do
             P.typeCheck False gType var
-            pure $ QueryVariable var
+            pure $ (Altered $ G.getBaseType (vType var) /= name, G.VVariable $ QueryVariable var {vType = mkRemoteGType (vType var)})
+          _ -> pure (Altered False, QueryVariable <$> v)
     }
   where
-    schemaType = NonNullable $ TNamed $ mkDefinition (Typename name) description TIScalar
+    customizedTypename = customizeTypename name
+    schemaType = NonNullable $ TNamed $ mkDefinition customizedTypename description TIScalar
     gType = toGraphQLType schemaType
 
+    mkRemoteGType = \case
+      G.TypeNamed n _ -> G.TypeNamed n name
+      G.TypeList n l -> G.TypeList n $ mkRemoteGType l
+
 remoteFieldEnumParser ::
   MonadParse n =>
+  MkTypename ->
   G.EnumTypeDefinition ->
   Parser 'Both n (Altered, G.Value RemoteSchemaVariable)
-remoteFieldEnumParser (G.EnumTypeDefinition desc name _directives valueDefns) =
+remoteFieldEnumParser customizeTypename (G.EnumTypeDefinition desc name _directives valueDefns) =
   let enumValDefns =
         valueDefns <&> \(G.EnumValueDefinition enumDesc enumName _) ->
           ( mkDefinition (G.unEnumValue enumName) enumDesc P.EnumValueInfo,
             G.VEnum enumName
           )
-   in fmap (Altered False,) $ P.enum (Typename name) desc $ NE.fromList enumValDefns
+   in fmap (Altered False,) $ P.enum (customizeTypename name) desc $ NE.fromList enumValDefns
 
 -- | remoteInputObjectParser returns an input parser for a given 'G.InputObjectTypeDefinition'
 --
@@ -380,8 +393,8 @@ remoteFieldEnumParser (G.EnumTypeDefinition desc name _directives valueDefns) =
 -- field: if yes, we memoize that branch and proceed as normal. Otherwise we can omit the
 -- memoization: we know for sure that the preset fields won't generate a recursive call!
 remoteInputObjectParser ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.InputObjectTypeDefinition RemoteSchemaInputValueDefinition ->
   m
@@ -401,8 +414,9 @@ remoteInputObjectParser schemaDoc defn@(G.InputObjectTypeDefinition desc name _
     -- the same parser.
 
       Right <$> P.memoizeOn 'remoteInputObjectParser defn do
+        typename <- mkTypename name
         argsParser <- argumentsParser valueDefns schemaDoc
-        pure $ fmap G.VObject <$> P.object (Typename name) desc argsParser
+        pure $ fmap G.VObject <$> P.object typename desc argsParser
 
 -- | Variable expansion optimization.
 -- Since each parser returns a value that indicates whether it was altered, we can detect when no
@@ -474,8 +488,8 @@ shortCircuitIfUnaltered parser =
 -- part of the tree was altered during parsing; if any of the fields is preset, or recursively
 -- contains values that contain presets further down, then this result is labelled as altered.
 argumentsParser ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
   RemoteSchemaIntrospection ->
   m (InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)))
@@ -515,20 +529,21 @@ aggregateListAndAlteration = first mconcat . unzip . catMaybes
 
 -- | 'remoteSchemaObject' returns a output parser for a given 'ObjectTypeDefinition'.
 remoteSchemaObject ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.ObjectTypeDefinition RemoteSchemaInputValueDefinition ->
   m (Parser 'Output n [G.Field G.NoFragments RemoteSchemaVariable])
 remoteSchemaObject schemaDoc defn@(G.ObjectTypeDefinition description name interfaces _directives subFields) =
   P.memoizeOn 'remoteSchemaObject defn do
-    subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc) subFields
+    subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc name) subFields
     interfaceDefs <- traverse getInterface interfaces
     implements <- traverse (remoteSchemaInterface schemaDoc) interfaceDefs
     -- TODO: also check sub-interfaces, when these are supported in a future graphql spec
     traverse_ validateImplementsFields interfaceDefs
+    typename <- mkTypename name
     pure $
-      P.selectionSetObject (Typename name) description subFieldParsers implements
+      P.selectionSetObject typename description subFieldParsers implements
         <&> toList
           . OMap.mapWithKey
             ( \alias -> handleTypename $ \_ ->
@@ -694,14 +709,14 @@ constructed query.
 -- | 'remoteSchemaInterface' returns a output parser for a given 'InterfaceTypeDefinition'.
 --   Also check Note [Querying remote schema interfaces]
 remoteSchemaInterface ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition ->
   m (Parser 'Output n (G.SelectionSet G.NoFragments RemoteSchemaVariable))
 remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name _directives fields possibleTypes) =
   P.memoizeOn 'remoteSchemaObject defn do
-    subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc) fields
+    subFieldParsers <- traverse (remoteFieldFromDefinition schemaDoc name) fields
     objs <- traverse (getObjectParser schemaDoc getObject) possibleTypes
     -- In the Draft GraphQL spec (> June 2018), interfaces can themselves
     -- implement superinterfaces.  In the future, we may need to support this
@@ -712,7 +727,8 @@ remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name
     -- types in the schema document that claim to implement this interface.  We
     -- should have a check that expresses that that collection of objects is equal
     -- to 'possibleTypes'.
-    pure $ P.selectionSetInterface (Typename name) description subFieldParsers objs <&> constructInterfaceSelectionSet
+    typename <- mkTypename name
+    pure $ P.selectionSetInterface typename description subFieldParsers objs <&> constructInterfaceSelectionSet
   where
     getObject :: G.Name -> m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
     getObject objectName =
@@ -767,8 +783,8 @@ remoteSchemaInterface schemaDoc defn@(G.InterfaceTypeDefinition description name
 
 -- | 'remoteSchemaUnion' returns a output parser for a given 'UnionTypeDefinition'.
 remoteSchemaUnion ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.UnionTypeDefinition ->
   m (Parser 'Output n (G.SelectionSet G.NoFragments RemoteSchemaVariable))
@@ -777,8 +793,9 @@ remoteSchemaUnion schemaDoc defn@(G.UnionTypeDefinition description name _direct
     objs <- traverse (getObjectParser schemaDoc getObject) objectNames
     when (null objs) $
       throw400 RemoteSchemaError $ "List of member types cannot be empty for union type " <> squote name
+    typename <- mkTypename name
     pure $
-      P.selectionSetUnion (Typename name) description objs
+      P.selectionSetUnion typename description objs
         <&> ( \objNameAndFields ->
                 catMaybes $
                   objNameAndFields <&> \(objName, fields) ->
@@ -816,17 +833,18 @@ remoteSchemaUnion schemaDoc defn@(G.UnionTypeDefinition description name _direct
                 <> squote objectName
 
 remoteFieldFromDefinition ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
+  G.Name ->
   G.FieldDefinition RemoteSchemaInputValueDefinition ->
   m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
-remoteFieldFromDefinition schemaDoc (G.FieldDefinition description name argsDefinition gType _) =
+remoteFieldFromDefinition schemaDoc parentTypeName (G.FieldDefinition description name argsDefinition gType _) = do
-  let addNullableList :: FieldParser n (G.Field G.NoFragments RemoteSchemaVariable) -> FieldParser n (G.Field G.NoFragments RemoteSchemaVariable)
+  let addNullableList :: FieldParser n a -> FieldParser n a
       addNullableList (P.FieldParser (Definition name' un desc (FieldInfo args typ)) parser) =
         P.FieldParser (Definition name' un desc (FieldInfo args (Nullable (TList typ)))) parser
 
-      addNonNullableList :: FieldParser n (G.Field G.NoFragments RemoteSchemaVariable) -> FieldParser n (G.Field G.NoFragments RemoteSchemaVariable)
+      addNonNullableList :: FieldParser n a -> FieldParser n a
       addNonNullableList (P.FieldParser (Definition name' un desc (FieldInfo args typ)) parser) =
         P.FieldParser (Definition name' un desc (FieldInfo args (NonNullable (TList typ)))) parser
 
@@ -835,85 +853,96 @@ remoteFieldFromDefinition schemaDoc (G.FieldDefinition description name argsDefi
       convertType gType' = do
         case gType' of
           G.TypeNamed (G.Nullability True) fieldTypeName ->
-            P.nullableField <$> remoteFieldFromName schemaDoc name description fieldTypeName argsDefinition
+            P.nullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition
           G.TypeList (G.Nullability True) gType'' ->
             addNullableList <$> convertType gType''
           G.TypeNamed (G.Nullability False) fieldTypeName -> do
-            P.nonNullableField <$> remoteFieldFromName schemaDoc name description fieldTypeName argsDefinition
+            P.nonNullableField <$> remoteFieldFromName schemaDoc parentTypeName name description fieldTypeName argsDefinition
           G.TypeList (G.Nullability False) gType'' ->
             addNonNullableList <$> convertType gType''
-   in convertType gType
+  convertType gType
 
 -- | 'remoteFieldFromName' accepts a GraphQL name and searches for its definition
 --   in the 'RemoteSchemaIntrospection'.
 remoteFieldFromName ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.Name ->
+  G.Name ->
   Maybe G.Description ->
   G.Name ->
   G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
   m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
-remoteFieldFromName sdoc fieldName description fieldTypeName argsDefns =
+remoteFieldFromName sdoc parentTypeName fieldName description fieldTypeName argsDefns =
   case lookupType sdoc fieldTypeName of
     Nothing -> throw400 RemoteSchemaError $ "Could not find type with name " <>> fieldTypeName
-    Just typeDef -> remoteField sdoc fieldName description argsDefns typeDef
+    Just typeDef -> remoteField sdoc parentTypeName fieldName description argsDefns typeDef
 
 -- | 'remoteField' accepts a 'G.TypeDefinition' and will returns a 'FieldParser' for it.
 --   Note that the 'G.TypeDefinition' should be of the GraphQL 'Output' kind, when an
 --   GraphQL 'Input' kind is provided, then error will be thrown.
 remoteField ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   G.Name ->
+  G.Name ->
   Maybe G.Description ->
   G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
   G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition ->
   m (FieldParser n (G.Field G.NoFragments RemoteSchemaVariable))
-remoteField sdoc fieldName description argsDefn typeDefn = do
+remoteField sdoc parentTypeName fieldName description argsDefn typeDefn = do
   -- TODO add directives
   argsParser <- argumentsParser argsDefn sdoc
+  customizeTypename <- asks getter
+  customizeFieldName <- asks getter
+  let customizedFieldName = customizeFieldName parentTypeName fieldName
   case typeDefn of
     G.TypeDefinitionObject objTypeDefn -> do
       remoteSchemaObjFields <- remoteSchemaObject sdoc objTypeDefn
       -- converting [Field NoFragments Name] to (SelectionSet NoFragments G.Name)
       let remoteSchemaObjSelSet = fmap G.SelectionField <$> remoteSchemaObjFields
-      pure remoteSchemaObjSelSet <&> mkFieldParserWithSelectionSet argsParser
+      pure remoteSchemaObjSelSet <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
     G.TypeDefinitionScalar scalarTypeDefn ->
-      pure $ mkFieldParserWithoutSelectionSet argsParser $ void $ remoteFieldScalarParser scalarTypeDefn
+      pure $ mkFieldParserWithoutSelectionSet customizedFieldName argsParser $ void $ remoteFieldScalarParser customizeTypename scalarTypeDefn
     G.TypeDefinitionEnum enumTypeDefn ->
-      pure $ mkFieldParserWithoutSelectionSet argsParser $ void $ remoteFieldEnumParser enumTypeDefn
+      pure $ mkFieldParserWithoutSelectionSet customizedFieldName argsParser $ void $ remoteFieldEnumParser customizeTypename enumTypeDefn
     G.TypeDefinitionInterface ifaceTypeDefn ->
-      remoteSchemaInterface sdoc ifaceTypeDefn <&> mkFieldParserWithSelectionSet argsParser
+      remoteSchemaInterface sdoc ifaceTypeDefn <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
     G.TypeDefinitionUnion unionTypeDefn ->
-      remoteSchemaUnion sdoc unionTypeDefn <&> mkFieldParserWithSelectionSet argsParser
+      remoteSchemaUnion sdoc unionTypeDefn <&> mkFieldParserWithSelectionSet customizedFieldName argsParser
     _ -> throw400 RemoteSchemaError "expected output type, but got input type"
   where
     mkField ::
       Maybe G.Name ->
+      G.Name ->
       HashMap G.Name (G.Value RemoteSchemaVariable) ->
       G.SelectionSet G.NoFragments RemoteSchemaVariable ->
       G.Field G.NoFragments RemoteSchemaVariable
-    mkField alias args selSet =
+    mkField alias customizedFieldName args selSet =
-      G.Field alias fieldName args mempty selSet
+      -- If there's no alias then use customizedFieldName as the alias so the
+      -- correctly customized field name will be returned from the remote server.
+      let alias' = alias <|> guard (customizedFieldName /= fieldName) *> Just customizedFieldName
+       in G.Field alias' fieldName args mempty selSet
 
     mkFieldParserWithoutSelectionSet ::
+      G.Name ->
       InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) ->
       Parser 'Both n () ->
       FieldParser n (G.Field G.NoFragments RemoteSchemaVariable)
-    mkFieldParserWithoutSelectionSet argsParser outputParser =
+    mkFieldParserWithoutSelectionSet customizedFieldName argsParser outputParser =
-      P.rawSelection fieldName description argsParser outputParser
+      P.rawSelection customizedFieldName description argsParser outputParser
-        <&> \(alias, _, (_, args)) -> mkField alias args []
+        <&> \(alias, _, (_, args)) -> mkField alias customizedFieldName args []
 
     mkFieldParserWithSelectionSet ::
+      G.Name ->
       InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) ->
       Parser 'Output n (G.SelectionSet G.NoFragments RemoteSchemaVariable) ->
       FieldParser n (G.Field G.NoFragments RemoteSchemaVariable)
-    mkFieldParserWithSelectionSet argsParser outputParser =
+    mkFieldParserWithSelectionSet customizedFieldName argsParser outputParser =
-      P.rawSubselection fieldName description argsParser outputParser
+      P.rawSubselection customizedFieldName description argsParser outputParser
-        <&> \(alias, _, (_, args), selSet) -> mkField alias args selSet
+        <&> \(alias, _, (_, args), selSet) -> mkField alias customizedFieldName args selSet
 
 -- | helper function to get a parser of an object with it's name
 --   This function is called from 'remoteSchemaInterface' and
@@ -921,8 +950,8 @@ remoteField sdoc fieldName description argsDefn typeDefn = do
 --   different implementation of 'getObject', which is the
 --   reason 'getObject' is an argument to this function
 getObjectParser ::
-  forall n m.
+  forall r m n.
-  (MonadSchema n m, MonadError QErr m) =>
+  MonadBuildRemoteSchema r m n =>
   RemoteSchemaIntrospection ->
   (G.Name -> m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)) ->
   G.Name ->
@@ -931,265 +960,37 @@ getObjectParser schemaDoc getObject objName = do
   obj <- remoteSchemaObject schemaDoc =<< getObject objName
   return $ (objName,) <$> obj
 
-addCustomNamespace ::
+customizeRemoteNamespace ::
-  forall m.
+  forall n.
-  MonadParse m =>
-  RemoteSchemaInfo ->
-  G.Name ->
-  G.Name ->
-  [P.FieldParser m RawRemoteField] ->
-  P.FieldParser m RemoteField
-addCustomNamespace remoteSchemaInfo rootTypeName namespace fieldParsers =
-  P.subselection_ namespace Nothing remoteFieldParser
-  where
-    rawRemoteFieldsParser :: Parser 'Output m [RawRemoteField]
-    rawRemoteFieldsParser =
-      P.selectionSet (Typename rootTypeName) Nothing fieldParsers
-        <&> toList
-          . OMap.mapWithKey
-            ( \alias -> \case
-                P.SelectField fld -> fld
-                P.SelectTypename fld ->
-                  -- In P.selectionSet we lose the resultCustomizer from __typename fields so we need to put it back
-                  let resultCustomizer = modifyFieldByName alias $ customizeTypeNameString $ _rscCustomizeTypeName $ rsCustomizer remoteSchemaInfo
-                   in RemoteFieldG remoteSchemaInfo resultCustomizer $ G.Field (Just alias) $$(G.litName "__typename") mempty mempty mempty
-            )
-
-    remoteFieldParser :: Parser 'Output m RemoteField
-    remoteFieldParser =
-      rawRemoteFieldsParser <&> \remoteFields ->
-        RemoteFieldG
-          remoteSchemaInfo
-          (foldMap _rfResultCustomizer remoteFields)
-          (RRFNamespaceField $ G.SelectionField . _rfField <$> remoteFields)
-
-customizeFieldParsers ::
-  forall m n.
-  (MonadState MemoState m, MonadFix m, MonadParse n) =>
-  RemoteSchemaInfo ->
-  G.Name ->
-  [P.FieldParser n RawRemoteField] ->
-  m [P.FieldParser n RemoteField]
-customizeFieldParsers remoteSchemaInfo@RemoteSchemaInfo {..} rootTypeName fieldParsers = do
-  fieldParsers' <-
-    if hasTypeOrFieldCustomizations rsCustomizer
-      then traverse (customizeFieldParser' (set rfResultCustomizer) rsCustomizer rootTypeName) fieldParsers
-      else -- no need to customize individual FieldParsers if there are no type or field name customizations
-        pure fieldParsers
-  pure $ case _rscNamespaceFieldName rsCustomizer of
-    Nothing -> fmap realRemoteField <$> fieldParsers'
-    Just namespace -> [addCustomNamespace remoteSchemaInfo rootTypeName namespace fieldParsers']
-
-customizeFieldParser ::
-  forall n a b.
   (MonadParse n) =>
-  (ResultCustomizer -> a -> b) ->
+  RemoteSchemaInfo ->
-  RemoteSchemaCustomizer ->
   G.Name ->
-  P.FieldParser n a ->
+  [P.FieldParser n RemoteField] ->
-  (P.FieldParser n b)
+  [P.FieldParser n (NamespacedField RemoteField)]
-customizeFieldParser setResultCustomizer remoteSchemaCustomizer rootTypeName =
+customizeRemoteNamespace remoteSchemaInfo@RemoteSchemaInfo {..} rootTypeName fieldParsers =
-  if hasTypeOrFieldCustomizations remoteSchemaCustomizer
+  customizeNamespace (_rscNamespaceFieldName rsCustomizer) fromParsedSelection mkNamespaceTypename fieldParsers
-    then evalMemoState . customizeFieldParser' setResultCustomizer remoteSchemaCustomizer rootTypeName
-    else fmap $ setResultCustomizer mempty
-
-customizeFieldParser' ::
-  forall m n a b.
-  (MonadState MemoState m, MonadFix m, MonadParse n) =>
-  (ResultCustomizer -> a -> b) ->
-  RemoteSchemaCustomizer ->
-  G.Name ->
-  P.FieldParser n a ->
-  m (P.FieldParser n b)
-customizeFieldParser' setResultCustomizer remoteSchemaCustomizer rootTypeName P.FieldParser {..} = do
-  customizedDefinition <- customizeFieldDefinition remoteSchemaCustomizer rootTypeName fDefinition
-  let customizedRootTypeName = remoteSchemaCustomizeTypeName remoteSchemaCustomizer rootTypeName
-  pure
-    P.FieldParser
-      { fParser =
-          fParserWithResultCustomizer
-            <=< customizeField customizedRootTypeName (dInfo customizedDefinition) . fmap customizeVariable,
-        fDefinition = customizedDefinition
-      }
   where
-    fParserWithResultCustomizer :: (ResultCustomizer, G.Field G.NoFragments Variable) -> n b
+    fromParsedSelection alias =
-    fParserWithResultCustomizer (resultCustomizer, fld) =
+      handleTypename . const $
-      setResultCustomizer resultCustomizer <$> fParser fld
+        -- 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)
 
-    customizeVariable :: Variable -> Variable
+type MonadBuildRemoteSchema r m n = (MonadSchema n m, MonadError QErr m, MonadReader r m, Has MkTypename r, Has CustomizeRemoteFieldName r)
-    customizeVariable Variable {..} = Variable {vType = customizeGraphQLType vType, ..}
 
-    customizeGraphQLType :: G.GType -> G.GType
+runMonadBuildRemoteSchema :: Monad m => SchemaT n (ReaderT (MkTypename, CustomizeRemoteFieldName) m) a -> m a
-    customizeGraphQLType = \case
+runMonadBuildRemoteSchema m = flip runReaderT (Typename, idFieldCustomizer) $ runSchemaT m
-      G.TypeNamed nullability name -> G.TypeNamed nullability $ remoteSchemaDecustomizeTypeName remoteSchemaCustomizer name
-      G.TypeList nullability gtype -> G.TypeList nullability $ customizeGraphQLType gtype
-
-    customizeField :: G.Name -> P.FieldInfo -> G.Field G.NoFragments var -> n (ResultCustomizer, G.Field G.NoFragments var)
-    customizeField parentTypeName (P.FieldInfo _ fieldType) (G.Field alias fieldName args directives selSet) = do
-      let fieldName' =
-            if "__" `T.isPrefixOf` G.unName fieldName
-              then fieldName
-              else remoteSchemaDecustomizeFieldName remoteSchemaCustomizer parentTypeName fieldName
-          alias' = alias <|> if fieldName' == fieldName then Nothing else Just fieldName
-      selSet' :: [(ResultCustomizer, G.Selection G.NoFragments var)] <- withPath (++ [Key "selectionSet"]) $
-        case fieldType ^. definitionLens of
-          typeDef@(Definition _ _ _ TIObject {}) -> traverse (customizeSelection typeDef) selSet
-          typeDef@(Definition _ _ _ TIInterface {}) -> traverse (customizeSelection typeDef) selSet
-          typeDef@(Definition _ _ _ TIUnion {}) -> traverse (customizeSelection typeDef) selSet
-          _ -> pure $ (mempty,) <$> selSet
-      let resultCustomizer =
-            modifyFieldByName (fromMaybe fieldName' alias') $
-              if fieldName' == $$(G.litName "__typename")
-                then customizeTypeNameString (_rscCustomizeTypeName remoteSchemaCustomizer)
-                else foldMap fst selSet'
-      pure $ (resultCustomizer, G.Field alias' fieldName' args directives $ snd <$> selSet')
-
-    customizeSelection :: Definition (TypeInfo 'Output) -> G.Selection G.NoFragments var -> n (ResultCustomizer, G.Selection G.NoFragments var)
-    customizeSelection parentTypeDef = \case
-      G.SelectionField fld@G.Field {..} ->
-        withPath (++ [Key $ G.unName _fName]) $ do
-          let parentTypeName = getName parentTypeDef
-          fieldInfo <- findField _fName parentTypeName $ dInfo parentTypeDef
-          second G.SelectionField <$> customizeField parentTypeName fieldInfo fld
-      G.SelectionInlineFragment G.InlineFragment {..} -> do
-        inlineFragmentType <-
-          case _ifTypeCondition of
-            Nothing -> pure parentTypeDef
-            Just typeName -> findSubtype typeName parentTypeDef
-        customizedSelectionSet <- traverse (customizeSelection inlineFragmentType) _ifSelectionSet
-        pure $
-          ( foldMap fst customizedSelectionSet,
-            G.SelectionInlineFragment
-              G.InlineFragment
-                { _ifTypeCondition = remoteSchemaDecustomizeTypeName remoteSchemaCustomizer <$> _ifTypeCondition,
-                  _ifSelectionSet = snd <$> customizedSelectionSet,
-                  ..
-                }
-          )
-
-    findField :: G.Name -> G.Name -> TypeInfo 'Output -> n P.FieldInfo
-    findField fieldName parentTypeName parentTypeInfo =
-      if fieldName == $$(G.litName "__typename") -- TODO can we avoid checking for __typename in two different places?
-        then pure $ P.FieldInfo [] $ NonNullable $ TNamed $ mkDefinition (Typename stringScalar) Nothing TIScalar
-        else do
-          fields <- case parentTypeInfo of
-            TIObject objectInfo -> pure $ oiFields objectInfo
-            TIInterface interfaceInfo -> pure $ iiFields interfaceInfo
-            _ -> parseError $ "Type " <> parentTypeName <<> " has no fields"
-          fld <- find ((== fieldName) . dName) fields `onNothing` parseError ("field " <> fieldName <<> " not found in type: " <> squote parentTypeName)
-          pure $ dInfo fld
-
-    findSubtype :: G.Name -> Definition (TypeInfo 'Output) -> n (Definition (TypeInfo 'Output))
-    findSubtype typeName parentTypeDef =
-      if typeName == getName parentTypeDef
-        then pure parentTypeDef
-        else do
-          possibleTypes <-
-            case dInfo parentTypeDef of
-              TIInterface interfaceInfo -> pure $ iiPossibleTypes interfaceInfo
-              TIUnion unionInfo -> pure $ uiPossibleTypes unionInfo
-              _ -> parseError $ "Type " <> getName parentTypeDef <<> " has no possible subtypes"
-          fmap TIObject <$> find ((== typeName) . dName) possibleTypes
-            `onNothing` parseError ("Type " <> typeName <<> " is not a subtype of " <>> getName parentTypeDef)
-
-type MemoState = (HashMap G.Name ObjectInfo, HashMap G.Name InterfaceInfo, HashMap G.Name UnionInfo, HashMap G.Name InputObjectInfo)
-
-evalMemoState :: Lazy.State MemoState a -> a
-evalMemoState = flip Lazy.evalState (mempty, mempty, mempty, mempty)
-
--- | memo function used to "tie the knot" and preserve sharing in the customized type definitions
--- It would be nice if we could just re-use MonadSchema and memoizeOn, but the types there are too
--- parser-specific.
-memo :: (MonadState s m, MonadFix m, Hashable k, Eq k) => Lens' s (HashMap k v) -> (k -> v -> m v) -> k -> v -> m v
-memo lens f k v = do
-  m <- use lens
-  Map.lookup k m `onNothing` mdo
-    -- Note: v' is added to the state _before_ it is produced
-    lens %= Map.insert k v'
-    v' <- f k v
-    pure v'
-
-customizeFieldDefinition ::
-  forall m.
-  (MonadState MemoState m, MonadFix m) =>
-  RemoteSchemaCustomizer ->
-  G.Name ->
-  Definition P.FieldInfo ->
-  m (Definition P.FieldInfo)
-customizeFieldDefinition remoteSchemaCustomizer = customizeFieldDefinition'
   where
-    customizeFieldDefinition' :: G.Name -> Definition P.FieldInfo -> m (Definition P.FieldInfo)
+    idFieldCustomizer :: CustomizeRemoteFieldName
-    customizeFieldDefinition' parentTypeName Definition {..} = do
+    idFieldCustomizer = const id
-      dInfo' <- customizeFieldInfo dInfo
-      pure
-        Definition
-          { dName = remoteSchemaCustomizeFieldName remoteSchemaCustomizer parentTypeName dName,
-            dInfo = dInfo',
-            ..
-          }
 
-    customizeFieldInfo :: P.FieldInfo -> m P.FieldInfo
+withRemoteSchemaCustomization ::
-    customizeFieldInfo (P.FieldInfo args typ) =
+  forall m r a.
-      P.FieldInfo <$> traverse (traverse $ customizeInputFieldInfo) args <*> customizeType typ
+  (MonadReader r m, Has MkTypename r, Has CustomizeRemoteFieldName r) =>
-
+  RemoteSchemaCustomizer ->
-    customizeTypeDefinition :: (G.Name -> b -> m b) -> Definition b -> m (Definition b)
+  m a ->
-    customizeTypeDefinition f Definition {..} = do
+  m a
-      dInfo' <- f dName dInfo
+withRemoteSchemaCustomization remoteSchemaCustomizer =
-      pure
+  withTypenameCustomization (Typename . remoteSchemaCustomizeTypeName remoteSchemaCustomizer)
-        Definition
+    . withRemoteFieldNameCustomization (remoteSchemaCustomizeFieldName remoteSchemaCustomizer)
-          { dName = remoteSchemaCustomizeTypeName remoteSchemaCustomizer dName,
-            dInfo = dInfo',
-            ..
-          }
-
-    customizeType :: Type k -> m (Type k)
-    customizeType = \case
-      NonNullable nn -> NonNullable <$> customizeNonNullableType nn
-      Nullable nn -> Nullable <$> customizeNonNullableType nn
-
-    customizeNonNullableType :: NonNullableType k -> m (NonNullableType k)
-    customizeNonNullableType = \case
-      TList typ -> TList <$> customizeType typ
-      TNamed definition -> TNamed <$> customizeTypeDefinition customizeTypeInfo definition
-
-    customizeTypeInfo :: G.Name -> TypeInfo k -> m (TypeInfo k)
-    customizeTypeInfo typeName = \case
-      ti@TIScalar -> pure ti
-      ti@TIEnum {} -> pure ti
-      TIInputObject ioi -> TIInputObject <$> customizeInputObjectInfo typeName ioi
-      TIObject oi -> TIObject <$> customizeObjectInfo typeName oi
-      TIInterface ii -> TIInterface <$> customizeInterfaceInfo typeName ii
-      TIUnion ui -> TIUnion <$> customizeUnionInfo typeName ui
-
-    customizeInputFieldInfo :: InputFieldInfo -> m InputFieldInfo
-    customizeInputFieldInfo = \case
-      IFRequired nnType -> IFRequired <$> customizeNonNullableType nnType
-      IFOptional typ value -> IFOptional <$> customizeType typ <*> pure value
-
-    customizeObjectInfo :: G.Name -> ObjectInfo -> m ObjectInfo
-    customizeObjectInfo = memo _1 $ \typeName ObjectInfo {..} -> do
-      oiFields' <- traverse (customizeFieldDefinition' typeName) oiFields
-      oiImplements' <- traverse (customizeTypeDefinition customizeInterfaceInfo) oiImplements
-      pure
-        ObjectInfo
-          { oiFields = oiFields',
-            oiImplements = oiImplements'
-          }
-
-    customizeInterfaceInfo :: G.Name -> InterfaceInfo -> m InterfaceInfo
-    customizeInterfaceInfo = memo _2 $ \typeName InterfaceInfo {..} -> do
-      iiFields' <- traverse (customizeFieldDefinition' typeName) iiFields
-      iiPossibleTypes' <- traverse (customizeTypeDefinition customizeObjectInfo) iiPossibleTypes
-      pure
-        InterfaceInfo
-          { iiFields = iiFields',
-            iiPossibleTypes = iiPossibleTypes'
-          }
-
-    customizeUnionInfo :: G.Name -> UnionInfo -> m UnionInfo
-    customizeUnionInfo = memo _3 $ \_typeName (UnionInfo possibleTypes) ->
-      UnionInfo <$> traverse (customizeTypeDefinition customizeObjectInfo) possibleTypes
-
-    customizeInputObjectInfo :: G.Name -> InputObjectInfo -> m InputObjectInfo
-    customizeInputObjectInfo = memo _4 $ \_typeName (InputObjectInfo args) ->
-      InputObjectInfo <$> traverse (traverse $ customizeInputFieldInfo) args

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

@@ -1376,23 +1376,27 @@ remoteRelationshipField remoteFieldInfo = runMaybeT do
       -- These are the arguments that are given by the user while executing a query
       let remoteFieldUserArguments = map snd $ Map.toList remoteFieldParamMap
       remoteFld <-
-        lift $
+        withRemoteSchemaCustomization remoteSchemaCustomizer $
-          customizeFieldParser (,) remoteSchemaCustomizer parentTypeName . P.wrapFieldParser nestedFieldType
+          lift $
-            <$> remoteField remoteRelationshipIntrospection fieldName Nothing remoteFieldUserArguments fieldTypeDefinition
+            P.wrapFieldParser nestedFieldType
+              <$> remoteField remoteRelationshipIntrospection parentTypeName fieldName Nothing remoteFieldUserArguments fieldTypeDefinition
 
       pure $
         pure $
           remoteFld
-            `P.bindField` \(resultCustomizer, G.Field {G._fArguments = args, G._fSelectionSet = selSet, G._fName = fname}) -> do
+            `P.bindField` \fld@G.Field {G._fArguments = args, G._fSelectionSet = selSet, G._fName = fname} -> do
               let remoteArgs =
                     Map.toList args <&> \(argName, argVal) -> IR.RemoteFieldArgument argName $ P.GraphQLValue $ argVal
-              let resultCustomizer' = applyFieldCalls fieldCalls $ applyAliasMapping (singletonAliasMapping fname (fcName $ NE.last fieldCalls)) resultCustomizer
+              let resultCustomizer =
+                    applyFieldCalls fieldCalls $
+                      applyAliasMapping (singletonAliasMapping fname (fcName $ NE.last fieldCalls)) $
+                        makeResultCustomizer remoteSchemaCustomizer fld
               pure $
                 IR.AFRemote $
                   IR.RemoteSelectRemoteSchema $
                     IR.RemoteSchemaSelect
                       { _rselArgs = remoteArgs,
-                        _rselResultCustomizer = resultCustomizer',
+                        _rselResultCustomizer = resultCustomizer,
                         _rselSelection = selSet,
                         _rselHasuraFields = hasuraFields,
                         _rselFieldCall = fieldCalls,

server/src-lib/Hasura/GraphQL/Transport/HTTP.hs

@@ -468,7 +468,7 @@ runGQ env logger reqId userInfo ipAddress reqHeaders queryType reqUnparsed = do
     runRemoteGQ httpManager fieldName rsi resultCustomizer gqlReq = do
       (telemTimeIO_DT, remoteResponseHeaders, resp) <-
         doQErr $ E.execRemoteGQ env httpManager userInfo reqHeaders (rsDef rsi) gqlReq
-      value <- extractFieldFromResponse fieldName rsi resultCustomizer resp
+      value <- extractFieldFromResponse fieldName resultCustomizer resp
       let filteredHeaders = filter ((== "Set-Cookie") . fst) remoteResponseHeaders
       pure $ AnnotatedResponsePart telemTimeIO_DT Telem.Remote (encJFromOrderedValue value) filteredHeaders
 
@@ -564,14 +564,11 @@ extractFieldFromResponse ::
   forall m.
   Monad m =>
   RootFieldAlias ->
-  RemoteSchemaInfo ->
   ResultCustomizer ->
   LBS.ByteString ->
   ExceptT (Either GQExecError QErr) m JO.Value
-extractFieldFromResponse fieldName rsi resultCustomizer resp = do
+extractFieldFromResponse fieldName resultCustomizer resp = do
-  let namespace = fmap G.unName $ _rscNamespaceFieldName $ rsCustomizer rsi
+  let fieldName' = G.unName $ _rfaAlias fieldName
-      fieldName' = G.unName $ _rfaAlias fieldName
-  -- TODO: use RootFieldAlias for remote fields
   dataVal <-
     applyResultCustomizer resultCustomizer
       <$> do
@@ -579,19 +576,11 @@ extractFieldFromResponse fieldName rsi resultCustomizer resp = do
         case graphQLResponse of
           GraphQLResponseErrors errs -> doGQExecError errs
           GraphQLResponseData d -> pure d
-  case namespace of
+  dataObj <- onLeft (JO.asObject dataVal) do400
-    Just _ ->
+  fieldVal <-
-      -- If using a custom namespace field then the response from the remote server
+    onNothing (JO.lookup fieldName' dataObj) $
-      -- will already be unwrapped so just return it.
+      do400 $ "expecting key " <> fieldName'
-      return dataVal
+  return fieldVal
-    _ -> do
-      -- No custom namespace so we need to look up the field name in the data
-      -- object.
-      dataObj <- onLeft (JO.asObject dataVal) do400
-      fieldVal <-
-        onNothing (JO.lookup fieldName' dataObj) $
-          do400 $ "expecting key " <> fieldName'
-      return fieldVal
   where
     do400 = withExceptT Right . throw400 RemoteSchemaError
     doGQExecError = withExceptT Left . throwError . GQExecError

server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs

@@ -717,7 +717,7 @@ onStart env enabledLogTypes serverEnv wsConn (StartMsg opId q) onMessageActions
       (telemTimeIO_DT, _respHdrs, resp) <-
         doQErr $
           E.execRemoteGQ env httpMgr userInfo reqHdrs (rsDef rsi) gqlReq
-      value <- mapExceptT lift $ extractFieldFromResponse fieldName rsi resultCustomizer resp
+      value <- mapExceptT lift $ extractFieldFromResponse fieldName resultCustomizer resp
       return $ AnnotatedResponsePart telemTimeIO_DT Telem.Remote (encJFromOrderedValue value) []
 
     WSServerEnv

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

@@ -3,11 +3,9 @@ module Hasura.RQL.Types.RemoteSchema
     AddRemoteSchemaQuery (..),
     AliasMapping,
     DropRemoteSchemaPermissions (..),
-    RawRemoteField,
     RemoteField,
     RemoteFieldCustomization (..),
     RemoteFieldG (..),
-    RemoteRootField (..),
     RemoteSchemaCustomization (..),
     RemoteSchemaCustomizer (..),
     RemoteSchemaDef (..),
@@ -25,7 +23,6 @@ module Hasura.RQL.Types.RemoteSchema
     ValidatedRemoteSchemaDef (..),
     applyAliasMapping,
     customizeTypeNameString,
-    getRemoteFieldSelectionSet,
     getUrlFromEnv,
     hasTypeOrFieldCustomizations,
     lookupEnum,
@@ -36,11 +33,8 @@ module Hasura.RQL.Types.RemoteSchema
     lookupType,
     lookupUnion,
     modifyFieldByName,
-    realRemoteField,
     remoteSchemaCustomizeFieldName,
     remoteSchemaCustomizeTypeName,
-    remoteSchemaDecustomizeFieldName,
-    remoteSchemaDecustomizeTypeName,
     rfField,
     rfRemoteSchemaInfo,
     rfResultCustomizer,
@@ -185,11 +179,7 @@ data RemoteSchemaCustomizer = RemoteSchemaCustomizer
     -- | type name -> type name
     _rscCustomizeTypeName :: !(HashMap G.Name G.Name),
     -- | type name -> field name -> field name
-    _rscCustomizeFieldName :: !(HashMap G.Name (HashMap G.Name G.Name)),
+    _rscCustomizeFieldName :: !(HashMap G.Name (HashMap G.Name G.Name))
-    -- | type name -> type name
-    _rscDecustomizeTypeName :: !(HashMap G.Name G.Name),
-    -- | type name -> field name -> field name
-    _rscDecustomizeFieldName :: !(HashMap G.Name (HashMap G.Name G.Name))
   }
   deriving (Show, Eq, Generic)
 
@@ -209,14 +199,6 @@ remoteSchemaCustomizeFieldName :: RemoteSchemaCustomizer -> G.Name -> G.Name ->
 remoteSchemaCustomizeFieldName RemoteSchemaCustomizer {..} typeName fieldName =
   Map.lookup typeName _rscCustomizeFieldName >>= Map.lookup fieldName & fromMaybe fieldName
 
-remoteSchemaDecustomizeTypeName :: RemoteSchemaCustomizer -> G.Name -> G.Name
-remoteSchemaDecustomizeTypeName RemoteSchemaCustomizer {..} typeName =
-  Map.lookupDefault typeName typeName _rscDecustomizeTypeName
-
-remoteSchemaDecustomizeFieldName :: RemoteSchemaCustomizer -> G.Name -> G.Name -> G.Name
-remoteSchemaDecustomizeFieldName RemoteSchemaCustomizer {..} typeName fieldName =
-  Map.lookup typeName _rscDecustomizeFieldName >>= Map.lookup fieldName & fromMaybe fieldName
-
 hasTypeOrFieldCustomizations :: RemoteSchemaCustomizer -> Bool
 hasTypeOrFieldCustomizations RemoteSchemaCustomizer {..} =
   not $ Map.null _rscCustomizeTypeName && Map.null _rscCustomizeFieldName
@@ -428,37 +410,16 @@ newtype RemoteSchemaIntrospection
   = RemoteSchemaIntrospection [(G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition)]
   deriving (Show, Eq, Generic, Hashable, Cacheable, Ord)
 
--- | An RemoteRootField could either be a real field on the remote server
+data RemoteFieldG var = RemoteFieldG
--- or represent a virtual namespace that only exists in the Hasura schema.
-data RemoteRootField var
-  = -- | virtual namespace field
-    RRFNamespaceField !(G.SelectionSet G.NoFragments var)
-  | -- | a real field on the remote server
-    RRFRealField !(G.Field G.NoFragments var)
-  deriving (Functor, Foldable, Traversable)
-
--- | For a real remote field gives a SelectionSet for selecting the field itself.
---   For a virtual field gives the unwrapped SelectionSet for the field.
-getRemoteFieldSelectionSet :: RemoteRootField var -> G.SelectionSet G.NoFragments var
-getRemoteFieldSelectionSet = \case
-  RRFNamespaceField selSet -> selSet
-  RRFRealField fld -> [G.SelectionField fld]
-
-data RemoteFieldG f var = RemoteFieldG
   { _rfRemoteSchemaInfo :: !RemoteSchemaInfo,
     _rfResultCustomizer :: !ResultCustomizer,
-    _rfField :: !(f var)
+    _rfField :: !(G.Field G.NoFragments var)
   }
   deriving (Functor, Foldable, Traversable)
 
 $(makeLenses ''RemoteFieldG)
 
-type RawRemoteField = RemoteFieldG (G.Field G.NoFragments) RemoteSchemaVariable
+type RemoteField = RemoteFieldG RemoteSchemaVariable
-
-type RemoteField = RemoteFieldG RemoteRootField RemoteSchemaVariable
-
-realRemoteField :: RawRemoteField -> RemoteField
-realRemoteField RemoteFieldG {..} = RemoteFieldG {_rfField = RRFRealField _rfField, ..}
 
 data RemoteSchemaPermsCtx
   = RemoteSchemaPermsEnabled

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

@@ -44,12 +44,11 @@ module Hasura.RQL.Types.SchemaCache
     ViewInfo (..),
     isMutable,
     IntrospectionResult (..),
-    ParsedIntrospection (..),
+    ParsedIntrospectionG (..),
+    ParsedIntrospection,
     RemoteSchemaCustomizer (..),
     remoteSchemaCustomizeTypeName,
     remoteSchemaCustomizeFieldName,
-    remoteSchemaDecustomizeTypeName,
-    remoteSchemaDecustomizeFieldName,
     RemoteSchemaCtx (..),
     rscName,
     rscInfo,
@@ -126,6 +125,7 @@ import Database.PG.Query qualified as Q
 import Hasura.Backends.Postgres.Connection qualified as PG
 import Hasura.Base.Error
 import Hasura.GraphQL.Context (GQLContext, RoleContext)
+import Hasura.GraphQL.Namespace
 import Hasura.GraphQL.Parser qualified as P
 import Hasura.Incremental
   ( Cacheable,
@@ -220,12 +220,14 @@ data IntrospectionResult = IntrospectionResult
 
 instance Cacheable IntrospectionResult
 
-data ParsedIntrospection = ParsedIntrospection
+data ParsedIntrospectionG m = ParsedIntrospection
-  { piQuery :: [P.FieldParser (P.ParseT Identity) RemoteField],
+  { piQuery :: [P.FieldParser m (NamespacedField RemoteField)],
-    piMutation :: Maybe [P.FieldParser (P.ParseT Identity) RemoteField],
+    piMutation :: Maybe [P.FieldParser m (NamespacedField RemoteField)],
-    piSubscription :: Maybe [P.FieldParser (P.ParseT Identity) RemoteField]
+    piSubscription :: Maybe [P.FieldParser m (NamespacedField RemoteField)]
   }
 
+type ParsedIntrospection = ParsedIntrospectionG (P.ParseT Identity)
+
 -- | See 'fetchRemoteSchema'.
 data RemoteSchemaCtx = RemoteSchemaCtx
   { _rscName :: !RemoteSchemaName,

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

@@ -11,6 +11,8 @@ module Hasura.RQL.Types.SourceCustomization
     SourceCustomization (..),
     withSourceCustomization,
     MkRootFieldName,
+    CustomizeRemoteFieldName,
+    withRemoteFieldNameCustomization,
   )
 where
 
@@ -122,3 +124,8 @@ withSourceCustomization ::
 withSourceCustomization SourceCustomization {..} =
   withTypenameCustomization (mkCustomizedTypename _scTypeNames)
     . withRootFieldNameCustomization (mkCustomizedFieldName _scRootFields)
+
+type CustomizeRemoteFieldName = G.Name -> G.Name -> G.Name
+
+withRemoteFieldNameCustomization :: forall m r a. (MonadReader r m, Has CustomizeRemoteFieldName r) => CustomizeRemoteFieldName -> m a -> m a
+withRemoteFieldNameCustomization = local . set hasLens

server/src-test/Hasura/GraphQL/RemoteServerSpec.hs

@@ -1,115 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-
-module Hasura.GraphQL.RemoteServerSpec (spec) where
-
-import Data.Containers.ListUtils (nubOrd)
-import Data.Either (isRight)
-import Data.HashMap.Strict qualified as Map
-import Hasura.Generator ()
-import Hasura.GraphQL.RemoteServer
-import Hasura.Prelude
-import Hasura.RQL.Types.RemoteSchema
-import Hasura.RQL.Types.SchemaCache
-import Language.GraphQL.Draft.Syntax qualified as G
-import Test.Hspec
-import Test.Hspec.QuickCheck
-import Test.QuickCheck
-
-spec :: Spec
-spec = do
-  describe "IntrospectionResult" $ do
-    describe "getCustomizer" $ do
-      prop "inverse" $
-        forAllShrinkShow gen shrink_ show_ $ \(introspectionResult, typesAndFields, customization) ->
-          let customizer = getCustomizer introspectionResult (Just customization)
-              customizeTypeName = remoteSchemaCustomizeTypeName customizer
-              customizeFieldName = remoteSchemaCustomizeFieldName customizer
-              decustomizeTypeName = remoteSchemaDecustomizeTypeName customizer
-              decustomizeFieldName = remoteSchemaDecustomizeFieldName customizer
-              typeTests =
-                conjoin $
-                  Map.keys typesAndFields <&> \typeName ->
-                    decustomizeTypeName (customizeTypeName typeName) === typeName
-              fieldTests =
-                conjoin $
-                  Map.toList typesAndFields <&> \(typeName, fieldNames) ->
-                    conjoin $
-                      fieldNames <&> \fieldName ->
-                        decustomizeFieldName (customizeTypeName typeName) (customizeFieldName typeName fieldName) === fieldName
-           in isRight (validateSchemaCustomizationsDistinct customizer $ irDoc introspectionResult)
-                ==> typeTests .&&. fieldTests
-
-getTypesAndFields :: IntrospectionResult -> HashMap G.Name [G.Name]
-getTypesAndFields IntrospectionResult {irDoc = RemoteSchemaIntrospection typeDefinitions} =
-  Map.fromList $ map getTypeAndFields typeDefinitions
-  where
-    getTypeAndFields = \case
-      G.TypeDefinitionScalar G.ScalarTypeDefinition {..} -> (_stdName, [])
-      G.TypeDefinitionObject G.ObjectTypeDefinition {..} -> (_otdName, G._fldName <$> _otdFieldsDefinition)
-      G.TypeDefinitionInterface G.InterfaceTypeDefinition {..} -> (_itdName, G._fldName <$> _itdFieldsDefinition)
-      G.TypeDefinitionUnion G.UnionTypeDefinition {..} -> (_utdName, [])
-      G.TypeDefinitionEnum G.EnumTypeDefinition {..} -> (_etdName, [])
-      G.TypeDefinitionInputObject G.InputObjectTypeDefinition {..} -> (_iotdName, [])
-
-genCustomization :: HashMap G.Name [G.Name] -> Gen RemoteSchemaCustomization
-genCustomization typesAndFields = RemoteSchemaCustomization <$> arbitrary <*> fmap Just genTypeNames <*> fmap Just genFieldNames
-  where
-    genTypeNames = RemoteTypeCustomization <$> arbitrary <*> arbitrary <*> genMap (Map.keys typesAndFields)
-    genFieldNames = do
-      typesAndFields' <- sublistOf $ Map.toList typesAndFields
-      for typesAndFields' $ \(typeName, fieldNames) ->
-        RemoteFieldCustomization typeName <$> arbitrary <*> arbitrary <*> genMap fieldNames
-    genMap names = do
-      keys <- sublistOf names
-      values <- nubOrd . filter (`notElem` names) <$> infiniteList
-      pure $ Map.fromList $ zip keys values
-
-gen :: Gen (IntrospectionResult, HashMap G.Name [G.Name], RemoteSchemaCustomization)
-gen = do
-  introspectionResult <- arbitrary
-  let typesAndFields = getTypesAndFields introspectionResult
-  customization <- genCustomization typesAndFields
-  pure (introspectionResult, typesAndFields, customization)
-
-shrink_ :: (IntrospectionResult, HashMap G.Name [G.Name], RemoteSchemaCustomization) -> [(IntrospectionResult, HashMap G.Name [G.Name], RemoteSchemaCustomization)]
-shrink_ (introspectionResult, typesAndFields, customization@RemoteSchemaCustomization {..}) =
-  (shrinkCustomization <&> (introspectionResult,typesAndFields,))
-    ++ (shrinkTypesAndFields <&> (introspectionResult,,customization))
-  where
-    shrinkCustomization = shrinkNamespace ++ shrinkTypeNames ++ shrinkFieldNames
-
-    shrinkMaybe _ Nothing = []
-    shrinkMaybe f (Just x) = Nothing : (Just <$> f x)
-
-    shrinkMaybe' = shrinkMaybe shrinkNothing
-
-    shrinkHashMap f = shrinkMapBy Map.fromList Map.toList $ shrinkList f
-
-    shrinkHashMap' = shrinkHashMap shrinkNothing
-
-    shrinkNamespace = do
-      ns <- shrinkMaybe' _rscRootFieldsNamespace
-      pure $ customization {_rscRootFieldsNamespace = ns}
-
-    shrinkTypeNames = do
-      tns <- shrinkMaybe shrinkTypeNames' _rscTypeNames
-      pure $ customization {_rscTypeNames = tns}
-
-    shrinkTypeNames' rtc@RemoteTypeCustomization {..} =
-      (shrinkMaybe' _rtcPrefix <&> \p -> rtc {_rtcPrefix = p})
-        ++ (shrinkMaybe' _rtcSuffix <&> \s -> rtc {_rtcSuffix = s})
-        ++ (shrinkHashMap' _rtcMapping <&> \m -> rtc {_rtcMapping = m})
-
-    shrinkFieldNames = do
-      fns <- shrinkMaybe (shrinkList shrinkFieldNames') _rscFieldNames
-      pure $ customization {_rscFieldNames = fns}
-
-    shrinkFieldNames' rfc@RemoteFieldCustomization {..} =
-      (shrinkMaybe' _rfcPrefix <&> \p -> rfc {_rfcPrefix = p})
-        ++ (shrinkMaybe' _rfcSuffix <&> \s -> rfc {_rfcSuffix = s})
-        ++ (shrinkHashMap' _rfcMapping <&> \m -> rfc {_rfcMapping = m})
-
-    shrinkTypesAndFields = shrinkHashMap (traverse $ shrinkList shrinkNothing) typesAndFields
-
-show_ :: (IntrospectionResult, HashMap G.Name [G.Name], RemoteSchemaCustomization) -> String
-show_ (_a, b, c) = show (b, c)

server/src-test/Hasura/GraphQL/Schema/RemoteTest.hs

@@ -11,8 +11,8 @@ import Hasura.Base.Error
 import Hasura.GraphQL.Execute.Inline
 import Hasura.GraphQL.Execute.Remote (resolveRemoteVariable, runVariableCache)
 import Hasura.GraphQL.Execute.Resolve
+import Hasura.GraphQL.Namespace
 import Hasura.GraphQL.Parser.Internal.Parser qualified as P
-import Hasura.GraphQL.Parser.Monad
 import Hasura.GraphQL.Parser.Schema
 import Hasura.GraphQL.Parser.TestUtils
 import Hasura.GraphQL.RemoteServer (identityCustomizer)
@@ -99,20 +99,17 @@ buildQueryParsers ::
   IO (P.FieldParser TestMonad (G.Field G.NoFragments RemoteSchemaVariable))
 buildQueryParsers introspection = do
   let introResult = IntrospectionResult introspection $$(G.litName "Query") Nothing Nothing
-  (query, _, _) <-
+  ParsedIntrospection query _ _ <-
     runError $
-      runSchemaT $
+      buildRemoteParser introResult $
-        buildRemoteParser introResult $
+        RemoteSchemaInfo (ValidatedRemoteSchemaDef N.nullURI [] False 60 Nothing) identityCustomizer
-          RemoteSchemaInfo (ValidatedRemoteSchemaDef N.nullURI [] False 60 Nothing) identityCustomizer
   pure $
-    head query <&> \(RemoteFieldG _ _ abstractField) ->
+    head query <&> \case
-      case abstractField of
+      NotNamespaced remoteFld -> _rfField remoteFld
-        RRFRealField f -> f
+      Namespaced _ ->
-        RRFNamespaceField _ ->
+        -- Shouldn't happen if we're using identityCustomizer
-          error "buildQueryParsers: unexpected RRFNamespaceField"
+        -- TODO: add some tests for remote schema customization
-
+        error "buildQueryParsers: unexpected Namespaced field"
--- Shouldn't happen if we're using identityCustomizer
--- TODO: add some tests for remote schema customization
 
 runQueryParser ::
   P.FieldParser TestMonad any ->

server/src-test/Main.hs

@@ -23,7 +23,6 @@ import Hasura.App
 import Hasura.EventingSpec qualified as EventingSpec
 import Hasura.GraphQL.NamespaceSpec qualified as NamespaceSpec
 import Hasura.GraphQL.Parser.DirectivesTest qualified as GraphQLDirectivesSpec
-import Hasura.GraphQL.RemoteServerSpec qualified as RemoteServerSpec
 import Hasura.GraphQL.Schema.RemoteTest qualified as GraphRemoteSchemaSpec
 import Hasura.IncrementalSpec qualified as IncrementalSpec
 import Hasura.Logging
@@ -90,7 +89,6 @@ unitSpecs = do
   describe "Hasura.RQL.Types.Common" CommonTypesSpec.spec
   describe "Hasura.RQL.Types.Endpoint" EndpointSpec.spec
   describe "Hasura.GraphQL.Namespace" NamespaceSpec.spec
-  describe "Hasura.GraphQL.RemoteServer" RemoteServerSpec.spec
   describe "Hasura.SQL.WKT" WKTSpec.spec
   describe "Hasura.Server.Auth" AuthSpec.spec
   describe "Hasura.Server.Telemetry" TelemetrySpec.spec

server/tests-py/queries/remote_schemas/validation/customize_all_the_things.yaml

@@ -69,11 +69,11 @@
         }
       }
   response:
-    errors:
+    data:
-    - extensions:
+      star_wars:
-        path: $.selectionSet.star_wars.selectionSet.super_hero.selectionSet
+        super_hero:
-        code: validation-failed
+          ident: '1'
-      message: Type "Droid" is not a subtype of "FooCharacter_x"
+          foo_name_f: R2-D2
 
 - description: query with fragment
   url: /v1/graphql
@@ -123,27 +123,27 @@
           ident: "1"
           foo_name_f: R2-D2
 
-# - description: query with variable with wrong type name
+- description: query with variable with wrong type name
-#   url: /v1/graphql
+  url: /v1/graphql
-#   status: 200
+  status: 200
-#   query:
+  query:
-#     query: |
+    query: |
-#       query Hero($ep: Int!) {
+      query Hero($ep: Int!) {
-#         star_wars {
+        star_wars {
-#           super_hero(episode: $ep) {
+          super_hero(episode: $ep) {
-#             ident
+            ident
-#             foo_name_f
+            foo_name_f
-#           }
+          }
-#         }
+        }
-#       }
+      }
-#     variables:
+    variables:
-#       ep: 4
+      ep: 4
-#   response:
+  response:
-#     errors:
+    errors:
-#     - extensions:
+    - extensions:
-#         path: $.selectionSet.star_wars.selectionSet.super_hero.args.episode
+        path: $.selectionSet.star_wars.selectionSet.super_hero.args.episode
-#         code: validation-failed
+        code: validation-failed
-#       message: variable "ep" is declared as Int!, but used where MyInt! is expected
+      message: variable "ep" is declared as Int!, but used where MyInt! is expected
 
 - description: query with __type introspection
   url: /v1/graphql
@@ -334,7 +334,7 @@
       - extensions:
           path: $.selectionSet.star_wars.selectionSet.super_hero.selectionSet.id
           code: validation-failed
-        message: "field \"id\" not found in type: 'FooCharacter_x'"
+        message: "field \"id\" not found in type: 'FooHuman_x'"
 
 - description: query aliases
   url: /v1/graphql

server/tests-py/queries/remote_schemas/validation/field_prefix_validation.yaml

@@ -36,7 +36,7 @@
       - extensions:
           path: $.selectionSet.hero.selectionSet.id
           code: validation-failed
-        message: "field \"id\" not found in type: 'Character'"
+        message: "field \"id\" not found in type: 'Human'"
 
 - description: query aliases
   url: /v1/graphql

server/tests-py/queries/remote_schemas/validation/namespace_validation.yaml

@@ -8,11 +8,6 @@
           hero(episode: 4) {
             id
             name
-            ... on BarDroid {
-              id
-              name
-              primaryFunction
-            }
           }
         }
       }
@@ -22,4 +17,3 @@
         hero:
           id: '1'
           name: R2-D2
-          primaryFunction: Astromech

server/tests-py/queries/remote_schemas/validation/type_prefix_validation.yaml

@@ -5,6 +5,7 @@
     query: |
       {
         hero(episode: 4) {
+          __typename
           id
           name
           ... on FooDroid {
@@ -17,6 +18,7 @@
   response:
     data:
       hero:
+        __typename: FooDroid
         id: "1"
         name: R2-D2
         primaryFunction: Astromech
@@ -62,11 +64,10 @@
         }
       }
   response:
-    errors:
+    data:
-    - extensions:
+      hero:
-        path: $.selectionSet.hero.selectionSet
+        id: '1'
-        code: validation-failed
+        name: R2-D2
-      message: Type "Droid" is not a subtype of "FooCharacter"
 
 - description: query with fragment
   url: /v1/graphql
@@ -108,25 +109,25 @@
         id: "1"
         name: R2-D2
 
-# - description: query with variable with wrong type name
+- description: query with variable with wrong type name
-#   url: /v1/graphql
+  url: /v1/graphql
-#   status: 200
+  status: 200
-#   query:
+  query:
-#     query: |
+    query: |
-#       query Hero($ep: Int!) {
+      query Hero($ep: Int!) {
-#         hero(episode: $ep) {
+        hero(episode: $ep) {
-#           id
+          id
-#           name
+          name
-#         }
+        }
-#       }
+      }
-#     variables:
+    variables:
-#       ep: 4
+      ep: 4
-#   response:
+  response:
-#     errors:
+    errors:
-#     - extensions:
+    - extensions:
-#         path: $.selectionSet.hero.args.episode
+        path: $.selectionSet.hero.args.episode
-#         code: validation-failed
+        code: validation-failed
-#       message: variable "ep" is declared as Int!, but used where MyInt! is expected
+      message: variable "ep" is declared as Int!, but used where MyInt! is expected
 
 - description: query with __type introspection
   url: /v1/graphql

server/tests-py/test_schema_stitching.py

@@ -836,7 +836,7 @@ class TestValidateRemoteSchemaNamespaceQuery:
     def transact(self, request, hge_ctx):
         config = request.config
         if not config.getoption('--skip-schema-setup'):
-            customization = { "root_fields_namespace": "foo", "type_names": {"prefix": "Bar" }}
+            customization = { "root_fields_namespace": "foo" }
             q = mk_add_remote_q('character-foo', 'http://localhost:5000/character-iface-graphql', customization=customization)
             st_code, resp = hge_ctx.v1q(q)
             assert st_code == 200, resp