-- | MSSQL DDL
--
-- Implements the DDL related methods of the
-- 'Hasura.RQL.Types.Metadata.Backend.BackendMetadata' type class
-- for the MSSQL backend, which provides an interface for fetching information about
-- the objects in the database, such as tables, relationships, etc.
--
-- The actual instance is defined in "Hasura.Backends.MSSQL.Instances.Metadata".
module Hasura.Backends.MSSQL.DDL
  ( buildComputedFieldInfo,
    fetchAndValidateEnumValues,
    buildFunctionInfo,
    updateColumnInEventTrigger,
    parseCollectableType,
    module M,
  )
where

import Data.Aeson
import Hasura.Backends.MSSQL.DDL.BoolExp as M
import Hasura.Backends.MSSQL.DDL.Source as M
import Hasura.Backends.MSSQL.Types.Internal qualified as MT
import Hasura.Base.Error
import Hasura.GraphQL.Schema.NamingCase
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Server.Utils
import Hasura.Session

buildComputedFieldInfo ::
  (MonadError QErr m) =>
  HashSet (TableName 'MSSQL) ->
  TableName 'MSSQL ->
  HashSet (Column 'MSSQL) ->
  ComputedFieldName ->
  ComputedFieldDefinition 'MSSQL ->
  RawFunctionInfo 'MSSQL ->
  Comment ->
  m (ComputedFieldInfo 'MSSQL)
buildComputedFieldInfo :: HashSet (TableName 'MSSQL)
-> TableName 'MSSQL
-> HashSet (Column 'MSSQL)
-> ComputedFieldName
-> ComputedFieldDefinition 'MSSQL
-> RawFunctionInfo 'MSSQL
-> Comment
-> m (ComputedFieldInfo 'MSSQL)
buildComputedFieldInfo HashSet (TableName 'MSSQL)
_ TableName 'MSSQL
_ HashSet (Column 'MSSQL)
_ ComputedFieldName
_ ComputedFieldDefinition 'MSSQL
_ RawFunctionInfo 'MSSQL
_ Comment
_ =
  Code -> Text -> m (ComputedFieldInfo 'MSSQL)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Computed fields aren't supported for MSSQL sources"

fetchAndValidateEnumValues ::
  (Monad m) =>
  SourceConfig 'MSSQL ->
  TableName 'MSSQL ->
  Maybe (PrimaryKey 'MSSQL (RawColumnInfo 'MSSQL)) ->
  [RawColumnInfo 'MSSQL] ->
  m (Either QErr EnumValues)
fetchAndValidateEnumValues :: SourceConfig 'MSSQL
-> TableName 'MSSQL
-> Maybe (PrimaryKey 'MSSQL (RawColumnInfo 'MSSQL))
-> [RawColumnInfo 'MSSQL]
-> m (Either QErr EnumValues)
fetchAndValidateEnumValues SourceConfig 'MSSQL
_ TableName 'MSSQL
_ Maybe (PrimaryKey 'MSSQL (RawColumnInfo 'MSSQL))
_ [RawColumnInfo 'MSSQL]
_ =
  ExceptT QErr m EnumValues -> m (Either QErr EnumValues)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m EnumValues -> m (Either QErr EnumValues))
-> ExceptT QErr m EnumValues -> m (Either QErr EnumValues)
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> ExceptT QErr m EnumValues
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Enum tables are not supported for MSSQL sources"

buildFunctionInfo ::
  (MonadError QErr m) =>
  SourceName ->
  FunctionName 'MSSQL ->
  SystemDefined ->
  FunctionConfig ->
  FunctionPermissionsMap ->
  RawFunctionInfo 'MSSQL ->
  Maybe Text ->
  NamingCase ->
  m (FunctionInfo 'MSSQL, SchemaDependency)
buildFunctionInfo :: SourceName
-> FunctionName 'MSSQL
-> SystemDefined
-> FunctionConfig
-> FunctionPermissionsMap
-> RawFunctionInfo 'MSSQL
-> Maybe Text
-> NamingCase
-> m (FunctionInfo 'MSSQL, SchemaDependency)
buildFunctionInfo SourceName
_ FunctionName 'MSSQL
_ SystemDefined
_ FunctionConfig
_ FunctionPermissionsMap
_ RawFunctionInfo 'MSSQL
_ Maybe Text
_ NamingCase
_ =
  Code -> Text -> m (FunctionInfo 'MSSQL, SchemaDependency)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"SQL Functions are not supported for MSSQL source"

updateColumnInEventTrigger ::
  TableName 'MSSQL ->
  Column 'MSSQL ->
  Column 'MSSQL ->
  TableName 'MSSQL ->
  EventTriggerConf 'MSSQL ->
  EventTriggerConf 'MSSQL
updateColumnInEventTrigger :: TableName 'MSSQL
-> Column 'MSSQL
-> Column 'MSSQL
-> TableName 'MSSQL
-> EventTriggerConf 'MSSQL
-> EventTriggerConf 'MSSQL
updateColumnInEventTrigger TableName 'MSSQL
_ Column 'MSSQL
_ Column 'MSSQL
_ TableName 'MSSQL
_ = EventTriggerConf 'MSSQL -> EventTriggerConf 'MSSQL
forall a. a -> a
id

parseCollectableType ::
  (MonadError QErr m) =>
  CollectableType (ColumnType 'MSSQL) ->
  Value ->
  m (PartialSQLExp 'MSSQL)
parseCollectableType :: CollectableType (ColumnType 'MSSQL)
-> Value -> m (PartialSQLExp 'MSSQL)
parseCollectableType CollectableType (ColumnType 'MSSQL)
collectableType = \case
  String Text
t
    | Text -> Bool
isSessionVariable Text
t -> PartialSQLExp 'MSSQL -> m (PartialSQLExp 'MSSQL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialSQLExp 'MSSQL -> m (PartialSQLExp 'MSSQL))
-> PartialSQLExp 'MSSQL -> m (PartialSQLExp 'MSSQL)
forall a b. (a -> b) -> a -> b
$ CollectableType (ColumnType 'MSSQL)
-> SessionVariable -> PartialSQLExp 'MSSQL
mkTypedSessionVar CollectableType (ColumnType 'MSSQL)
collectableType (SessionVariable -> PartialSQLExp 'MSSQL)
-> SessionVariable -> PartialSQLExp 'MSSQL
forall a b. (a -> b) -> a -> b
$ Text -> SessionVariable
mkSessionVariable Text
t
    | Text -> Bool
isReqUserId Text
t -> PartialSQLExp 'MSSQL -> m (PartialSQLExp 'MSSQL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialSQLExp 'MSSQL -> m (PartialSQLExp 'MSSQL))
-> PartialSQLExp 'MSSQL -> m (PartialSQLExp 'MSSQL)
forall a b. (a -> b) -> a -> b
$ CollectableType (ColumnType 'MSSQL)
-> SessionVariable -> PartialSQLExp 'MSSQL
mkTypedSessionVar CollectableType (ColumnType 'MSSQL)
collectableType SessionVariable
forall a. IsString a => a
userIdHeader
  Value
val -> case CollectableType (ColumnType 'MSSQL)
collectableType of
    CollectableTypeScalar ColumnType 'MSSQL
scalarType ->
      Expression -> PartialSQLExp 'MSSQL
forall (backend :: BackendType).
SQLExpression backend -> PartialSQLExp backend
PSESQLExp (Expression -> PartialSQLExp 'MSSQL)
-> (Value -> Expression) -> Value -> PartialSQLExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Expression
MT.ValueExpression (Value -> PartialSQLExp 'MSSQL)
-> m Value -> m (PartialSQLExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'MSSQL -> Value -> m (ScalarValue 'MSSQL)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnType ColumnType 'MSSQL
scalarType Value
val
    CollectableTypeArray ColumnType 'MSSQL
_ ->
      Code -> Text -> m (PartialSQLExp 'MSSQL)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array types are not supported in MSSQL backend"

mkTypedSessionVar ::
  CollectableType (ColumnType 'MSSQL) ->
  SessionVariable ->
  PartialSQLExp 'MSSQL
mkTypedSessionVar :: CollectableType (ColumnType 'MSSQL)
-> SessionVariable -> PartialSQLExp 'MSSQL
mkTypedSessionVar CollectableType (ColumnType 'MSSQL)
columnType =
  SessionVarType 'MSSQL -> SessionVariable -> PartialSQLExp 'MSSQL
forall (backend :: BackendType).
SessionVarType backend -> SessionVariable -> PartialSQLExp backend
PSESessVar (ColumnType 'MSSQL -> ScalarType 'MSSQL
ColumnType 'MSSQL -> ScalarType
msColumnTypeToScalarType (ColumnType 'MSSQL -> ScalarType)
-> CollectableType (ColumnType 'MSSQL)
-> CollectableType ScalarType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CollectableType (ColumnType 'MSSQL)
columnType)

msColumnTypeToScalarType :: ColumnType 'MSSQL -> ScalarType 'MSSQL
msColumnTypeToScalarType :: ColumnType 'MSSQL -> ScalarType 'MSSQL
msColumnTypeToScalarType = \case
  ColumnScalar ScalarType 'MSSQL
scalarType -> ScalarType 'MSSQL
scalarType
  ColumnEnumReference EnumReference 'MSSQL
_ -> ScalarType 'MSSQL
ScalarType
MT.TextType