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

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE TemplateHaskell #-}

-- | 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.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 r m n.
  MonadBuildSchemaBase r m n =>
  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