-- | 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,
    getStoredProcedureGraphqlName,
    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.Function.Cache
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types
import Hasura.Server.Utils
import Hasura.Session
import Hasura.StoredProcedure.Types
import Hasura.Table.Cache
import Language.GraphQL.Draft.Syntax qualified as G

buildComputedFieldInfo ::
  (MonadError QErr m) =>
  HashSet (TableName 'MSSQL) ->
  TableName 'MSSQL ->
  HashSet (Column 'MSSQL) ->
  ComputedFieldName ->
  ComputedFieldDefinition 'MSSQL ->
  RawFunctionInfo 'MSSQL ->
  Comment ->
  m (ComputedFieldInfo 'MSSQL)
buildComputedFieldInfo :: forall (m :: * -> *).
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
_ =
  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 :: forall (m :: * -> *).
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]
_ =
  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 'MSSQL ->
  FunctionPermissionsMap ->
  RawFunctionInfo 'MSSQL ->
  Maybe Text ->
  NamingCase ->
  m (FunctionInfo 'MSSQL, SchemaDependency)
buildFunctionInfo :: forall (m :: * -> *).
MonadError QErr m =>
SourceName
-> FunctionName 'MSSQL
-> SystemDefined
-> FunctionConfig 'MSSQL
-> FunctionPermissionsMap
-> RawFunctionInfo 'MSSQL
-> Maybe Text
-> NamingCase
-> m (FunctionInfo 'MSSQL, SchemaDependency)
buildFunctionInfo SourceName
_ FunctionName 'MSSQL
_ SystemDefined
_ FunctionConfig 'MSSQL
_ 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 :: forall (m :: * -> *).
MonadError QErr m =>
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 a. a -> m a
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 a. a -> m a
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 ->
      SQLExpression 'MSSQL -> PartialSQLExp 'MSSQL
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
<$> ScalarTypeParsingContext 'MSSQL
-> ColumnType 'MSSQL -> Value -> m (ScalarValue 'MSSQL)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnTypeWithContext () 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

getStoredProcedureGraphqlName ::
  (MonadError QErr m) =>
  MT.FunctionName ->
  StoredProcedureConfig ->
  m G.Name
getStoredProcedureGraphqlName :: forall (m :: * -> *).
MonadError QErr m =>
FunctionName -> StoredProcedureConfig -> m Name
getStoredProcedureGraphqlName FunctionName
spname =
  m Name -> (Name -> m Name) -> Maybe Name -> m Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either QErr Name -> m Name
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr Name -> m Name) -> Either QErr Name -> m Name
forall a b. (a -> b) -> a -> b
$ FunctionName -> Either QErr Name
MT.getGQLFunctionName FunctionName
spname) Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> m Name)
-> (StoredProcedureConfig -> Maybe Name)
-> StoredProcedureConfig
-> m Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredProcedureConfig -> Maybe Name
_spcCustomName