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

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

import Autodocodec (HasCodec (codec))
import Data.Aeson (FromJSON)
import Data.Aeson qualified as J
import Data.Environment qualified as Env
import Data.Kind (Type)
import Data.Typeable
import Hasura.Backends.Postgres.Connection qualified as Postgres
import Hasura.Backends.Postgres.Connection.VersionCheck (runCockroachVersionCheck)
import Hasura.Backends.Postgres.Execute.ConnectionTemplate qualified as Postgres
import Hasura.Backends.Postgres.Instances.PingSource (runCockroachDBPing)
import Hasura.Backends.Postgres.SQL.DML qualified as Postgres
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres
import Hasura.Backends.Postgres.SQL.Value qualified as Postgres
import Hasura.Backends.Postgres.Types.Aggregates qualified as Postgres
import Hasura.Backends.Postgres.Types.BoolExp qualified as Postgres
import Hasura.Backends.Postgres.Types.CitusExtraTableMetadata qualified as Citus
import Hasura.Backends.Postgres.Types.ComputedField qualified as Postgres
import Hasura.Backends.Postgres.Types.Function qualified as Postgres
import Hasura.Backends.Postgres.Types.Insert qualified as Postgres (BackendInsert)
import Hasura.Backends.Postgres.Types.Update qualified as Postgres
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp.AggregationPredicates qualified as Agg
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common (SourceName, TriggerOnReplication (..))
import Hasura.RQL.Types.HealthCheck
import Hasura.RQL.Types.HealthCheckImplementation (HealthCheckImplementation (..))

--------------------------------------------------------------------------------
-- PostgresBackend

-- | This class is an implementation detail of 'Backend'.
-- Some types of 'Backend' differ across different Postgres "kinds". This
-- class alllows each "kind" to specify its own specific implementation. All
-- common code is directly part of the `Backend` instance.
--
-- Note: Users shouldn't ever put this as a constraint. Use `Backend ('Postgres
-- pgKind)` instead.
class
  ( Representable (PgExtraTableMetadata pgKind),
    J.ToJSON (PgExtraTableMetadata pgKind),
    J.FromJSON (PgExtraTableMetadata pgKind)
  ) =>
  PostgresBackend (pgKind :: PostgresKind)
  where
  type PgExtraTableMetadata pgKind :: Type

  versionCheckImpl :: Env.Environment -> SourceConnConfiguration ('Postgres pgKind) -> IO (Either QErr ())
  versionCheckImpl = (SourceConnConfiguration ('Postgres pgKind) -> IO (Either QErr ()))
-> Environment
-> SourceConnConfiguration ('Postgres pgKind)
-> IO (Either QErr ())
forall a b. a -> b -> a
const ((SourceConnConfiguration ('Postgres pgKind)
  -> IO (Either QErr ()))
 -> Environment
 -> SourceConnConfiguration ('Postgres pgKind)
 -> IO (Either QErr ()))
-> (SourceConnConfiguration ('Postgres pgKind)
    -> IO (Either QErr ()))
-> Environment
-> SourceConnConfiguration ('Postgres pgKind)
-> IO (Either QErr ())
forall a b. (a -> b) -> a -> b
$ IO (Either QErr ())
-> PostgresConnConfiguration -> IO (Either QErr ())
forall a b. a -> b -> a
const (Either QErr () -> IO (Either QErr ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr () -> IO (Either QErr ()))
-> Either QErr () -> IO (Either QErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either QErr ()
forall a b. b -> Either a b
Right ())

  runPingSourceImpl :: Env.Environment -> (String -> IO ()) -> SourceName -> SourceConnConfiguration ('Postgres pgKind) -> IO ()
  runPingSourceImpl Environment
_ String -> IO ()
_ SourceName
_ SourceConnConfiguration ('Postgres pgKind)
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance PostgresBackend 'Vanilla where
  type PgExtraTableMetadata 'Vanilla = Postgres.PGExtraTableMetadata

instance PostgresBackend 'Citus where
  type PgExtraTableMetadata 'Citus = Citus.ExtraTableMetadata

instance PostgresBackend 'Cockroach where
  type PgExtraTableMetadata 'Cockroach = Postgres.PGExtraTableMetadata
  versionCheckImpl :: Environment
-> SourceConnConfiguration ('Postgres 'Cockroach)
-> IO (Either QErr ())
versionCheckImpl = Environment
-> SourceConnConfiguration ('Postgres 'Cockroach)
-> IO (Either QErr ())
Environment -> PostgresConnConfiguration -> IO (Either QErr ())
runCockroachVersionCheck
  runPingSourceImpl :: Environment
-> (String -> IO ())
-> SourceName
-> SourceConnConfiguration ('Postgres 'Cockroach)
-> IO ()
runPingSourceImpl = Environment
-> (String -> IO ())
-> SourceName
-> SourceConnConfiguration ('Postgres 'Cockroach)
-> IO ()
Environment
-> (String -> IO ())
-> SourceName
-> PostgresConnConfiguration
-> IO ()
runCockroachDBPing

----------------------------------------------------------------
-- Backend instance

instance
  ( HasTag ('Postgres pgKind),
    Typeable ('Postgres pgKind),
    PostgresBackend pgKind,
    FromJSON (BackendSourceKind ('Postgres pgKind)),
    HasCodec (BackendSourceKind ('Postgres pgKind))
  ) =>
  Backend ('Postgres pgKind)
  where
  type BackendConfig ('Postgres pgKind) = ()
  type BackendInfo ('Postgres pgKind) = ()
  type TableName ('Postgres pgKind) = Postgres.QualifiedTable
  type FunctionName ('Postgres pgKind) = Postgres.QualifiedFunction
  type FunctionArgument ('Postgres pgKind) = Postgres.FunctionArg
  type RawFunctionInfo ('Postgres pgKind) = Postgres.PGRawFunctionInfo
  type ConstraintName ('Postgres pgKind) = Postgres.ConstraintName
  type BasicOrderType ('Postgres pgKind) = Postgres.OrderType
  type NullsOrderType ('Postgres pgKind) = Postgres.NullsOrder
  type CountType ('Postgres pgKind) = Postgres.CountAggregate pgKind
  type Column ('Postgres pgKind) = Postgres.PGCol
  type ScalarValue ('Postgres pgKind) = Postgres.PGScalarValue
  type ScalarType ('Postgres pgKind) = Postgres.PGScalarType
  type BooleanOperators ('Postgres pgKind) = Postgres.BooleanOperators
  type SQLExpression ('Postgres pgKind) = Postgres.SQLExp
  type ComputedFieldDefinition ('Postgres pgKind) = Postgres.ComputedFieldDefinition
  type ScalarSelectionArguments ('Postgres pgKind) = Postgres.ColumnOp

  type FunctionArgumentExp ('Postgres pgKind) = Postgres.ArgumentExp
  type ComputedFieldImplicitArguments ('Postgres pgKind) = Postgres.ComputedFieldImplicitArguments
  type ComputedFieldReturn ('Postgres pgKind) = Postgres.ComputedFieldReturn

  type UpdateVariant ('Postgres pgKind) = Postgres.PgUpdateVariant pgKind

  type AggregationPredicates ('Postgres pgKind) = Agg.AggregationPredicatesImplementation ('Postgres pgKind)

  type ExtraTableMetadata ('Postgres pgKind) = PgExtraTableMetadata pgKind
  type BackendInsert ('Postgres pgKind) = Postgres.BackendInsert pgKind

  type XComputedField ('Postgres pgKind) = XEnable
  type XRelay ('Postgres pgKind) = XEnable
  type XNodesAgg ('Postgres pgKind) = XEnable
  type XEventTriggers ('Postgres pgKind) = XEnable
  type XNestedInserts ('Postgres pgKind) = XEnable
  type XStreamingSubscription ('Postgres pgKind) = XEnable
  type XGroupBy ('Postgres pgKind) = XEnable

  type ResolvedConnectionTemplate ('Postgres pgKind) = Maybe Postgres.PostgresResolvedConnectionTemplate -- 'Nothing' represents no connection template configured
  type ConnectionTemplateRequestContext ('Postgres pgKind) = Postgres.RequestContext

  type HealthCheckTest ('Postgres pgKind) = HealthCheckTestSql
  healthCheckImplementation :: Maybe
  (HealthCheckImplementation (HealthCheckTest ('Postgres pgKind)))
healthCheckImplementation =
    HealthCheckImplementation (HealthCheckTest ('Postgres pgKind))
-> Maybe
     (HealthCheckImplementation (HealthCheckTest ('Postgres pgKind)))
forall a. a -> Maybe a
Just
      (HealthCheckImplementation (HealthCheckTest ('Postgres pgKind))
 -> Maybe
      (HealthCheckImplementation (HealthCheckTest ('Postgres pgKind))))
-> HealthCheckImplementation (HealthCheckTest ('Postgres pgKind))
-> Maybe
     (HealthCheckImplementation (HealthCheckTest ('Postgres pgKind)))
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
        }

  supportsAggregateComputedFields :: Bool
supportsAggregateComputedFields = Bool
True
  versionCheckImplementation :: Environment
-> SourceConnConfiguration ('Postgres pgKind)
-> IO (Either QErr ())
versionCheckImplementation = forall (pgKind :: PostgresKind).
PostgresBackend pgKind =>
Environment
-> SourceConnConfiguration ('Postgres pgKind)
-> IO (Either QErr ())
versionCheckImpl @pgKind
  runPingSource :: Environment
-> (String -> IO ())
-> SourceName
-> SourceConnConfiguration ('Postgres pgKind)
-> IO ()
runPingSource = forall (pgKind :: PostgresKind).
PostgresBackend pgKind =>
Environment
-> (String -> IO ())
-> SourceName
-> SourceConnConfiguration ('Postgres pgKind)
-> IO ()
runPingSourceImpl @pgKind
  isComparableType :: ScalarType ('Postgres pgKind) -> Bool
isComparableType = ScalarType ('Postgres pgKind) -> Bool
PGScalarType -> Bool
Postgres.isComparableType
  isNumType :: ScalarType ('Postgres pgKind) -> Bool
isNumType = ScalarType ('Postgres pgKind) -> Bool
PGScalarType -> Bool
Postgres.isNumType
  textToScalarValue :: Maybe Text -> ScalarValue ('Postgres pgKind)
textToScalarValue = Maybe Text -> ScalarValue ('Postgres pgKind)
Maybe Text -> PGScalarValue
Postgres.textToScalarValue
  parseScalarValue :: ScalarTypeParsingContext ('Postgres pgKind)
-> ScalarType ('Postgres pgKind)
-> Value
-> Either QErr (ScalarValue ('Postgres pgKind))
parseScalarValue () ScalarType ('Postgres pgKind)
ty Value
val = (Value -> Parser PGScalarValue)
-> Value -> Either QErr PGScalarValue
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser (PGScalarType -> Value -> Parser PGScalarValue
Postgres.parsePGValue ScalarType ('Postgres pgKind)
PGScalarType
ty) Value
val
  scalarValueToJSON :: ScalarValue ('Postgres pgKind) -> Value
scalarValueToJSON = ScalarValue ('Postgres pgKind) -> Value
PGScalarValue -> Value
Postgres.pgScalarValueToJson
  functionToTable :: FunctionName ('Postgres pgKind) -> TableName ('Postgres pgKind)
functionToTable = (FunctionName -> TableName) -> QualifiedFunction -> QualifiedTable
forall a b. (a -> b) -> QualifiedObject a -> QualifiedObject b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TableName
Postgres.TableName (Text -> TableName)
-> (FunctionName -> Text) -> FunctionName -> TableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Text
Postgres.getFunctionTxt)
  tableToFunction :: TableName ('Postgres pgKind) -> FunctionName ('Postgres pgKind)
tableToFunction = (TableName -> FunctionName) -> QualifiedTable -> QualifiedFunction
forall a b. (a -> b) -> QualifiedObject a -> QualifiedObject b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FunctionName
Postgres.FunctionName (Text -> FunctionName)
-> (TableName -> Text) -> TableName -> FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Text
Postgres.getTableTxt)
  computedFieldFunction :: ComputedFieldDefinition ('Postgres pgKind)
-> FunctionName ('Postgres pgKind)
computedFieldFunction = ComputedFieldDefinition ('Postgres pgKind)
-> FunctionName ('Postgres pgKind)
ComputedFieldDefinition -> QualifiedFunction
Postgres._cfdFunction
  computedFieldReturnType :: ComputedFieldReturn ('Postgres pgKind)
-> ComputedFieldReturnType ('Postgres pgKind)
computedFieldReturnType = \case
    Postgres.CFRScalar PGScalarType
scalarType -> ScalarType ('Postgres pgKind)
-> ComputedFieldReturnType ('Postgres pgKind)
forall (b :: BackendType).
ScalarType b -> ComputedFieldReturnType b
ReturnsScalar ScalarType ('Postgres pgKind)
PGScalarType
scalarType
    Postgres.CFRSetofTable QualifiedTable
table -> TableName ('Postgres pgKind)
-> ComputedFieldReturnType ('Postgres pgKind)
forall (b :: BackendType). TableName b -> ComputedFieldReturnType b
ReturnsTable TableName ('Postgres pgKind)
QualifiedTable
table
  fromComputedFieldImplicitArguments :: forall v.
v
-> ComputedFieldImplicitArguments ('Postgres pgKind)
-> [FunctionArgumentExp ('Postgres pgKind) v]
fromComputedFieldImplicitArguments = v
-> ComputedFieldImplicitArguments ('Postgres pgKind)
-> [FunctionArgumentExp ('Postgres pgKind) v]
v -> ComputedFieldImplicitArguments -> [ArgumentExp v]
forall v. v -> ComputedFieldImplicitArguments -> [ArgumentExp v]
Postgres.fromComputedFieldImplicitArguments

  tableGraphQLName :: TableName ('Postgres pgKind) -> Either QErr Name
tableGraphQLName = TableName ('Postgres pgKind) -> Either QErr Name
QualifiedTable -> Either QErr Name
forall a (m :: * -> *).
(ToTxt a, MonadError QErr m) =>
QualifiedObject a -> m Name
Postgres.qualifiedObjectToName
  functionGraphQLName :: FunctionName ('Postgres pgKind) -> Either QErr Name
functionGraphQLName = FunctionName ('Postgres pgKind) -> Either QErr Name
QualifiedFunction -> Either QErr Name
forall a (m :: * -> *).
(ToTxt a, MonadError QErr m) =>
QualifiedObject a -> m Name
Postgres.qualifiedObjectToName

  snakeCaseTableName :: TableName ('Postgres pgKind) -> Text
snakeCaseTableName = TableName ('Postgres pgKind) -> Text
QualifiedTable -> Text
forall a. ToTxt a => QualifiedObject a -> Text
Postgres.snakeCaseQualifiedObject
  getTableIdentifier :: TableName ('Postgres pgKind) -> Either QErr GQLNameIdentifier
getTableIdentifier = TableName ('Postgres pgKind) -> Either QErr GQLNameIdentifier
QualifiedTable -> Either QErr GQLNameIdentifier
forall a.
ToTxt a =>
QualifiedObject a -> Either QErr GQLNameIdentifier
Postgres.getIdentifierQualifiedObject
  namingConventionSupport :: SupportedNamingCase
namingConventionSupport = SupportedNamingCase
Postgres.namingConventionSupport

  resizeSourcePools :: SourceConfig ('Postgres pgKind)
-> ServerReplicas -> IO SourceResizePoolSummary
resizeSourcePools SourceConfig ('Postgres pgKind)
sourceConfig ServerReplicas
serverReplicas = (PGExecCtx -> ServerReplicas -> IO SourceResizePoolSummary
Postgres._pecResizePools (PGSourceConfig -> PGExecCtx
Postgres._pscExecCtx SourceConfig ('Postgres pgKind)
PGSourceConfig
sourceConfig)) ServerReplicas
serverReplicas

  defaultTriggerOnReplication :: Maybe (XEventTriggers ('Postgres pgKind), TriggerOnReplication)
defaultTriggerOnReplication = ((), TriggerOnReplication) -> Maybe ((), TriggerOnReplication)
forall a. a -> Maybe a
Just ((), TriggerOnReplication
TORDisableTrigger)

  resolveConnectionTemplate :: SourceConfig ('Postgres pgKind)
-> ConnectionTemplateRequestContext ('Postgres pgKind)
-> Maybe ConnectionTemplate
-> Either QErr EncJSON
resolveConnectionTemplate = SourceConfig ('Postgres pgKind)
-> ConnectionTemplateRequestContext ('Postgres pgKind)
-> Maybe ConnectionTemplate
-> Either QErr EncJSON
PGSourceConfig
-> RequestContext
-> Maybe ConnectionTemplate
-> Either QErr EncJSON
forall (m :: * -> *).
MonadError QErr m =>
PGSourceConfig
-> RequestContext -> Maybe ConnectionTemplate -> m EncJSON
Postgres.pgResolveConnectionTemplate

instance
  ( HasTag ('Postgres pgKind)
  ) =>
  HasSourceConfiguration ('Postgres pgKind)
  where
  type SourceConfig ('Postgres pgKind) = Postgres.PGSourceConfig
  type SourceConnConfiguration ('Postgres pgKind) = Postgres.PostgresConnConfiguration
  sourceConfigNumReadReplicas :: SourceConfig ('Postgres pgKind) -> Int
sourceConfigNumReadReplicas = SourceConfig ('Postgres pgKind) -> Int
PGSourceConfig -> Int
Postgres.sourceConfigNumReadReplicas
  sourceConfigConnectonTemplateEnabled :: SourceConfig ('Postgres pgKind) -> Bool
sourceConfigConnectonTemplateEnabled = SourceConfig ('Postgres pgKind) -> Bool
PGSourceConfig -> Bool
Postgres.sourceConfigConnectonTemplateEnabled
  sourceConfigBackendSourceKind :: SourceConfig ('Postgres pgKind)
-> BackendSourceKind ('Postgres pgKind)
sourceConfigBackendSourceKind SourceConfig ('Postgres pgKind)
_sourceConfig =
    case forall (b :: BackendType). HasTag b => BackendTag b
backendTag @('Postgres pgKind) of
      BackendTag ('Postgres pgKind)
PostgresVanillaTag -> BackendSourceKind ('Postgres pgKind)
BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind
      BackendTag ('Postgres pgKind)
PostgresCitusTag -> BackendSourceKind ('Postgres pgKind)
BackendSourceKind ('Postgres 'Citus)
PostgresCitusKind
      BackendTag ('Postgres pgKind)
PostgresCockroachTag -> BackendSourceKind ('Postgres pgKind)
BackendSourceKind ('Postgres 'Cockroach)
PostgresCockroachKind