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

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

import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as HashSet
import Data.Semigroup.Foldable (toNonEmpty)
import Data.String.Interpolate (i)
import Data.Text.Extended
import Database.PG.Query.PTI qualified as PTI
import Database.PG.Query.Pool (fromPGTxErr)
import Database.PG.Query.Transaction (Query)
import Database.PG.Query.Transaction qualified as Query
import Database.PostgreSQL.LibPQ qualified as PQ
import Hasura.Backends.Postgres.DDL qualified as Postgres
import Hasura.Backends.Postgres.Execute.Types (PGExecCtxInfo (..), PGExecFrom (..), PGExecTxType (..), runPgSourceReadTx, _pecRunTx, _pscExecCtx)
import Hasura.Backends.Postgres.Instances.NativeQueries as Postgres (validateNativeQuery)
import Hasura.Backends.Postgres.SQL.Types (QualifiedObject (..), QualifiedTable)
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres
import Hasura.Backends.Postgres.Types.CitusExtraTableMetadata
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.DDL.Relationship (defaultBuildArrayRelationshipInfo, defaultBuildObjectRelationshipInfo)
import Hasura.RQL.Types.Backend (Backend)
import Hasura.RQL.Types.Backend qualified as Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column (ColumnMutability (..), RawColumnInfo (..))
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache (askSourceConfig)
import Hasura.RQL.Types.Source.Column (SourceColumnInfo (..))
import Hasura.RQL.Types.Source.Table (SourceConstraint (..), SourceForeignKeys (..), SourceTableInfo (..), SourceTableType (..))
import Hasura.Table.Cache
import Language.GraphQL.Draft.Syntax (unDescription)

--------------------------------------------------------------------------------
-- PostgresMetadata

-- | We differentiate the handling of metadata between Citus and Vanilla
-- Postgres because Citus imposes limitations on the types of joins that it
-- permits, which then limits the types of relations that we can track.
class PostgresMetadata (pgKind :: PostgresKind) where
  -- TODO: find a better name
  validateRel ::
    (MonadError QErr m) =>
    TableCache ('Postgres pgKind) ->
    QualifiedTable ->
    Either (ObjRelDef ('Postgres pgKind)) (ArrRelDef ('Postgres pgKind)) ->
    m ()

  -- | A query for getting the list of all tables on a given data source. This
  -- is primarily used by the console to display tables for tracking etc.
  listAllTablesSql :: Query

  -- | Given 'PgExtraTableMetadata', return whether this is source "table" is a
  -- table or a view.
  tableTypeImpl :: Backend.ExtraTableMetadata ('Postgres pgKind) -> SourceTableType

  -- | A mapping from pg scalar types with clear oid equivalent to oid.
  --
  -- This is a insert order hash map so that when we invert it
  -- duplicate oids will point to a more "general" type.
  pgTypeOidMapping :: InsOrdHashMap.InsOrdHashMap Postgres.PGScalarType PQ.Oid
  pgTypeOidMapping =
    [(PGScalarType, Oid)] -> InsOrdHashMap PGScalarType Oid
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
      ([(PGScalarType, Oid)] -> InsOrdHashMap PGScalarType Oid)
-> [(PGScalarType, Oid)] -> InsOrdHashMap PGScalarType Oid
forall a b. (a -> b) -> a -> b
$ [ (PGScalarType
Postgres.PGSmallInt, Oid
PTI.int2),
          (PGScalarType
Postgres.PGSerial, Oid
PTI.int4),
          (PGScalarType
Postgres.PGInteger, Oid
PTI.int4),
          (PGScalarType
Postgres.PGBigSerial, Oid
PTI.int8),
          (PGScalarType
Postgres.PGBigInt, Oid
PTI.int8),
          (PGScalarType
Postgres.PGFloat, Oid
PTI.float4),
          (PGScalarType
Postgres.PGDouble, Oid
PTI.float8),
          (PGScalarType
Postgres.PGMoney, Oid
PTI.numeric),
          (PGScalarType
Postgres.PGNumeric, Oid
PTI.numeric),
          (PGScalarType
Postgres.PGBoolean, Oid
PTI.bool),
          (PGScalarType
Postgres.PGChar, Oid
PTI.bpchar),
          (PGScalarType
Postgres.PGVarchar, Oid
PTI.varchar),
          (PGScalarType
Postgres.PGText, Oid
PTI.text),
          (PGScalarType
Postgres.PGDate, Oid
PTI.date),
          (PGScalarType
Postgres.PGTimeStamp, Oid
PTI.timestamp),
          (PGScalarType
Postgres.PGTimeStampTZ, Oid
PTI.timestamptz),
          (PGScalarType
Postgres.PGTimeTZ, Oid
PTI.timetz),
          (PGScalarType
Postgres.PGJSON, Oid
PTI.json),
          (PGScalarType
Postgres.PGJSONB, Oid
PTI.jsonb),
          (PGScalarType
Postgres.PGUUID, Oid
PTI.uuid),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGSmallInt, Oid
PTI.int2_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGSerial, Oid
PTI.int4_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGInteger, Oid
PTI.int4_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGBigSerial, Oid
PTI.int8_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGBigInt, Oid
PTI.int8_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGFloat, Oid
PTI.float4_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGDouble, Oid
PTI.float8_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGMoney, Oid
PTI.numeric_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGNumeric, Oid
PTI.numeric_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGBoolean, Oid
PTI.bool_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGChar, Oid
PTI.char_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGVarchar, Oid
PTI.varchar_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGText, Oid
PTI.text_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGDate, Oid
PTI.date_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGTimeStamp, Oid
PTI.timestamp_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGTimeStampTZ, Oid
PTI.timestamptz_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGTimeTZ, Oid
PTI.timetz_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGJSON, Oid
PTI.json_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGJSON, Oid
PTI.jsonb_array),
          (PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
Postgres.PGUUID, Oid
PTI.uuid_array)
        ]

instance PostgresMetadata 'Vanilla where
  validateRel :: forall (m :: * -> *).
MonadError QErr m =>
TableCache ('Postgres 'Vanilla)
-> QualifiedTable
-> Either
     (ObjRelDef ('Postgres 'Vanilla)) (ArrRelDef ('Postgres 'Vanilla))
-> m ()
validateRel TableCache ('Postgres 'Vanilla)
_ QualifiedTable
_ Either
  (ObjRelDef ('Postgres 'Vanilla)) (ArrRelDef ('Postgres 'Vanilla))
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  tableTypeImpl :: ExtraTableMetadata ('Postgres 'Vanilla) -> SourceTableType
tableTypeImpl = ExtraTableMetadata ('Postgres 'Vanilla) -> SourceTableType
PGExtraTableMetadata -> SourceTableType
Postgres._petmTableType

  listAllTablesSql :: Query
listAllTablesSql =
    Text -> Query
Query.fromText
      [i|
        WITH partitions as (
          SELECT array(
            SELECT
            child.relname       AS partition
        FROM pg_inherits
            JOIN pg_class child             ON pg_inherits.inhrelid   = child.oid
            JOIN pg_namespace nmsp_child    ON nmsp_child.oid   = child.relnamespace
          ) as names
        )
        SELECT info_schema.table_schema, info_schema.table_name
        FROM information_schema.tables as info_schema, partitions
        WHERE
          info_schema.table_schema NOT IN ('information_schema', 'pg_catalog', 'hdb_catalog', '_timescaledb_internal')
          AND NOT (info_schema.table_name = ANY (partitions.names))
        ORDER BY info_schema.table_schema, info_schema.table_name
      |]

instance PostgresMetadata 'Citus where
  validateRel ::
    forall m.
    (MonadError QErr m) =>
    TableCache ('Postgres 'Citus) ->
    QualifiedTable ->
    Either (ObjRelDef ('Postgres 'Citus)) (ArrRelDef ('Postgres 'Citus)) ->
    m ()
  validateRel :: forall (m :: * -> *).
MonadError QErr m =>
TableCache ('Postgres 'Citus)
-> QualifiedTable
-> Either
     (ObjRelDef ('Postgres 'Citus)) (ArrRelDef ('Postgres 'Citus))
-> m ()
validateRel TableCache ('Postgres 'Citus)
tableCache QualifiedTable
sourceTable Either
  (ObjRelDef ('Postgres 'Citus)) (ArrRelDef ('Postgres 'Citus))
relInfo = do
    TableInfo ('Postgres 'Citus)
sourceTableInfo <- QualifiedTable -> m (TableInfo ('Postgres 'Citus))
lookupTableInfo QualifiedTable
sourceTable
    case Either
  (ObjRelDef ('Postgres 'Citus)) (ArrRelDef ('Postgres 'Citus))
relInfo of
      Left (RelDef RelName
_ ObjRelUsing ('Postgres 'Citus)
obj Maybe Text
_) ->
        case ObjRelUsing ('Postgres 'Citus)
obj of
          RUFKeyOn (SameTable NonEmpty (Column ('Postgres 'Citus))
_) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          RUFKeyOn (RemoteTable TableName ('Postgres 'Citus)
targetTable NonEmpty (Column ('Postgres 'Citus))
_) -> TableInfo ('Postgres 'Citus) -> QualifiedTable -> m ()
checkObjectRelationship TableInfo ('Postgres 'Citus)
sourceTableInfo TableName ('Postgres 'Citus)
QualifiedTable
targetTable
          RUManual RelManualTableConfig {} -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Right (RelDef RelName
_ ArrRelUsing ('Postgres 'Citus)
obj Maybe Text
_) ->
        case ArrRelUsing ('Postgres 'Citus)
obj of
          RUFKeyOn (ArrRelUsingFKeyOn TableName ('Postgres 'Citus)
targetTable NonEmpty (Column ('Postgres 'Citus))
_col) -> TableInfo ('Postgres 'Citus) -> QualifiedTable -> m ()
checkArrayRelationship TableInfo ('Postgres 'Citus)
sourceTableInfo TableName ('Postgres 'Citus)
QualifiedTable
targetTable
          RUManual RelManualTableConfig {} -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    where
      lookupTableInfo :: QualifiedTable -> m (TableInfo ('Postgres 'Citus))
lookupTableInfo QualifiedTable
tableName =
        QualifiedTable
-> HashMap QualifiedTable (TableInfo ('Postgres 'Citus))
-> Maybe (TableInfo ('Postgres 'Citus))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup QualifiedTable
tableName TableCache ('Postgres 'Citus)
HashMap QualifiedTable (TableInfo ('Postgres 'Citus))
tableCache
          Maybe (TableInfo ('Postgres 'Citus))
-> m (TableInfo ('Postgres 'Citus))
-> m (TableInfo ('Postgres 'Citus))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (TableInfo ('Postgres 'Citus))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"no such table " Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedTable
tableName)

      checkObjectRelationship :: TableInfo ('Postgres 'Citus) -> QualifiedTable -> m ()
checkObjectRelationship TableInfo ('Postgres 'Citus)
sourceTableInfo QualifiedTable
targetTable = do
        TableInfo ('Postgres 'Citus)
targetTableInfo <- QualifiedTable -> m (TableInfo ('Postgres 'Citus))
lookupTableInfo QualifiedTable
targetTable
        let notSupported :: m ()
notSupported = TableInfo ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus) -> Text -> m ()
throwNotSupportedError TableInfo ('Postgres 'Citus)
sourceTableInfo TableInfo ('Postgres 'Citus)
targetTableInfo Text
"object"
        case ( TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata (TableCoreInfoG
   ('Postgres 'Citus)
   (FieldInfo ('Postgres 'Citus))
   (ColumnInfo ('Postgres 'Citus))
 -> ExtraTableMetadata ('Postgres 'Citus))
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
sourceTableInfo,
               TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata (TableCoreInfoG
   ('Postgres 'Citus)
   (FieldInfo ('Postgres 'Citus))
   (ColumnInfo ('Postgres 'Citus))
 -> ExtraTableMetadata ('Postgres 'Citus))
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
targetTableInfo
             ) of
          (Distributed {}, Local {}) -> m ()
notSupported
          (Distributed {}, Reference {}) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          (Distributed {}, Distributed {}) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          (ExtraTableMetadata
_, Distributed {}) -> m ()
notSupported
          (ExtraTableMetadata
_, ExtraTableMetadata
_) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      checkArrayRelationship :: TableInfo ('Postgres 'Citus) -> QualifiedTable -> m ()
checkArrayRelationship TableInfo ('Postgres 'Citus)
sourceTableInfo QualifiedTable
targetTable = do
        TableInfo ('Postgres 'Citus)
targetTableInfo <- QualifiedTable -> m (TableInfo ('Postgres 'Citus))
lookupTableInfo QualifiedTable
targetTable
        let notSupported :: m ()
notSupported = TableInfo ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus) -> Text -> m ()
throwNotSupportedError TableInfo ('Postgres 'Citus)
sourceTableInfo TableInfo ('Postgres 'Citus)
targetTableInfo Text
"array"
        case ( TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata (TableCoreInfoG
   ('Postgres 'Citus)
   (FieldInfo ('Postgres 'Citus))
   (ColumnInfo ('Postgres 'Citus))
 -> ExtraTableMetadata ('Postgres 'Citus))
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
sourceTableInfo,
               TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata (TableCoreInfoG
   ('Postgres 'Citus)
   (FieldInfo ('Postgres 'Citus))
   (ColumnInfo ('Postgres 'Citus))
 -> ExtraTableMetadata ('Postgres 'Citus))
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
targetTableInfo
             ) of
          (Distributed {}, Distributed {}) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          (Distributed {}, ExtraTableMetadata
_) -> m ()
notSupported
          (ExtraTableMetadata
_, Distributed {}) -> m ()
notSupported
          (ExtraTableMetadata
_, ExtraTableMetadata
_) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      showDistributionType :: ExtraTableMetadata -> Text
      showDistributionType :: ExtraTableMetadata -> Text
showDistributionType = \case
        Local {} -> Text
"local"
        Distributed {} -> Text
"distributed"
        Reference {} -> Text
"reference"

      throwNotSupportedError :: TableInfo ('Postgres 'Citus) -> TableInfo ('Postgres 'Citus) -> Text -> m ()
      throwNotSupportedError :: TableInfo ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus) -> Text -> m ()
throwNotSupportedError TableInfo ('Postgres 'Citus)
sourceTableInfo TableInfo ('Postgres 'Citus)
targetTableInfo Text
t =
        let tciSrc :: TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
tciSrc = TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
sourceTableInfo
            tciTgt :: TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
tciTgt = TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
targetTableInfo
         in Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
              Code
NotSupported
              ( ExtraTableMetadata -> Text
showDistributionType (TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
tciSrc)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" tables ("
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> Text
forall a. ToTxt a => a -> Text
toTxt (TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> TableName ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
tciSrc)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") cannot have an "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" relationship against a "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExtraTableMetadata -> Text
showDistributionType (TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata (TableCoreInfoG
   ('Postgres 'Citus)
   (FieldInfo ('Postgres 'Citus))
   (ColumnInfo ('Postgres 'Citus))
 -> ExtraTableMetadata ('Postgres 'Citus))
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
-> ExtraTableMetadata ('Postgres 'Citus)
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres 'Citus)
-> TableCoreInfoG
     ('Postgres 'Citus)
     (FieldInfo ('Postgres 'Citus))
     (ColumnInfo ('Postgres 'Citus))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo ('Postgres 'Citus)
targetTableInfo)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" table ("
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> Text
forall a. ToTxt a => a -> Text
toTxt (TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
-> TableName ('Postgres 'Citus)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfoG
  ('Postgres 'Citus)
  (FieldInfo ('Postgres 'Citus))
  (ColumnInfo ('Postgres 'Citus))
tciTgt)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
              )

  tableTypeImpl :: ExtraTableMetadata ('Postgres 'Citus) -> SourceTableType
tableTypeImpl = ExtraTableMetadata ('Postgres 'Citus) -> SourceTableType
ExtraTableMetadata -> SourceTableType
tableType
  listAllTablesSql :: Query
listAllTablesSql =
    Text -> Query
Query.fromText
      [i|
        WITH partitions as (
          SELECT array(
            SELECT
            child.relname       AS partition
        FROM pg_inherits
            JOIN pg_class child             ON pg_inherits.inhrelid   = child.oid
            JOIN pg_namespace nmsp_child    ON nmsp_child.oid   = child.relnamespace
          ) as names
        )
        SELECT info_schema.table_schema, info_schema.table_name
        FROM information_schema.tables as info_schema, partitions
        WHERE
          info_schema.table_schema NOT IN ('pg_catalog', 'citus', 'information_schema', 'columnar', 'columnar_internal', 'guest', 'INFORMATION_SCHEMA', 'sys', 'db_owner', 'db_securityadmin', 'db_accessadmin', 'db_backupoperator', 'db_ddladmin', 'db_datawriter', 'db_datareader', 'db_denydatawriter', 'db_denydatareader', 'hdb_catalog', '_timescaledb_internal')
          AND NOT (info_schema.table_name = ANY (partitions.names))
          AND info_schema.table_name NOT IN ('citus_tables')
        ORDER BY info_schema.table_schema, info_schema.table_name
      |]

instance PostgresMetadata 'Cockroach where
  validateRel :: forall (m :: * -> *).
MonadError QErr m =>
TableCache ('Postgres 'Cockroach)
-> QualifiedTable
-> Either
     (ObjRelDef ('Postgres 'Cockroach))
     (ArrRelDef ('Postgres 'Cockroach))
-> m ()
validateRel TableCache ('Postgres 'Cockroach)
_ QualifiedTable
_ Either
  (ObjRelDef ('Postgres 'Cockroach))
  (ArrRelDef ('Postgres 'Cockroach))
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  tableTypeImpl :: ExtraTableMetadata ('Postgres 'Cockroach) -> SourceTableType
tableTypeImpl = ExtraTableMetadata ('Postgres 'Cockroach) -> SourceTableType
PGExtraTableMetadata -> SourceTableType
Postgres._petmTableType

  pgTypeOidMapping :: InsOrdHashMap PGScalarType Oid
pgTypeOidMapping =
    [(PGScalarType, Oid)] -> InsOrdHashMap PGScalarType Oid
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
      [ (PGScalarType
Postgres.PGInteger, Oid
PTI.int8),
        (PGScalarType
Postgres.PGSerial, Oid
PTI.int8),
        (PGScalarType
Postgres.PGJSON, Oid
PTI.jsonb)
      ]
      InsOrdHashMap PGScalarType Oid
-> InsOrdHashMap PGScalarType Oid -> InsOrdHashMap PGScalarType Oid
forall k v.
(Eq k, Hashable k) =>
InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
`InsOrdHashMap.union` forall (pgKind :: PostgresKind).
PostgresMetadata pgKind =>
InsOrdHashMap PGScalarType Oid
pgTypeOidMapping @'Vanilla

  listAllTablesSql :: Query
listAllTablesSql =
    Text -> Query
Query.fromText
      [i|
        WITH partitions as (
          SELECT array(
            SELECT
            child.relname       AS partition
        FROM pg_inherits
            JOIN pg_class child             ON pg_inherits.inhrelid   = child.oid
            JOIN pg_namespace nmsp_child    ON nmsp_child.oid   = child.relnamespace
          ) as names
        )
        SELECT info_schema.table_schema, info_schema.table_name
        FROM information_schema.tables as info_schema, partitions
        WHERE
          info_schema.table_schema NOT IN ('pg_catalog', 'crdb_internal', 'information_schema', 'columnar', 'guest', 'INFORMATION_SCHEMA', 'sys', 'db_owner', 'db_securityadmin', 'db_accessadmin', 'db_backupoperator', 'db_ddladmin', 'db_datawriter', 'db_datareader', 'db_denydatawriter', 'db_denydatareader', 'hdb_catalog', '_timescaledb_internal', 'pg_extension')
          AND NOT (info_schema.table_name = ANY (partitions.names))
        ORDER BY info_schema.table_schema, info_schema.table_name
      |]

----------------------------------------------------------------
-- BackendMetadata instance

instance
  ( Backend ('Postgres pgKind),
    PostgresMetadata pgKind,
    Postgres.FetchTableMetadata pgKind,
    Postgres.FetchFunctionMetadata pgKind,
    Postgres.ToMetadataFetchQuery pgKind
  ) =>
  BackendMetadata ('Postgres pgKind)
  where
  prepareCatalog :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m) =>
SourceConfig ('Postgres pgKind)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
prepareCatalog = SourceConfig ('Postgres pgKind)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
SourceConfig ('Postgres Any)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadIO m, MonadBaseControl IO m) =>
SourceConfig ('Postgres pgKind)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
Postgres.prepareCatalog
  buildComputedFieldInfo :: forall (m :: * -> *).
MonadError QErr m =>
HashSet (TableName ('Postgres pgKind))
-> TableName ('Postgres pgKind)
-> HashSet (Column ('Postgres pgKind))
-> ComputedFieldName
-> ComputedFieldDefinition ('Postgres pgKind)
-> RawFunctionInfo ('Postgres pgKind)
-> Comment
-> m (ComputedFieldInfo ('Postgres pgKind))
buildComputedFieldInfo = HashSet (TableName ('Postgres pgKind))
-> TableName ('Postgres pgKind)
-> HashSet (Column ('Postgres pgKind))
-> ComputedFieldName
-> ComputedFieldDefinition ('Postgres pgKind)
-> RawFunctionInfo ('Postgres pgKind)
-> Comment
-> m (ComputedFieldInfo ('Postgres pgKind))
HashSet QualifiedTable
-> QualifiedTable
-> HashSet PGCol
-> ComputedFieldName
-> ComputedFieldDefinition
-> PGRawFunctionInfo
-> Comment
-> m (ComputedFieldInfo ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
QErrM m =>
HashSet QualifiedTable
-> QualifiedTable
-> HashSet PGCol
-> ComputedFieldName
-> ComputedFieldDefinition
-> PGRawFunctionInfo
-> Comment
-> m (ComputedFieldInfo ('Postgres pgKind))
Postgres.buildComputedFieldInfo
  fetchAndValidateEnumValues :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m) =>
SourceConfig ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> Maybe
     (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
-> [RawColumnInfo ('Postgres pgKind)]
-> m (Either QErr EnumValues)
fetchAndValidateEnumValues = SourceConfig ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> Maybe
     (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
-> [RawColumnInfo ('Postgres pgKind)]
-> m (Either QErr EnumValues)
PGSourceConfig
-> QualifiedTable
-> Maybe
     (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
-> [RawColumnInfo ('Postgres pgKind)]
-> m (Either QErr EnumValues)
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig
-> QualifiedTable
-> Maybe
     (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
-> [RawColumnInfo ('Postgres pgKind)]
-> m (Either QErr EnumValues)
Postgres.fetchAndValidateEnumValues
  resolveSourceConfig :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadResolveSource m) =>
SourceName
-> SourceConnConfiguration ('Postgres pgKind)
-> BackendSourceKind ('Postgres pgKind)
-> BackendInfo ('Postgres pgKind)
-> Environment
-> Manager
-> m (Either QErr (SourceConfig ('Postgres pgKind)))
resolveSourceConfig = SourceName
-> SourceConnConfiguration ('Postgres pgKind)
-> BackendSourceKind ('Postgres pgKind)
-> BackendInfo ('Postgres pgKind)
-> Environment
-> Manager
-> m (Either QErr (SourceConfig ('Postgres pgKind)))
SourceName
-> PostgresConnConfiguration
-> BackendSourceKind ('Postgres pgKind)
-> BackendConfig ('Postgres pgKind)
-> Environment
-> Manager
-> m (Either QErr (SourceConfig ('Postgres pgKind)))
forall (m :: * -> *) (pgKind :: PostgresKind) manager.
(MonadIO m, MonadResolveSource m) =>
SourceName
-> PostgresConnConfiguration
-> BackendSourceKind ('Postgres pgKind)
-> BackendConfig ('Postgres pgKind)
-> Environment
-> manager
-> m (Either QErr (SourceConfig ('Postgres pgKind)))
Postgres.resolveSourceConfig
  resolveDatabaseMetadata :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadResolveSource m) =>
Logger Hasura
-> SourceMetadata ('Postgres pgKind)
-> SourceConfig ('Postgres pgKind)
-> m (Either QErr (DBObjectsIntrospection ('Postgres pgKind)))
resolveDatabaseMetadata Logger Hasura
_ = SourceMetadata ('Postgres pgKind)
-> SourceConfig ('Postgres pgKind)
-> m (Either QErr (DBObjectsIntrospection ('Postgres pgKind)))
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchFunctionMetadata pgKind, FetchTableMetadata pgKind, MonadIO m,
 MonadBaseControl IO m) =>
SourceMetadata ('Postgres pgKind)
-> SourceConfig ('Postgres pgKind)
-> m (Either QErr (DBObjectsIntrospection ('Postgres pgKind)))
Postgres.resolveDatabaseMetadata
  parseBoolExpOperations :: forall (m :: * -> *) v.
MonadError QErr m =>
ValueParser ('Postgres pgKind) m v
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> ColumnReference ('Postgres pgKind)
-> Value
-> m [OpExpG ('Postgres pgKind) v]
parseBoolExpOperations = ValueParser ('Postgres pgKind) m v
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> ColumnReference ('Postgres pgKind)
-> Value
-> m [OpExpG ('Postgres pgKind) v]
forall (pgKind :: PostgresKind) (m :: * -> *) v.
(Backend ('Postgres pgKind), MonadError QErr m) =>
ValueParser ('Postgres pgKind) m v
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> ColumnReference ('Postgres pgKind)
-> Value
-> m [OpExpG ('Postgres pgKind) v]
Postgres.parseBoolExpOperations
  buildArrayRelationshipInfo :: forall (m :: * -> *).
MonadError QErr m =>
SourceConfig ('Postgres pgKind)
-> SourceName
-> HashMap
     (TableName ('Postgres pgKind))
     (HashSet (ForeignKey ('Postgres pgKind)))
-> TableName ('Postgres pgKind)
-> ArrRelDef ('Postgres pgKind)
-> m (RelInfo ('Postgres pgKind), Seq SchemaDependency)
buildArrayRelationshipInfo SourceConfig ('Postgres pgKind)
_ = SourceName
-> HashMap
     (TableName ('Postgres pgKind))
     (HashSet (ForeignKey ('Postgres pgKind)))
-> TableName ('Postgres pgKind)
-> ArrRelDef ('Postgres pgKind)
-> m (RelInfo ('Postgres pgKind), Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> TableName b
-> ArrRelDef b
-> m (RelInfo b, Seq SchemaDependency)
defaultBuildArrayRelationshipInfo
  buildObjectRelationshipInfo :: forall (m :: * -> *).
MonadError QErr m =>
SourceConfig ('Postgres pgKind)
-> SourceName
-> HashMap
     (TableName ('Postgres pgKind))
     (HashSet (ForeignKey ('Postgres pgKind)))
-> TableName ('Postgres pgKind)
-> ObjRelDef ('Postgres pgKind)
-> m (RelInfo ('Postgres pgKind), Seq SchemaDependency)
buildObjectRelationshipInfo SourceConfig ('Postgres pgKind)
_ = SourceName
-> HashMap
     (TableName ('Postgres pgKind))
     (HashSet (ForeignKey ('Postgres pgKind)))
-> TableName ('Postgres pgKind)
-> ObjRelDef ('Postgres pgKind)
-> m (RelInfo ('Postgres pgKind), Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> TableName b
-> ObjRelDef b
-> m (RelInfo b, Seq SchemaDependency)
defaultBuildObjectRelationshipInfo
  buildFunctionInfo :: forall (m :: * -> *).
MonadError QErr m =>
SourceName
-> FunctionName ('Postgres pgKind)
-> SystemDefined
-> FunctionConfig ('Postgres pgKind)
-> FunctionPermissionsMap
-> RawFunctionInfo ('Postgres pgKind)
-> Maybe Text
-> NamingCase
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
buildFunctionInfo = SourceName
-> FunctionName ('Postgres pgKind)
-> SystemDefined
-> FunctionConfig ('Postgres pgKind)
-> FunctionPermissionsMap
-> RawFunctionInfo ('Postgres pgKind)
-> Maybe Text
-> NamingCase
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
SourceName
-> QualifiedFunction
-> SystemDefined
-> FunctionConfig ('Postgres pgKind)
-> FunctionPermissionsMap
-> RawFunctionInfo ('Postgres pgKind)
-> Maybe Text
-> NamingCase
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), QErrM m) =>
SourceName
-> QualifiedFunction
-> SystemDefined
-> FunctionConfig ('Postgres pgKind)
-> FunctionPermissionsMap
-> RawFunctionInfo ('Postgres pgKind)
-> Maybe Text
-> NamingCase
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
Postgres.buildFunctionInfo
  updateColumnInEventTrigger :: TableName ('Postgres pgKind)
-> Column ('Postgres pgKind)
-> Column ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> EventTriggerConf ('Postgres pgKind)
-> EventTriggerConf ('Postgres pgKind)
updateColumnInEventTrigger = TableName ('Postgres pgKind)
-> Column ('Postgres pgKind)
-> Column ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> EventTriggerConf ('Postgres pgKind)
-> EventTriggerConf ('Postgres pgKind)
QualifiedTable
-> PGCol
-> PGCol
-> QualifiedTable
-> EventTriggerConf ('Postgres pgKind)
-> EventTriggerConf ('Postgres pgKind)
forall (pgKind :: PostgresKind).
QualifiedTable
-> PGCol
-> PGCol
-> QualifiedTable
-> EventTriggerConf ('Postgres pgKind)
-> EventTriggerConf ('Postgres pgKind)
Postgres.updateColumnInEventTrigger
  parseCollectableType :: forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has (ScalarTypeParsingContext ('Postgres pgKind)) r) =>
CollectableType (ColumnType ('Postgres pgKind))
-> Value -> m (PartialSQLExp ('Postgres pgKind))
parseCollectableType = CollectableType (ColumnType ('Postgres pgKind))
-> Value -> m (PartialSQLExp ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), MonadError QErr m) =>
CollectableType (ColumnType ('Postgres pgKind))
-> Value -> m (PartialSQLExp ('Postgres pgKind))
Postgres.parseCollectableType
  postDropSourceHook :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m) =>
SourceConfig ('Postgres pgKind)
-> TableEventTriggers ('Postgres pgKind) -> m ()
postDropSourceHook = SourceConfig ('Postgres pgKind)
-> TableEventTriggers ('Postgres pgKind) -> m ()
SourceConfig ('Postgres Any)
-> TableEventTriggers ('Postgres Any) -> m ()
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m) =>
SourceConfig ('Postgres pgKind)
-> TableEventTriggers ('Postgres pgKind) -> m ()
Postgres.postDropSourceHook
  validateRelationship :: forall (m :: * -> *).
MonadError QErr m =>
TableCache ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> Either
     (ObjRelDef ('Postgres pgKind)) (ArrRelDef ('Postgres pgKind))
-> m ()
validateRelationship = forall (pgKind :: PostgresKind) (m :: * -> *).
(PostgresMetadata pgKind, MonadError QErr m) =>
TableCache ('Postgres pgKind)
-> QualifiedTable
-> Either
     (ObjRelDef ('Postgres pgKind)) (ArrRelDef ('Postgres pgKind))
-> m ()
validateRel @pgKind
  buildComputedFieldBooleanExp :: forall (m :: * -> *) v.
(MonadError QErr m, TableCoreInfoRM ('Postgres pgKind) m) =>
BoolExpResolver ('Postgres pgKind) m v
-> BoolExpRHSParser ('Postgres pgKind) m v
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> ComputedFieldInfo ('Postgres pgKind)
-> Value
-> m (AnnComputedFieldBoolExp ('Postgres pgKind) v)
buildComputedFieldBooleanExp = BoolExpResolver ('Postgres pgKind) m v
-> BoolExpRHSParser ('Postgres pgKind) m v
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> ComputedFieldInfo ('Postgres pgKind)
-> Value
-> m (AnnComputedFieldBoolExp ('Postgres pgKind) v)
forall (pgKind :: PostgresKind) (m :: * -> *) v.
(MonadError QErr m, Backend ('Postgres pgKind),
 TableCoreInfoRM ('Postgres pgKind) m) =>
BoolExpResolver ('Postgres pgKind) m v
-> BoolExpRHSParser ('Postgres pgKind) m v
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> FieldInfoMap (FieldInfo ('Postgres pgKind))
-> ComputedFieldInfo ('Postgres pgKind)
-> Value
-> m (AnnComputedFieldBoolExp ('Postgres pgKind) v)
Postgres.buildComputedFieldBooleanExp
  validateNativeQuery :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m) =>
Environment
-> SourceConnConfiguration ('Postgres pgKind)
-> LogicalModelInfo ('Postgres pgKind)
-> NativeQueryMetadata ('Postgres pgKind)
-> m (InterpolatedQuery ArgumentName)
validateNativeQuery = InsOrdHashMap PGScalarType Oid
-> Environment
-> PostgresConnConfiguration
-> LogicalModelInfo ('Postgres pgKind)
-> NativeQueryMetadata ('Postgres pgKind)
-> m (InterpolatedQuery ArgumentName)
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadIO m, MonadError QErr m) =>
InsOrdHashMap PGScalarType Oid
-> Environment
-> PostgresConnConfiguration
-> LogicalModelInfo ('Postgres pgKind)
-> NativeQueryMetadata ('Postgres pgKind)
-> m (InterpolatedQuery ArgumentName)
Postgres.validateNativeQuery (forall (pgKind :: PostgresKind).
PostgresMetadata pgKind =>
InsOrdHashMap PGScalarType Oid
pgTypeOidMapping @pgKind)
  supportsBeingRemoteRelationshipTarget :: SourceConfig ('Postgres pgKind) -> Bool
supportsBeingRemoteRelationshipTarget SourceConfig ('Postgres pgKind)
_ = Bool
True

  getTableInfo :: forall (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, MonadBaseControl IO m,
 MonadIO m) =>
SourceName
-> TableName ('Postgres pgKind)
-> m (Maybe (SourceTableInfo ('Postgres pgKind)))
getTableInfo SourceName
sourceName TableName ('Postgres pgKind)
tableName = do
    PGSourceConfig
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres pgKind) SourceName
sourceName

    HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
result <-
      (QErr
 -> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
    -> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> Either
     QErr (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either QErr
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   QErr (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
 -> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> m (Either
        QErr (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> m (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptT
  QErr
  m
  (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
-> m (Either
        QErr (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
        PGExecCtx -> PGExecCtxInfo -> RunTx
_pecRunTx (PGSourceConfig -> PGExecCtx
_pscExecCtx PGSourceConfig
sourceConfig) (PGExecTxType -> PGExecFrom -> PGExecCtxInfo
PGExecCtxInfo PGExecTxType
NoTxRead PGExecFrom
InternalRawQuery)
          (TxET
   QErr
   m
   (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
 -> ExceptT
      QErr
      m
      (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))))
-> TxET
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
-> ExceptT
     QErr
     m
     (HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 MonadTx m) =>
HashSet QualifiedTable -> m (DBTablesMetadata ('Postgres pgKind))
Postgres.pgFetchTableMetadata @pgKind (QualifiedTable -> HashSet QualifiedTable
forall a. Hashable a => a -> HashSet a
HashSet.singleton TableName ('Postgres pgKind)
QualifiedTable
tableName)

    Maybe (SourceTableInfo ('Postgres pgKind))
-> m (Maybe (SourceTableInfo ('Postgres pgKind)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
      DBTableMetadata {[RawColumnInfo ('Postgres pgKind)]
Maybe PGDescription
Maybe ViewInfo
Maybe (PrimaryKey ('Postgres pgKind) (Column ('Postgres pgKind)))
HashSet (UniqueConstraint ('Postgres pgKind))
HashSet (ForeignKeyMetadata ('Postgres pgKind))
OID
ExtraTableMetadata ('Postgres pgKind)
_ptmiOid :: OID
_ptmiColumns :: [RawColumnInfo ('Postgres pgKind)]
_ptmiPrimaryKey :: Maybe (PrimaryKey ('Postgres pgKind) (Column ('Postgres pgKind)))
_ptmiUniqueConstraints :: HashSet (UniqueConstraint ('Postgres pgKind))
_ptmiForeignKeys :: HashSet (ForeignKeyMetadata ('Postgres pgKind))
_ptmiViewInfo :: Maybe ViewInfo
_ptmiDescription :: Maybe PGDescription
_ptmiExtraTableMetadata :: ExtraTableMetadata ('Postgres pgKind)
_ptmiOid :: forall (b :: BackendType). DBTableMetadata b -> OID
_ptmiColumns :: forall (b :: BackendType). DBTableMetadata b -> [RawColumnInfo b]
_ptmiPrimaryKey :: forall (b :: BackendType).
DBTableMetadata b -> Maybe (PrimaryKey b (Column b))
_ptmiUniqueConstraints :: forall (b :: BackendType).
DBTableMetadata b -> HashSet (UniqueConstraint b)
_ptmiForeignKeys :: forall (b :: BackendType).
DBTableMetadata b -> HashSet (ForeignKeyMetadata b)
_ptmiViewInfo :: forall (b :: BackendType). DBTableMetadata b -> Maybe ViewInfo
_ptmiDescription :: forall (b :: BackendType). DBTableMetadata b -> Maybe PGDescription
_ptmiExtraTableMetadata :: forall (b :: BackendType).
DBTableMetadata b -> ExtraTableMetadata b
..} <- QualifiedTable
-> HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
-> Maybe (DBTableMetadata ('Postgres pgKind))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName ('Postgres pgKind)
QualifiedTable
tableName HashMap QualifiedTable (DBTableMetadata ('Postgres pgKind))
result

      let convertColumn :: RawColumnInfo ('Postgres pgKind) -> SourceColumnInfo ('Postgres pgKind)
          convertColumn :: RawColumnInfo ('Postgres pgKind)
-> SourceColumnInfo ('Postgres pgKind)
convertColumn RawColumnInfo {Bool
Int
Maybe Description
Column ('Postgres pgKind)
ColumnMutability
RawColumnType ('Postgres pgKind)
rciName :: Column ('Postgres pgKind)
rciPosition :: Int
rciType :: RawColumnType ('Postgres pgKind)
rciIsNullable :: Bool
rciDescription :: Maybe Description
rciMutability :: ColumnMutability
rciName :: forall (b :: BackendType). RawColumnInfo b -> Column b
rciPosition :: forall (b :: BackendType). RawColumnInfo b -> Int
rciType :: forall (b :: BackendType). RawColumnInfo b -> RawColumnType b
rciIsNullable :: forall (b :: BackendType). RawColumnInfo b -> Bool
rciDescription :: forall (b :: BackendType). RawColumnInfo b -> Maybe Description
rciMutability :: forall (b :: BackendType). RawColumnInfo b -> ColumnMutability
..} =
            SourceColumnInfo
              { _sciName :: Column ('Postgres pgKind)
_sciName = Column ('Postgres pgKind)
rciName,
                _sciType :: RawColumnType ('Postgres pgKind)
_sciType = RawColumnType ('Postgres pgKind)
rciType,
                _sciNullable :: Bool
_sciNullable = Bool
rciIsNullable,
                _sciDescription :: Maybe Text
_sciDescription = (Description -> Text) -> Maybe Description -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
unDescription Maybe Description
rciDescription,
                _sciInsertable :: Bool
_sciInsertable = ColumnMutability -> Bool
_cmIsInsertable ColumnMutability
rciMutability,
                _sciUpdatable :: Bool
_sciUpdatable = ColumnMutability -> Bool
_cmIsUpdatable ColumnMutability
rciMutability,
                _sciValueGenerated :: Maybe ColumnValueGenerationStrategy
_sciValueGenerated = Maybe ColumnValueGenerationStrategy
forall a. Maybe a
Nothing
              }

          convertForeignKeys :: HashSet (ForeignKeyMetadata ('Postgres pgKind)) -> SourceForeignKeys ('Postgres pgKind)
          convertForeignKeys :: HashSet (ForeignKeyMetadata ('Postgres pgKind))
-> SourceForeignKeys ('Postgres pgKind)
convertForeignKeys HashSet (ForeignKeyMetadata ('Postgres pgKind))
foreignKeys = HashMap
  (ConstraintName ('Postgres pgKind))
  (SourceConstraint ('Postgres pgKind))
-> SourceForeignKeys ('Postgres pgKind)
forall (b :: BackendType).
HashMap (ConstraintName b) (SourceConstraint b)
-> SourceForeignKeys b
SourceForeignKeys (HashMap
   (ConstraintName ('Postgres pgKind))
   (SourceConstraint ('Postgres pgKind))
 -> SourceForeignKeys ('Postgres pgKind))
-> HashMap
     (ConstraintName ('Postgres pgKind))
     (SourceConstraint ('Postgres pgKind))
-> SourceForeignKeys ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ [(ConstraintName, SourceConstraint ('Postgres pgKind))]
-> HashMap ConstraintName (SourceConstraint ('Postgres pgKind))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList do
            ForeignKeyMetadata ForeignKey {NEHashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
TableName ('Postgres pgKind)
Constraint ('Postgres pgKind)
_fkConstraint :: Constraint ('Postgres pgKind)
_fkForeignTable :: TableName ('Postgres pgKind)
_fkColumnMapping :: NEHashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
_fkConstraint :: forall (b :: BackendType). ForeignKey b -> Constraint b
_fkForeignTable :: forall (b :: BackendType). ForeignKey b -> TableName b
_fkColumnMapping :: forall (b :: BackendType).
ForeignKey b -> NEHashMap (Column b) (Column b)
..} <- HashSet (ForeignKeyMetadata ('Postgres pgKind))
-> [ForeignKeyMetadata ('Postgres pgKind)]
forall a. HashSet a -> [a]
HashSet.toList HashSet (ForeignKeyMetadata ('Postgres pgKind))
foreignKeys

            let mappings :: HashMap Postgres.PGCol Postgres.PGCol
                mappings :: HashMap PGCol PGCol
mappings = NEHashMap PGCol PGCol -> HashMap PGCol PGCol
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap NEHashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
NEHashMap PGCol PGCol
_fkColumnMapping

            (ConstraintName, SourceConstraint ('Postgres pgKind))
-> [(ConstraintName, SourceConstraint ('Postgres pgKind))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constraint ('Postgres pgKind) -> ConstraintName ('Postgres pgKind)
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName Constraint ('Postgres pgKind)
_fkConstraint, TableName ('Postgres pgKind)
-> HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
-> SourceConstraint ('Postgres pgKind)
forall (b :: BackendType).
TableName b -> HashMap (Column b) (Column b) -> SourceConstraint b
SourceConstraint TableName ('Postgres pgKind)
_fkForeignTable HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
mappings)

      SourceTableInfo ('Postgres pgKind)
-> Maybe (SourceTableInfo ('Postgres pgKind))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        SourceTableInfo
          { _stiName :: TableName ('Postgres pgKind)
_stiName = TableName ('Postgres pgKind)
tableName,
            _stiInsertable :: Bool
_stiInsertable = Bool -> (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ViewInfo -> Bool
viIsInsertable Maybe ViewInfo
_ptmiViewInfo,
            _stiUpdatable :: Bool
_stiUpdatable = Bool -> (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ViewInfo -> Bool
viIsUpdatable Maybe ViewInfo
_ptmiViewInfo,
            _stiDeletable :: Bool
_stiDeletable = Bool -> (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ViewInfo -> Bool
viIsDeletable Maybe ViewInfo
_ptmiViewInfo,
            _stiForeignKeys :: SourceForeignKeys ('Postgres pgKind)
_stiForeignKeys = HashSet (ForeignKeyMetadata ('Postgres pgKind))
-> SourceForeignKeys ('Postgres pgKind)
convertForeignKeys HashSet (ForeignKeyMetadata ('Postgres pgKind))
_ptmiForeignKeys,
            _stiPrimaryKey :: Maybe (NonEmpty (Column ('Postgres pgKind)))
_stiPrimaryKey = (PrimaryKey ('Postgres pgKind) PGCol -> NonEmpty PGCol)
-> Maybe (PrimaryKey ('Postgres pgKind) PGCol)
-> Maybe (NonEmpty PGCol)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NESeq PGCol -> NonEmpty PGCol
forall a. NESeq a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty (NESeq PGCol -> NonEmpty PGCol)
-> (PrimaryKey ('Postgres pgKind) PGCol -> NESeq PGCol)
-> PrimaryKey ('Postgres pgKind) PGCol
-> NonEmpty PGCol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryKey ('Postgres pgKind) PGCol -> NESeq PGCol
forall (b :: BackendType) a. PrimaryKey b a -> NESeq a
_pkColumns) Maybe (PrimaryKey ('Postgres pgKind) (Column ('Postgres pgKind)))
Maybe (PrimaryKey ('Postgres pgKind) PGCol)
_ptmiPrimaryKey,
            _stiColumns :: [SourceColumnInfo ('Postgres pgKind)]
_stiColumns = (RawColumnInfo ('Postgres pgKind)
 -> SourceColumnInfo ('Postgres pgKind))
-> [RawColumnInfo ('Postgres pgKind)]
-> [SourceColumnInfo ('Postgres pgKind)]
forall a b. (a -> b) -> [a] -> [b]
map RawColumnInfo ('Postgres pgKind)
-> SourceColumnInfo ('Postgres pgKind)
convertColumn [RawColumnInfo ('Postgres pgKind)]
_ptmiColumns,
            _stiLogicalModels :: [LogicalModelMetadata ('Postgres pgKind)]
_stiLogicalModels = [],
            _stiType :: SourceTableType
_stiType = forall (pgKind :: PostgresKind).
PostgresMetadata pgKind =>
ExtraTableMetadata ('Postgres pgKind) -> SourceTableType
tableTypeImpl @pgKind ExtraTableMetadata ('Postgres pgKind)
_ptmiExtraTableMetadata,
            _stiDescription :: Maybe Text
_stiDescription = Maybe Text
forall a. Maybe a
Nothing
          }

  listAllTables :: forall (m :: * -> *) r.
(CacheRM m, MonadBaseControl IO m, MetadataM m, MonadError QErr m,
 MonadIO m, MonadReader r m, Has (Logger Hasura) r,
 ProvidesNetwork m) =>
SourceName -> m [TableName ('Postgres pgKind)]
listAllTables SourceName
sourceName = do
    PGSourceConfig
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @('Postgres pgKind) SourceName
sourceName

    [(SchemaName, TableName)]
results <-
      PGSourceConfig
-> TxET QErr m [(SchemaName, TableName)]
-> m (Either QErr [(SchemaName, TableName)])
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig -> TxET QErr m a -> m (Either QErr a)
runPgSourceReadTx PGSourceConfig
sourceConfig ((PGTxErr -> QErr) -> Query -> TxET QErr m [(SchemaName, TableName)]
forall (m :: * -> *) a e.
(MonadIO m, FromRes a) =>
(PGTxErr -> e) -> Query -> TxET e m a
Query.multiQE PGTxErr -> QErr
forall e. FromPGTxErr e => PGTxErr -> e
fromPGTxErr (forall (pgKind :: PostgresKind). PostgresMetadata pgKind => Query
listAllTablesSql @pgKind))
        m (Either QErr [(SchemaName, TableName)])
-> (QErr -> m [(SchemaName, TableName)])
-> m [(SchemaName, TableName)]
forall (m :: * -> *) e a.
Monad m =>
m (Either e a) -> (e -> m a) -> m a
`onLeftM` \QErr
err -> QErr -> m [(SchemaName, TableName)]
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> QErr -> QErr
prefixQErr Text
"failed to fetch source tables: " QErr
err)

    [QualifiedTable] -> m [QualifiedTable]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [QualifiedObject {SchemaName
TableName
qSchema :: SchemaName
qName :: TableName
qSchema :: SchemaName
qName :: TableName
..} | (SchemaName
qSchema, TableName
qName) <- [(SchemaName, TableName)]
results]

  listAllTrackables :: forall (m :: * -> *) r.
(CacheRM m, MonadBaseControl IO m, MetadataM m, MonadError QErr m,
 MonadIO m, MonadReader r m, Has (Logger Hasura) r,
 ProvidesNetwork m) =>
SourceName -> m (TrackableInfo ('Postgres pgKind))
listAllTrackables SourceName
_ = Text -> m (TrackableInfo ('Postgres pgKind))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"listAllTrackables not supported by Postgres"