{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | MSSQL Instances Types
--
-- Defines a 'Hasura.RQL.Types.Backend.Backend' type class instance for MSSQL.
module Hasura.Backends.MSSQL.Instances.Types () where

import Autodocodec (codec)
import Data.Aeson
import Data.Text.Casing (GQLNameIdentifier)
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Connection qualified as MSSQL
import Hasura.Backends.MSSQL.ToQuery ()
import Hasura.Backends.MSSQL.Types.Insert qualified as MSSQL (BackendInsert)
import Hasura.Backends.MSSQL.Types.Internal qualified as MSSQL
import Hasura.Backends.MSSQL.Types.Update qualified as MSSQL (UpdateOperator)
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.Update.Batch (UpdateBatch)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common (TriggerOnReplication (..))
import Hasura.RQL.Types.HealthCheck
import Hasura.RQL.Types.HealthCheckImplementation (HealthCheckImplementation (..))
import Hasura.RQL.Types.ResizePool (ServerReplicas, SourceResizePoolSummary (..))
import Language.GraphQL.Draft.Syntax qualified as G

instance Backend 'MSSQL where
  type BackendConfig 'MSSQL = ()
  type BackendInfo 'MSSQL = ()
  type TableName 'MSSQL = MSSQL.TableName
  type RawFunctionInfo 'MSSQL = Void

  -- It's something of a wart that we have to
  -- specify this here, as we don't support functions for MSSQL.
  type FunctionName 'MSSQL = MSSQL.FunctionName
  type FunctionArgument 'MSSQL = Void
  type ConstraintName 'MSSQL = MSSQL.ConstraintName
  type BasicOrderType 'MSSQL = MSSQL.Order
  type NullsOrderType 'MSSQL = MSSQL.NullsOrder
  type CountType 'MSSQL = Const (MSSQL.Countable MSSQL.ColumnName) -- TODO(redactionExp): Going to need to replace this Const with a fixed up type here
  type Column 'MSSQL = MSSQL.ColumnName
  type ScalarValue 'MSSQL = MSSQL.Value
  type ScalarType 'MSSQL = MSSQL.ScalarType
  type BooleanOperators 'MSSQL = MSSQL.BooleanOperators
  type SQLExpression 'MSSQL = MSSQL.Expression
  type ScalarSelectionArguments 'MSSQL = Void

  type ComputedFieldDefinition 'MSSQL = Void
  type FunctionArgumentExp 'MSSQL = Const Void
  type ComputedFieldImplicitArguments 'MSSQL = Void
  type ComputedFieldReturn 'MSSQL = Void

  type ExtraTableMetadata 'MSSQL = [MSSQL.ColumnName] -- List of identity columns
  type BackendInsert 'MSSQL = MSSQL.BackendInsert
  type UpdateVariant 'MSSQL = UpdateBatch 'MSSQL MSSQL.UpdateOperator

  type XComputedField 'MSSQL = XDisable
  type XRelay 'MSSQL = XDisable
  type XNodesAgg 'MSSQL = XEnable
  type XEventTriggers 'MSSQL = XEnable
  type XNestedInserts 'MSSQL = XDisable
  type XStreamingSubscription 'MSSQL = XDisable

  type HealthCheckTest 'MSSQL = HealthCheckTestSql
  healthCheckImplementation :: Maybe (HealthCheckImplementation (HealthCheckTest 'MSSQL))
healthCheckImplementation =
    HealthCheckImplementation (HealthCheckTest 'MSSQL)
-> Maybe (HealthCheckImplementation (HealthCheckTest 'MSSQL))
forall a. a -> Maybe a
Just
      (HealthCheckImplementation (HealthCheckTest 'MSSQL)
 -> Maybe (HealthCheckImplementation (HealthCheckTest 'MSSQL)))
-> HealthCheckImplementation (HealthCheckTest 'MSSQL)
-> Maybe (HealthCheckImplementation (HealthCheckTest 'MSSQL))
forall a b. (a -> b) -> a -> b
$ HealthCheckImplementation
        { _hciDefaultTest :: HealthCheckTestSql
_hciDefaultTest = HealthCheckTestSql
defaultHealthCheckTestSql,
          _hciTestCodec :: JSONCodec HealthCheckTestSql
_hciTestCodec = JSONCodec HealthCheckTestSql
forall value. HasCodec value => JSONCodec value
codec
        }

  isComparableType :: ScalarType 'MSSQL -> Bool
  isComparableType :: ScalarType 'MSSQL -> Bool
isComparableType = ScalarType 'MSSQL -> Bool
ScalarType -> Bool
MSSQL.isComparableType

  isNumType :: ScalarType 'MSSQL -> Bool
  isNumType :: ScalarType 'MSSQL -> Bool
isNumType = ScalarType 'MSSQL -> Bool
ScalarType -> Bool
MSSQL.isNumType

  textToScalarValue :: Maybe Text -> ScalarValue 'MSSQL
  textToScalarValue :: Maybe Text -> ScalarValue 'MSSQL
textToScalarValue = Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
ODBC.NullValue Text -> Value
ODBC.TextValue

  parseScalarValue :: ScalarTypeParsingContext 'MSSQL -> ScalarType 'MSSQL -> Value -> Either QErr (ScalarValue 'MSSQL)
  parseScalarValue :: ScalarTypeParsingContext 'MSSQL
-> ScalarType 'MSSQL -> Value -> Either QErr (ScalarValue 'MSSQL)
parseScalarValue = (ScalarType -> Value -> Either QErr Value)
-> () -> ScalarType -> Value -> Either QErr Value
forall a b. a -> b -> a
const ScalarType -> Value -> Either QErr Value
MSSQL.parseScalarValue

  -- TODO: Is this Postgres specific? Should it be removed from the class?
  scalarValueToJSON :: ScalarValue 'MSSQL -> Value
  scalarValueToJSON :: ScalarValue 'MSSQL -> Value
scalarValueToJSON = String -> Value -> Value
forall a. HasCallStack => String -> a
error String
"Unexpected MSSQL error: calling scalarValueToJSON. Please report this error at https://github.com/hasura/graphql-engine/issues/6590"

  functionToTable :: FunctionName 'MSSQL -> TableName 'MSSQL
  functionToTable :: FunctionName 'MSSQL -> TableName 'MSSQL
functionToTable = String -> FunctionName -> TableName
forall a. HasCallStack => String -> a
error String
"Unexpected MSSQL error: calling functionToTable. Please report this error at https://github.com/hasura/graphql-engine/issues/6590"

  tableToFunction :: TableName 'MSSQL -> FunctionName 'MSSQL
  tableToFunction :: TableName 'MSSQL -> FunctionName 'MSSQL
tableToFunction TableName 'MSSQL
tn = Text -> SchemaName -> FunctionName
MSSQL.FunctionName (TableName -> Text
MSSQL.tableName TableName 'MSSQL
TableName
tn) (TableName -> SchemaName
MSSQL.tableSchema TableName 'MSSQL
TableName
tn)

  tableGraphQLName :: TableName 'MSSQL -> Either QErr G.Name
  tableGraphQLName :: TableName 'MSSQL -> Either QErr Name
tableGraphQLName = TableName 'MSSQL -> Either QErr Name
TableName -> Either QErr Name
MSSQL.getGQLTableName

  functionGraphQLName :: FunctionName 'MSSQL -> Either QErr G.Name
  functionGraphQLName :: FunctionName 'MSSQL -> Either QErr Name
functionGraphQLName = String -> FunctionName -> Either QErr Name
forall a. HasCallStack => String -> a
error String
"Unexpected MSSQL error: calling functionGraphQLName. Please report this error at https://github.com/hasura/graphql-engine/issues/6590"

  snakeCaseTableName :: TableName 'MSSQL -> Text
  snakeCaseTableName :: TableName 'MSSQL -> Text
snakeCaseTableName TableName 'MSSQL
tn = Text -> SchemaName -> Text
MSSQL.snakeCaseName (TableName -> Text
MSSQL.tableName TableName 'MSSQL
TableName
tn) (TableName -> SchemaName
MSSQL.tableSchema TableName 'MSSQL
TableName
tn)

  getTableIdentifier :: TableName 'MSSQL -> Either QErr GQLNameIdentifier
  getTableIdentifier :: TableName 'MSSQL -> Either QErr GQLNameIdentifier
getTableIdentifier = TableName 'MSSQL -> Either QErr GQLNameIdentifier
TableName -> Either QErr GQLNameIdentifier
MSSQL.getTableIdentifier

  namingConventionSupport :: SupportedNamingCase
  namingConventionSupport :: SupportedNamingCase
namingConventionSupport = SupportedNamingCase
OnlyHasuraCase

  computedFieldFunction :: ComputedFieldDefinition 'MSSQL -> FunctionName 'MSSQL
  computedFieldFunction :: ComputedFieldDefinition 'MSSQL -> FunctionName 'MSSQL
computedFieldFunction = XDisable -> FunctionName
ComputedFieldDefinition 'MSSQL -> FunctionName 'MSSQL
forall a. XDisable -> a
absurd

  computedFieldReturnType :: ComputedFieldReturn 'MSSQL -> ComputedFieldReturnType 'MSSQL
  computedFieldReturnType :: ComputedFieldReturn 'MSSQL -> ComputedFieldReturnType 'MSSQL
computedFieldReturnType = XDisable -> ComputedFieldReturnType 'MSSQL
ComputedFieldReturn 'MSSQL -> ComputedFieldReturnType 'MSSQL
forall a. XDisable -> a
absurd

  fromComputedFieldImplicitArguments :: v -> ComputedFieldImplicitArguments 'MSSQL -> [FunctionArgumentExp 'MSSQL v]
  fromComputedFieldImplicitArguments :: forall v.
v
-> ComputedFieldImplicitArguments 'MSSQL
-> [FunctionArgumentExp 'MSSQL v]
fromComputedFieldImplicitArguments v
_ = XDisable -> [Const XDisable v]
ComputedFieldImplicitArguments 'MSSQL
-> [FunctionArgumentExp 'MSSQL v]
forall a. XDisable -> a
absurd

  resizeSourcePools :: SourceConfig 'MSSQL -> ServerReplicas -> IO SourceResizePoolSummary
  resizeSourcePools :: SourceConfig 'MSSQL -> ServerReplicas -> IO SourceResizePoolSummary
resizeSourcePools SourceConfig 'MSSQL
sourceConfig = MSSQLExecCtx -> ServerReplicas -> IO SourceResizePoolSummary
MSSQL.mssqlResizePools (MSSQLSourceConfig -> MSSQLExecCtx
MSSQL._mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig)

  defaultTriggerOnReplication :: Maybe (XEventTriggers 'MSSQL, TriggerOnReplication)
defaultTriggerOnReplication = ((), TriggerOnReplication) -> Maybe ((), TriggerOnReplication)
forall a. a -> Maybe a
Just ((), TriggerOnReplication
TOREnableTrigger)

instance HasSourceConfiguration 'MSSQL where
  type SourceConfig 'MSSQL = MSSQL.MSSQLSourceConfig
  type SourceConnConfiguration 'MSSQL = MSSQL.MSSQLConnConfiguration
  sourceConfigNumReadReplicas :: SourceConfig 'MSSQL -> Int
sourceConfigNumReadReplicas = MSSQLSourceConfig -> Int
SourceConfig 'MSSQL -> Int
MSSQL._mscReadReplicas
  sourceConfigConnectonTemplateEnabled :: SourceConfig 'MSSQL -> Bool
sourceConfigConnectonTemplateEnabled = Bool -> MSSQLSourceConfig -> Bool
forall a b. a -> b -> a
const Bool
False -- not supported
  sourceConfigBackendSourceKind :: SourceConfig 'MSSQL -> BackendSourceKind 'MSSQL
sourceConfigBackendSourceKind SourceConfig 'MSSQL
_sourceConfig = BackendSourceKind 'MSSQL
MSSQLKind