graphql-engine/server/src-lib/Hasura/Backends/MSSQL/Schema/IfMatched.hs
Auke Booij f026d44438 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 hasura/graphql-engine@5168b99e46 in hasura/graphql-engine#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: https://github.com/hasura/graphql-engine-mono/pull/3608
GitOrigin-RevId: 51a744f34ec7d57bc8077667ae7f9cb9c4f6c962
2022-02-17 08:17:17 +00:00

136 lines
5.1 KiB
Haskell

{-# LANGUAGE ApplicativeDo #-}
-- | MSSQL Schema IfMatched
--
-- This module contains the building blocks for parsing @if_matched@ clauses
-- (represented as 'IfMatched'), which in the MSSQL backend are used to
-- implement upsert functionality.
--
-- These are used by 'Hasura.Backends.MSSQL.Instances.Schema.backendInsertParser' to
-- construct a mssql-specific schema parser for insert (and upsert) mutations.
module Hasura.Backends.MSSQL.Schema.IfMatched
( ifMatchedFieldParser,
)
where
import Data.Has
import Data.Text.Extended
import Hasura.Backends.MSSQL.Types.Insert
import Hasura.Backends.MSSQL.Types.Internal (ScalarType (..))
import Hasura.GraphQL.Parser
( InputFieldsParser,
Kind (..),
Parser,
UnpreparedValue (..),
)
import Hasura.GraphQL.Parser qualified as P
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.BoolExp
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Table
import Hasura.Prelude
import Hasura.RQL.Types
import Language.GraphQL.Draft.Syntax qualified as G
-- | Field-parser for:
--
-- > if_matched: tablename_if_matched
-- >
-- > input tablename_if_matched {
-- > match_columns: [tablename_select_column!]
-- > update_columns: [tablename_update_columns!]
-- > where: tablename_bool_exp
-- > }
--
-- Note that the types ordinarily produced by this parser are only created if
-- the active role has /both/ select and update permissions to the table
-- @tablename@ defined /and/ these grant non-empty column permissions.
ifMatchedFieldParser ::
forall r m n.
MonadBuildSchema 'MSSQL r m n =>
SourceName ->
TableInfo 'MSSQL ->
m (InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
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.
ifMatchedObjectParser ::
forall r m n.
(MonadBuildSchema 'MSSQL r m n) =>
SourceName ->
TableInfo 'MSSQL ->
m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser sourceName tableInfo = runMaybeT do
-- Short-circuit if we don't have sufficient permissions.
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"
pure $ IfMatched {..}
-- | Table insert_match_columns enum
--
-- Parser for an enum type that matches the columns that can be used
-- for insert match_columns for a given table.
-- Maps to the insert_match_columns object.
--
-- Return Nothing if there's no column the current user has "select"
-- permissions for.
tableInsertMatchColumnsEnum ::
forall m n r.
(MonadSchema n m, MonadRole r m, MonadTableInfo r m, Has P.MkTypename r) =>
SourceName ->
TableInfo 'MSSQL ->
m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum sourceName tableInfo = do
tableGQLName <- getTableGQLName @'MSSQL tableInfo
columns <- tableSelectColumns sourceName tableInfo
enumName <- P.mkTypename $ tableGQLName <> $$(G.litName "_insert_match_column")
let description =
Just $
G.Description $
"select match_columns of table " <>> tableInfoName tableInfo
pure $
P.enum enumName description
<$> nonEmpty
[ ( define $ ciName column,
ciColumn column
)
| column <- columns,
isMatchColumnValid column
]
where
define name =
P.Definition name (Just $ G.Description "column name") P.EnumValueInfo
-- | Check whether a column can be used for match_columns.
isMatchColumnValid :: ColumnInfo 'MSSQL -> Bool
isMatchColumnValid = \case
-- Unfortunately MSSQL does not support comparison for TEXT types.
ColumnInfo {ciType = ColumnScalar TextType} -> False
_ -> True