Use record types rather than tuples fo IntrospectionResult and ParsedIntrospection

Author: Auke Booij

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

@@ -77,13 +77,15 @@ fetchRemoteSchema env manager schemaName schemaInfo@(RemoteSchemaInfo url header
     either (remoteSchemaErr . T.pack) return $ J.eitherDecode respData
 
   -- Check that the parsed GraphQL type info is valid by running the schema generation
-  parsers <- P.runSchemaT @m @(P.ParseT Identity) $ buildRemoteParser introspectRes schemaInfo
+  (queryParsers, mutationParsers, subscriptionParsers) <-
+    P.runSchemaT @m @(P.ParseT Identity) $ buildRemoteParser introspectRes schemaInfo
 
   -- The 'rawIntrospectionResult' contains the 'Bytestring' response of
   -- the introspection result of the remote server. We store this in the
   -- 'RemoteSchemaCtx' because we can use this when the 'introspect_remote_schema'
   -- is called by simple encoding the result to JSON.
-  return $ RemoteSchemaCtx schemaName introspectRes schemaInfo respData parsers
+  return $ RemoteSchemaCtx schemaName introspectRes schemaInfo respData $
+    ParsedIntrospection queryParsers mutationParsers subscriptionParsers
   where
     remoteSchemaErr :: T.Text -> m a
     remoteSchemaErr = throw400 RemoteSchemaError
@@ -295,11 +297,8 @@ instance J.FromJSON (FromIntrospection IntrospectionResult) where
       Just subsType -> do
         subRoot <- subsType .: "name"
         return $ Just subRoot
-    let r = ( G.SchemaIntrospection (fmap fromIntrospection types)
-            , queryRoot
-            , mutationRoot
-            , subsRoot
-            )
+    let r = IntrospectionResult (G.SchemaIntrospection (fmap fromIntrospection types))
+            queryRoot mutationRoot subsRoot
     return $ FromIntrospection r
 
 execRemoteGQ'

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

@@ -77,7 +77,7 @@ buildGQLContext =
 
         allActionInfos = Map.elems allActions
         queryRemotesMap =
-          fmap (map fDefinition . (\(x,_,_)->x) . rscParsed . fst) allRemoteSchemas
+          fmap (map fDefinition . piQuery . rscParsed . fst) allRemoteSchemas
         buildFullestDBSchema
           :: m ( Parser 'Output (P.ParseT Identity) (OMap.InsOrdHashMap G.Name (QueryRootField UnpreparedValue))
                , Maybe (Parser 'Output (P.ParseT Identity) (OMap.InsOrdHashMap G.Name (MutationRootField UnpreparedValue)))
@@ -119,15 +119,14 @@ buildGQLContext =
     -- This block of code checks that there are no conflicting root field names between remotes.
     remotes ::
       [ ( RemoteSchemaName
-        , ( [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
-          , Maybe [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
-          , Maybe [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
-          )
+        , ParsedIntrospection
         )
       ] <- (| foldlA' (\okSchemas (newSchemaName, (newSchemaContext, newMetadataObject)) -> do
                 checkedDuplicates <- (| withRecordInconsistency (do
-                     let (queryOld, mutationOld, _subscriptionOld) = unzip3 $ fmap snd okSchemas
-                     let (queryNew, mutationNew, _subscriptionNew) = rscParsed newSchemaContext
+                     let (queryOld, mutationOld) =
+                           unzip $ fmap ((\case ParsedIntrospection q m _ -> (q,m)) . snd) okSchemas
+                     let ParsedIntrospection queryNew mutationNew _subscriptionNew
+                           = rscParsed newSchemaContext
                      -- Check for conflicts between remotes
                      bindErrorA -<
                        checkFieldNamesUnique (fmap (P.getName . fDefinition) (queryNew ++ concat queryOld))
@@ -165,8 +164,8 @@ buildGQLContext =
         -- | The 'query' type of the remotes. TODO: also expose mutation
         -- remotes. NOT TODO: subscriptions, as we do not yet aim to support
         -- these.
-        queryRemotes = concatMap ((\(q,_,_)->q) . snd) remotes
-        mutationRemotes = concatMap (concat . (\(_,m,_)->m) . snd) remotes
+        queryRemotes = concatMap (piQuery . snd) remotes
+        mutationRemotes = concatMap (concat . piMutation . snd) remotes
         queryHasuraOrRelay = case queryType of
           QueryHasura -> queryWithIntrospection (Set.fromMap $ validTables $> ())
                          validFunctions queryRemotes mutationRemotes

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

@@ -26,7 +26,7 @@ buildRemoteParser
   -> m ( [P.FieldParser n (RemoteSchemaInfo, Field NoFragments Variable)]
        , Maybe [P.FieldParser n (RemoteSchemaInfo, Field NoFragments Variable)]
        , Maybe [P.FieldParser n (RemoteSchemaInfo, Field NoFragments Variable)])
-buildRemoteParser (sdoc, query_root, mutation_root, subscription_root) info = do
+buildRemoteParser (IntrospectionResult sdoc query_root mutation_root subscription_root) info = do
   queryT <- makeParsers query_root
   mutationT <- traverse makeParsers mutation_root
   subscriptionT <- traverse makeParsers subscription_root

server/src-lib/Hasura/RQL/DDL/RemoteRelationship/Validate.hs

@@ -92,9 +92,11 @@ validateRemoteRelationship remoteRelationship remoteSchemaMap pgColumns = do
                                   pure $ (variableName,v)
                               )) $ (HM.toList $ mapFromL (pgiColumn) pgColumns)
   let pgColumnsVariablesMap = HM.fromList pgColumnsVariables
-  (RemoteSchemaCtx rsName (schemaDoc@(G.SchemaIntrospection originalDefns),queryRootName,_,_) rsi _ _) <-
+  (RemoteSchemaCtx rsName introspectionResult rsi _ _) <-
     onNothing (HM.lookup remoteSchemaName remoteSchemaMap) $
     throwError $ RemoteSchemaNotFound remoteSchemaName
+  let schemaDoc@(G.SchemaIntrospection originalDefns) = irDoc introspectionResult
+      queryRootName = irQueryRoot introspectionResult
   queryRoot <- onNothing (lookupObject schemaDoc queryRootName) $
     throwError $ FieldNotFoundInRemoteSchema queryRootName
   (_, (leafParamMap, leafTypeMap)) <-

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

@@ -43,7 +43,8 @@ module Hasura.RQL.Types.SchemaCache
   , isMutable
   , mutableView
 
-  , IntrospectionResult
+  , IntrospectionResult(..)
+  , ParsedIntrospection(..)
   , RemoteSchemaCtx(..)
   , RemoteSchemaMap
 
@@ -167,16 +168,20 @@ mkComputedFieldDep reason tn computedField =
 
 type WithDeps a = (a, [SchemaDependency])
 
-type IntrospectionResult = ( G.SchemaIntrospection
-                           , G.Name -- query_root
-                           , Maybe G.Name -- mutation_root
-                           , Maybe G.Name
-                           )
+data IntrospectionResult
+  = IntrospectionResult
+  { irDoc              :: G.SchemaIntrospection
+  , irQueryRoot        :: G.Name
+  , irMutationRoot     :: Maybe G.Name
+  , irSubscriptionRoot :: Maybe G.Name
+  }
 
-type ParsedIntrospection =
-  ( [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
-  , Maybe [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
-  , Maybe [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)])
+data ParsedIntrospection
+  = ParsedIntrospection
+  { piQuery        :: [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
+  , piMutation     :: Maybe [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
+  , piSubscription :: Maybe [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
+  }
 
 data RemoteSchemaCtx
   = RemoteSchemaCtx