Role-invariant schema constructors

We build the GraphQL schema by combining building blocks such as `tableSelectionSet` and `columnParser`. These building blocks individually build `{InputFields,Field,}Parser` objects. Those object specify the valid GraphQL schema.

Since the GraphQL schema is role-dependent, at some point we need to know what fragment of the GraphQL schema a specific role is allowed to access, and this is stored in `{Sel,Upd,Ins,Del}PermInfo` objects.

We have passed around these permission objects as function arguments to the schema building blocks since we first started dealing with permissions during the PDV refactor - see 5168b99 in #4111. This means that, for instance, `tableSelectionSet` has as its type:
```haskell
tableSelectionSet ::
  forall b r m n.
  MonadBuildSchema b r m n =>
  SourceName ->
  TableInfo b ->
  SelPermInfo b ->
  m (Parser 'Output n (AnnotatedFields b))
```

There are three reasons to change this.

1. We often pass a `Maybe (xPermInfo b)` instead of a proper `xPermInfo b`, and it's not clear what the intended semantics of this is. Some potential improvements on the data types involved are discussed in issue hasura/graphql-engine-mono#3125.
2. In most cases we also already pass a `TableInfo b`, and together with the `MonadRole` that is usually also in scope, this means that we could look up the required permissions regardless: so passing the permissions explicitly undermines the "single source of truth" principle. Breaking this principle also makes the code more difficult to read.
3. We are working towards role-based parsers (see hasura/graphql-engine-mono#2711), where the `{InputFields,Field,}Parser` objects are constructed in a role-invariant way, so that we have a single object that can be used for all roles. In particular, this means that the schema building blocks _need_ to be constructed in a role-invariant way. While this PR doesn't accomplish that, it does reduce the amount of role-specific arguments being passed, thus fixing hasura/graphql-engine-mono#3068.

Concretely, this PR simply drops the `xPermInfo b` argument from almost all schema building blocks. Instead these objects are looked up from the `TableInfo b` as-needed. The resulting code is considerably simpler and shorter.

One way to interpret this change is as follows. Before this PR, we figured out permissions at the top-level in `Hasura.GraphQL.Schema`, passing down the obtained `xPermInfo` objects as required. After this PR, we have a bottom-up approach where the schema building blocks themselves decide whether they want to be included for a particular role.

So this moves some permission logic out of `Hasura.GraphQL.Schema`, which is very complex.

PR-URL: hasura/graphql-engine-mono#3608
GitOrigin-RevId: 51a744f34ec7d57bc8077667ae7f9cb9c4f6c962

Author: Auke Booij

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

@@ -68,22 +68,19 @@ bqBuildTableRelayQueryFields ::
   TableInfo 'BigQuery ->
   G.Name ->
   NESeq (ColumnInfo 'BigQuery) ->
-  SelPermInfo 'BigQuery ->
   m [a]
-bqBuildTableRelayQueryFields _sourceName _tableName _tableInfo _gqlName _pkeyColumns _selPerms =
+bqBuildTableRelayQueryFields _sourceName _tableName _tableInfo _gqlName _pkeyColumns =
   pure []
 
 bqBuildTableInsertMutationFields ::
   MonadBuildSchema 'BigQuery r m n =>
+  Scenario ->
   SourceName ->
   TableName 'BigQuery ->
   TableInfo 'BigQuery ->
   G.Name ->
-  InsPermInfo 'BigQuery ->
-  Maybe (SelPermInfo 'BigQuery) ->
-  Maybe (UpdPermInfo 'BigQuery) ->
   m [a]
-bqBuildTableInsertMutationFields _sourceName _tableName _tableInfo _gqlName _insPerms _selPerms _updPerms =
+bqBuildTableInsertMutationFields _scenario _sourceName _tableName _tableInfo _gqlName =
   pure []
 
 bqBuildTableUpdateMutationFields ::
@@ -92,10 +89,8 @@ bqBuildTableUpdateMutationFields ::
   TableName 'BigQuery ->
   TableInfo 'BigQuery ->
   G.Name ->
-  UpdPermInfo 'BigQuery ->
-  Maybe (SelPermInfo 'BigQuery) ->
   m [a]
-bqBuildTableUpdateMutationFields _sourceName _tableName _tableInfo _gqlName _updPerns _selPerms =
+bqBuildTableUpdateMutationFields _sourceName _tableName _tableInfo _gqlName =
   pure []
 
 bqBuildTableDeleteMutationFields ::
@@ -104,10 +99,8 @@ bqBuildTableDeleteMutationFields ::
   TableName 'BigQuery ->
   TableInfo 'BigQuery ->
   G.Name ->
-  DelPermInfo 'BigQuery ->
-  Maybe (SelPermInfo 'BigQuery) ->
   m [a]
-bqBuildTableDeleteMutationFields _sourceName _tableName _tableInfo _gqlName _delPerns _selPerms =
+bqBuildTableDeleteMutationFields _sourceName _tableName _tableInfo _gqlName =
   pure []
 
 bqBuildFunctionQueryFields ::
@@ -116,9 +109,8 @@ bqBuildFunctionQueryFields ::
   FunctionName 'BigQuery ->
   FunctionInfo 'BigQuery ->
   TableName 'BigQuery ->
-  SelPermInfo 'BigQuery ->
   m [a]
-bqBuildFunctionQueryFields _ _ _ _ _ =
+bqBuildFunctionQueryFields _ _ _ _ =
   pure []
 
 bqBuildFunctionRelayQueryFields ::
@@ -128,9 +120,8 @@ bqBuildFunctionRelayQueryFields ::
   FunctionInfo 'BigQuery ->
   TableName 'BigQuery ->
   NESeq (ColumnInfo 'BigQuery) ->
-  SelPermInfo 'BigQuery ->
   m [a]
-bqBuildFunctionRelayQueryFields _sourceName _functionName _functionInfo _tableName _pkeyColumns _selPerms =
+bqBuildFunctionRelayQueryFields _sourceName _functionName _functionInfo _tableName _pkeyColumns =
   pure []
 
 bqBuildFunctionMutationFields ::
@@ -139,9 +130,8 @@ bqBuildFunctionMutationFields ::
   FunctionName 'BigQuery ->
   FunctionInfo 'BigQuery ->
   TableName 'BigQuery ->
-  SelPermInfo 'BigQuery ->
   m [a]
-bqBuildFunctionMutationFields _ _ _ _ _ =
+bqBuildFunctionMutationFields _ _ _ _ =
   pure []
 
 ----------------------------------------------------------------
@@ -391,9 +381,9 @@ bqComputedField ::
   SourceName ->
   ComputedFieldInfo 'BigQuery ->
   TableName 'BigQuery ->
-  SelPermInfo 'BigQuery ->
+  TableInfo 'BigQuery ->
   m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
-bqComputedField _sourceName _fieldInfo _table _selectPemissions = pure Nothing
+bqComputedField _sourceName _fieldInfo _table _tableInfo = pure Nothing
 
 -- | Remote join field parser.
 -- Currently unsupported: returns Nothing for now.

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

@@ -25,6 +25,7 @@ import Hasura.GraphQL.Schema.BoolExp
 import Hasura.GraphQL.Schema.Build qualified as GSB
 import Hasura.GraphQL.Schema.Common
 import Hasura.GraphQL.Schema.Select
+import Hasura.GraphQL.Schema.Table
 import Hasura.GraphQL.Schema.Update qualified as SU
 import Hasura.Prelude
 import Hasura.RQL.IR
@@ -82,21 +83,18 @@ msBuildTableRelayQueryFields ::
   TableInfo 'MSSQL ->
   G.Name ->
   NESeq (ColumnInfo 'MSSQL) ->
-  SelPermInfo 'MSSQL ->
   m [a]
-msBuildTableRelayQueryFields _sourceName _tableName _tableInfo _gqlName _pkeyColumns _selPerms =
+msBuildTableRelayQueryFields _sourceName _tableName _tableInfo _gqlName _pkeyColumns =
   pure []
 
 backendInsertParser ::
   forall m r n.
   MonadBuildSchema 'MSSQL r m n =>
   SourceName ->
   TableInfo 'MSSQL ->
-  Maybe (SelPermInfo 'MSSQL) ->
-  Maybe (UpdPermInfo 'MSSQL) ->
   m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
-backendInsertParser sourceName tableInfo selectPerms updatePerms = do
-  ifMatched <- ifMatchedFieldParser sourceName tableInfo selectPerms updatePerms
+backendInsertParser sourceName tableInfo = do
+  ifMatched <- ifMatchedFieldParser sourceName tableInfo
   let _biIdentityColumns = _tciExtraTableMetadata $ _tiCoreInfo tableInfo
   pure $ do
     _biIfMatched <- ifMatched
@@ -108,21 +106,27 @@ msBuildTableUpdateMutationFields ::
   TableName 'MSSQL ->
   TableInfo 'MSSQL ->
   G.Name ->
-  UpdPermInfo 'MSSQL ->
-  Maybe (SelPermInfo 'MSSQL) ->
   m [FieldParser n (AnnotatedUpdateG 'MSSQL (RemoteRelationshipField UnpreparedValue) (UnpreparedValue 'MSSQL))]
-msBuildTableUpdateMutationFields =
-  GSB.buildTableUpdateMutationFields
-    ( \ti updPerms ->
-        fmap BackendUpdate
-          <$> SU.buildUpdateOperators
-            (UpdateSet <$> SU.presetColumns updPerms)
-            [ UpdateSet <$> SU.setOp,
-              UpdateInc <$> SU.incOp
-            ]
-            ti
-            updPerms
-    )
+msBuildTableUpdateMutationFields sourceName tableName tableInfo gqlName = do
+  fieldParsers <- runMaybeT do
+    tablePerms <- MaybeT $ tablePermissions tableInfo
+    updatePerms <- hoistMaybe $ _permUpd tablePerms
+    let mkBackendUpdate backendUpdateTableInfo =
+          (fmap . fmap) BackendUpdate $
+            SU.buildUpdateOperators
+              (UpdateSet <$> SU.presetColumns updatePerms)
+              [ UpdateSet <$> SU.setOp,
+                UpdateInc <$> SU.incOp
+              ]
+              backendUpdateTableInfo
+    lift $
+      GSB.buildTableUpdateMutationFields
+        mkBackendUpdate
+        sourceName
+        tableName
+        tableInfo
+        gqlName
+  pure . fold @Maybe @[_] $ fieldParsers
 
 msBuildTableDeleteMutationFields ::
   MonadBuildSchema 'MSSQL r m n =>
@@ -142,9 +146,8 @@ msBuildFunctionQueryFields ::
   FunctionName 'MSSQL ->
   FunctionInfo 'MSSQL ->
   TableName 'MSSQL ->
-  SelPermInfo 'MSSQL ->
   m [a]
-msBuildFunctionQueryFields _ _ _ _ _ =
+msBuildFunctionQueryFields _ _ _ _ =
   pure []
 
 msBuildFunctionRelayQueryFields ::
@@ -154,9 +157,8 @@ msBuildFunctionRelayQueryFields ::
   FunctionInfo 'MSSQL ->
   TableName 'MSSQL ->
   NESeq (ColumnInfo 'MSSQL) ->
-  SelPermInfo 'MSSQL ->
   m [a]
-msBuildFunctionRelayQueryFields _sourceName _functionName _functionInfo _tableName _pkeyColumns _selPerms =
+msBuildFunctionRelayQueryFields _sourceName _functionName _functionInfo _tableName _pkeyColumns =
   pure []
 
 msBuildFunctionMutationFields ::
@@ -165,9 +167,8 @@ msBuildFunctionMutationFields ::
   FunctionName 'MSSQL ->
   FunctionInfo 'MSSQL ->
   TableName 'MSSQL ->
-  SelPermInfo 'MSSQL ->
   m [a]
-msBuildFunctionMutationFields _ _ _ _ _ =
+msBuildFunctionMutationFields _ _ _ _ =
   pure []
 
 ----------------------------------------------------------------
@@ -179,11 +180,10 @@ msTableArgs ::
   MonadBuildSchema 'MSSQL r m n =>
   SourceName ->
   TableInfo 'MSSQL ->
-  SelPermInfo 'MSSQL ->
   m (InputFieldsParser n (IR.SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
-msTableArgs sourceName tableInfo selectPermissions = do
-  whereParser <- tableWhereArg sourceName tableInfo selectPermissions
-  orderByParser <- tableOrderByArg sourceName tableInfo selectPermissions
+msTableArgs sourceName tableInfo = do
+  whereParser <- tableWhereArg sourceName tableInfo
+  orderByParser <- tableOrderByArg sourceName tableInfo
   pure do
     whereArg <- whereParser
     orderByArg <- orderByParser
@@ -432,9 +432,9 @@ msComputedField ::
   SourceName ->
   ComputedFieldInfo 'MSSQL ->
   TableName 'MSSQL ->
-  SelPermInfo 'MSSQL ->
+  TableInfo 'MSSQL ->
   m (Maybe (FieldParser n (AnnotatedField 'MSSQL)))
-msComputedField _sourceName _fieldInfo _table _selectPemissions = pure Nothing
+msComputedField _sourceName _fieldInfo _table _tableInfo = pure Nothing
 
 -- | Remote join field parser.
 -- Currently unsupported: returns Nothing for now.

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

@@ -51,11 +51,9 @@ ifMatchedFieldParser ::
   MonadBuildSchema 'MSSQL r m n =>
   SourceName ->
   TableInfo 'MSSQL ->
-  Maybe (SelPermInfo 'MSSQL) ->
-  Maybe (UpdPermInfo 'MSSQL) ->
   m (InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
-ifMatchedFieldParser sourceName tableInfo selectPerms updatePerms = do
-  maybeObject <- ifMatchedObjectParser sourceName tableInfo selectPerms updatePerms
+ifMatchedFieldParser sourceName tableInfo = do
+  maybeObject <- ifMatchedObjectParser sourceName tableInfo
   return $ withJust maybeObject $ P.fieldOptional $$(G.litName "if_matched") (Just "upsert condition")
 
 -- | Parse a @tablename_if_matched@ object.
@@ -64,45 +62,35 @@ ifMatchedObjectParser ::
   (MonadBuildSchema 'MSSQL r m n) =>
   SourceName ->
   TableInfo 'MSSQL ->
-  Maybe (SelPermInfo 'MSSQL) ->
-  Maybe (UpdPermInfo 'MSSQL) ->
   m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
-ifMatchedObjectParser sourceName tableInfo maybeSelectPerms maybeUpdatePerms = runMaybeT do
+ifMatchedObjectParser sourceName tableInfo = runMaybeT do
   -- Short-circuit if we don't have sufficient permissions.
-  selectPerms <- hoistMaybe maybeSelectPerms
-  updatePerms <- hoistMaybe maybeUpdatePerms
-  matchColumnsEnum <- MaybeT $ tableInsertMatchColumnsEnum sourceName tableInfo selectPerms
-  updateColumnsEnum <- lift $ updateColumnsPlaceholderParser tableInfo updatePerms
+  updatePerms <- MaybeT $ (_permUpd =<<) <$> tablePermissions tableInfo
+  matchColumnsEnum <- MaybeT $ tableInsertMatchColumnsEnum sourceName tableInfo
+  lift do
+    updateColumnsEnum <- updateColumnsPlaceholderParser tableInfo
+    tableGQLName <- getTableGQLName tableInfo
+    objectName <- P.mkTypename $ tableGQLName <> $$(G.litName "_if_matched")
+    let _imColumnPresets = partialSQLExpToUnpreparedValue <$> upiSet updatePerms
+        updateFilter = fmap partialSQLExpToUnpreparedValue <$> upiFilter updatePerms
+        objectDesc = G.Description $ "upsert condition type for table " <>> tableInfoName tableInfo
+        matchColumnsName = $$(G.litName "match_columns")
+        updateColumnsName = $$(G.litName "update_columns")
+        whereName = $$(G.litName "where")
+    whereExpParser <- boolExp sourceName tableInfo
+    pure $
+      P.object objectName (Just objectDesc) do
+        _imConditions <-
+          (\whereExp -> BoolAnd $ updateFilter : maybeToList whereExp)
+            <$> P.fieldOptional whereName Nothing whereExpParser
+        _imMatchColumns <-
+          P.fieldWithDefault matchColumnsName Nothing (G.VList []) (P.list matchColumnsEnum)
+        _imUpdateColumns <-
+          P.fieldWithDefault updateColumnsName Nothing (G.VList []) (P.list updateColumnsEnum) `P.bindFields` \cs ->
+            -- this can only happen if the placeholder was used
+            sequenceA cs `onNothing` parseError "erroneous column name"
 
-  -- The style of the above code gives me some cognitive dissonance: We could
-  -- push the @hoistMaybe@ checks further away to callers, but not the enum
-  -- parsers, and as a result we end up with @MaybeT@ is a sort of local maximum
-  -- of legible expression.
-  -- See https://github.com/hasura/graphql-engine-mono/issues/3125.
-
-  tableGQLName <- getTableGQLName tableInfo
-  objectName <- P.mkTypename $ tableGQLName <> $$(G.litName "_if_matched")
-  let _imColumnPresets = partialSQLExpToUnpreparedValue <$> upiSet updatePerms
-      updateFilter = fmap partialSQLExpToUnpreparedValue <$> upiFilter updatePerms
-      objectDesc = G.Description $ "upsert condition type for table " <>> tableInfoName tableInfo
-      matchColumnsName = $$(G.litName "match_columns")
-      updateColumnsName = $$(G.litName "update_columns")
-      whereName = $$(G.litName "where")
-
-  whereExpParser <- lift $ boolExp sourceName tableInfo (Just selectPerms)
-  pure $
-    P.object objectName (Just objectDesc) $ do
-      _imConditions <-
-        (\whereExp -> BoolAnd $ updateFilter : maybeToList whereExp)
-          <$> P.fieldOptional whereName Nothing whereExpParser
-      _imMatchColumns <-
-        P.fieldWithDefault matchColumnsName Nothing (G.VList []) (P.list matchColumnsEnum)
-      _imUpdateColumns <-
-        P.fieldWithDefault updateColumnsName Nothing (G.VList []) (P.list updateColumnsEnum) `P.bindFields` \cs ->
-          -- this can only happen if the placeholder was used
-          sequenceA cs `onNothing` parseError "erroneous column name"
-
-      pure $ IfMatched {..}
+        pure $ IfMatched {..}
 
 -- | Table insert_match_columns enum
 --
@@ -117,11 +105,10 @@ tableInsertMatchColumnsEnum ::
   (MonadSchema n m, MonadRole r m, MonadTableInfo r m, Has P.MkTypename r) =>
   SourceName ->
   TableInfo 'MSSQL ->
-  SelPermInfo 'MSSQL ->
   m (Maybe (Parser 'Both n (Column 'MSSQL)))
-tableInsertMatchColumnsEnum sourceName tableInfo selectPermissions = do
+tableInsertMatchColumnsEnum sourceName tableInfo = do
   tableGQLName <- getTableGQLName @'MSSQL tableInfo
-  columns <- tableSelectColumns sourceName tableInfo selectPermissions
+  columns <- tableSelectColumns sourceName tableInfo
   enumName <- P.mkTypename $ tableGQLName <> $$(G.litName "_insert_match_column")
   let description =
         Just $