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

module Hasura.Backends.DataConnector.Adapter.Metadata (requestDatabaseSchema) where

import Control.Arrow.Extended
import Control.Monad.Trans.Control
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Bifunctor (bimap)
import Data.Environment (Environment)
import Data.Has (Has (getter))
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as HashSet
import Data.List.NonEmpty qualified as NEList
import Data.Map.Strict qualified as Map
import Data.Semigroup.Foldable (Foldable1 (..))
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text.Extended (toTxt, (<<>), (<>>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.API.V0 (FunctionInfo (_fiDescription, _fiName))
import Hasura.Backends.DataConnector.API.V0.Table qualified as DC (TableType (..))
import Hasura.Backends.DataConnector.Adapter.Backend (columnTypeToScalarType)
import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformSourceConfig, validateConnSourceConfig)
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
import Hasura.Backends.DataConnector.Agent.Client qualified as Client
import Hasura.Backends.Postgres.SQL.Types (PGDescription (..))
import Hasura.Base.Error (Code (..), QErr (..), decodeValue, runAesonParser, throw400, withPathK)
import Hasura.Function.Cache
  ( FunctionConfig (..),
    FunctionExposedAs (FEAMutation, FEAQuery),
    FunctionInfo (..),
    FunctionOverloads (FunctionOverloads),
    FunctionPermissionsMap,
    FunctionVolatility (FTSTABLE, FTVOLATILE),
    InputArgument (..),
    TrackableFunctionInfo (..),
    TrackableInfo (..),
    TrackableTableInfo (..),
    getFuncArgNameTxt,
  )
import Hasura.Function.Common
  ( getFunctionAggregateGQLName,
    getFunctionArgsGQLName,
    getFunctionGQLName,
  )
import Hasura.Incremental qualified as Inc
import Hasura.Incremental.Select qualified as Inc
import Hasura.Logging (Hasura, Logger)
import Hasura.Prelude
import Hasura.RQL.DDL.Relationship (defaultBuildArrayRelationshipInfo, defaultBuildObjectRelationshipInfo)
import Hasura.RQL.IR.BoolExp (OpExpG (..), PartialSQLExp (..), RootOrCurrent (..), RootOrCurrentColumn (..))
import Hasura.RQL.Types.Backend (FunctionReturnType (..), functionGraphQLName)
import Hasura.RQL.Types.BackendType (BackendSourceKind (..), BackendType (..))
import Hasura.RQL.Types.Column qualified as RQL.T.C
import Hasura.RQL.Types.Common (JsonAggSelect (JASMultipleRows, JASSingleObject), OID (..), SourceName, SystemDefined)
import Hasura.RQL.Types.CustomTypes (GraphQLType (..))
import Hasura.RQL.Types.EventTrigger (RecreateEventTriggers (RETDoNothing))
import Hasura.RQL.Types.Metadata (SourceMetadata (..))
import Hasura.RQL.Types.Metadata.Backend (BackendMetadata (..))
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.NamingCase (NamingCase)
import Hasura.RQL.Types.Relationships.Local (ArrRelDef, ObjRelDef, RelInfo ())
import Hasura.RQL.Types.SchemaCache (CacheRM, askSourceConfig, askSourceInfo)
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes (DependencyReason (DRTable), SchemaDependency (SchemaDependency), SchemaObjId (SOSourceObj), SourceObjId (SOITable))
import Hasura.RQL.Types.Source (DBObjectsIntrospection (..), SourceInfo (..))
import Hasura.RQL.Types.Source.Column (ColumnValueGenerationStrategy (..), SourceColumnInfo (..))
import Hasura.RQL.Types.Source.Table (SourceConstraint (..), SourceForeignKeys (..), SourceTableInfo (..), SourceTableType (..))
import Hasura.RQL.Types.SourceCustomization (applyFieldNameCaseCust)
import Hasura.SQL.AnyBackend (mkAnyBackend)
import Hasura.SQL.Types (CollectableType (..))
import Hasura.Server.Migrate.Version (SourceCatalogMigrationState (..))
import Hasura.Server.Utils qualified as HSU
import Hasura.Services.Network
import Hasura.Session (SessionVariable, mkSessionVariable)
import Hasura.Table.Cache (ForeignKey (_fkConstraint))
import Hasura.Table.Cache qualified as RQL.T.T
import Hasura.Tracing (ignoreTraceT)
import Language.GraphQL.Draft.Syntax qualified as G
import Language.GraphQL.Draft.Syntax qualified as GQL
import Network.HTTP.Client qualified as HTTP
import Witch qualified

instance BackendMetadata 'DataConnector where
  prepareCatalog _ = pure (RETDoNothing, SCMSNotSupported)
  type BackendInvalidationKeys 'DataConnector = HashMap DC.DataConnectorName Inc.InvalidationKey
  resolveBackendInfo = resolveBackendInfo'
  resolveSourceConfig = resolveSourceConfig'
  resolveDatabaseMetadata = resolveDatabaseMetadata'
  parseBoolExpOperations = parseBoolExpOperations'
  parseCollectableType = parseCollectableType'
  buildComputedFieldInfo = error "buildComputedFieldInfo: not implemented for the Data Connector backend."
  buildArrayRelationshipInfo = buildArrayRelationshipInfo'
  buildObjectRelationshipInfo = buildObjectRelationshipInfo'

  -- If/when we implement enums for Data Connector backend, we will also need to fix columnTypeToScalarType function
  -- in Hasura.Backends.DataConnector.Adapter.Backend. See note there for more information.
  fetchAndValidateEnumValues = error "fetchAndValidateEnumValues: not implemented for the Data Connector backend."
  buildFunctionInfo = buildFunctionInfo'
  updateColumnInEventTrigger = error "updateColumnInEventTrigger: not implemented for the Data Connector backend."
  postDropSourceHook _sourceConfig _tableTriggerMap = pure ()
  buildComputedFieldBooleanExp _ _ _ _ _ _ =
    error "buildComputedFieldBooleanExp: not implemented for the Data Connector backend."
  listAllTables = listAllTables'
  listAllTrackables = listAllTrackables'
  getTableInfo = getTableInfo'
  supportsBeingRemoteRelationshipTarget = supportsBeingRemoteRelationshipTarget'

arityJsonAggSelect :: API.FunctionArity -> JsonAggSelect
arityJsonAggSelect = \case
  API.FunctionArityOne -> JASSingleObject
  API.FunctionArityMany -> JASMultipleRows

functionReturnTypeFromAPI ::
  (MonadError QErr m) =>
  DC.FunctionName ->
  (Maybe (FunctionReturnType 'DataConnector), API.FunctionReturnType) ->
  m DC.TableName
functionReturnTypeFromAPI funcGivenName = \case
  (Just (DC.FunctionReturnsTable t), _) -> pure t
  (_, API.FunctionReturnsTable t) -> pure (Witch.into t)
  _ ->
    throw400 NotSupported
      $ "Function "
      <> toTxt funcGivenName
      <> " is missing a return type - This should be explicit in metadata, or inferred from agent"

buildFunctionInfo' ::
  (MonadError QErr m) =>
  SourceName ->
  DC.FunctionName ->
  SystemDefined ->
  FunctionConfig 'DataConnector ->
  FunctionPermissionsMap ->
  API.FunctionInfo ->
  Maybe Text ->
  NamingCase ->
  m
    ( Hasura.Function.Cache.FunctionInfo 'DataConnector,
      SchemaDependency
    )
buildFunctionInfo'
  sourceName
  funcName
  sysDefined
  funcConfig@FunctionConfig {..}
  permissionMap
  (API.FunctionInfo infoName infoType returnType infoSet infoArgs infoDesc)
  funcComment
  namingCase =
    do
      funcGivenName <- functionGraphQLName @'DataConnector funcName `onLeft` throwError
      let (volitility, exposeAs) = case infoType of
            API.FRead -> (FTSTABLE, FEAQuery)
            API.FWrite -> (FTVOLATILE, FEAMutation)
          setNamingCase = applyFieldNameCaseCust namingCase
      objid <-
        case (_fcResponse, returnType) of
          (Just (DC.FunctionReturnsTable t), _) -> pure $ SOSourceObj sourceName $ mkAnyBackend $ SOITable @'DataConnector t
          (_, API.FunctionReturnsTable t) -> pure $ SOSourceObj sourceName $ mkAnyBackend $ SOITable @'DataConnector (Witch.into t)
          _ ->
            throw400 NotSupported
              $ "Function "
              <> tshow funcName
              <> " is missing a return type - This should be explicit in metadata, or inferred from agent"

      inputArguments <- do
        let argNames = map API._faInputArgName infoArgs
            invalidArgs = filter (isNothing . GQL.mkName) argNames
        unless (null invalidArgs) $ throw400 NotSupported $ "Invalid argument names: " <> tshow invalidArgs
        -- Modified version of makeInputArguments from PG:
        case _fcSessionArgument of
          Nothing -> pure $ Seq.fromList $ map IAUserProvided infoArgs
          Just sessionArgName -> do
            unless (any (\arg -> getFuncArgNameTxt sessionArgName == API._faInputArgName arg) infoArgs)
              $ throw400 NotSupported
              $ "Session argument not mappable: "
              <> tshow sessionArgName
            pure
              $ Seq.fromList
              $ flip map infoArgs
              $ \arg ->
                if getFuncArgNameTxt sessionArgName == API._faInputArgName arg
                  then IASessionVariables sessionArgName
                  else IAUserProvided arg

      functionReturnType <- functionReturnTypeFromAPI funcName (_fcResponse, returnType)

      let funcInfo =
            FunctionInfo
              { _fiSQLName = Witch.into infoName, -- Converts to DC.FunctionName
                _fiGQLName = getFunctionGQLName funcGivenName funcConfig setNamingCase,
                _fiGQLArgsName = getFunctionArgsGQLName funcGivenName funcConfig setNamingCase,
                _fiGQLAggregateName = getFunctionAggregateGQLName funcGivenName funcConfig setNamingCase,
                _fiSystemDefined = sysDefined,
                _fiVolatility = volitility,
                _fiExposedAs = exposeAs,
                _fiInputArgs = inputArguments,
                _fiReturnType = functionReturnType,
                _fiDescription = infoDesc,
                _fiPermissions = permissionMap,
                _fiJsonAggSelect = arityJsonAggSelect infoSet,
                _fiComment = funcComment
              }
      pure $ (funcInfo, SchemaDependency objid DRTable)

resolveBackendInfo' ::
  forall arr m.
  ( ArrowChoice arr,
    Inc.ArrowCache m arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr,
    MonadIO m,
    MonadBaseControl IO m,
    ProvidesNetwork m
  ) =>
  Logger Hasura ->
  (Inc.Dependency (Maybe (HashMap DC.DataConnectorName Inc.InvalidationKey)), Map.Map DC.DataConnectorName DC.DataConnectorOptions) `arr` HashMap DC.DataConnectorName DC.DataConnectorInfo
resolveBackendInfo' logger = proc (invalidationKeys, optionsMap) -> do
  maybeDataConnectorCapabilities <-
    (|
      Inc.keyed
        ( \dataConnectorName dataConnectorOptions -> do
            getDataConnectorCapabilitiesIfNeeded -< (invalidationKeys, dataConnectorName, dataConnectorOptions)
        )
      |)
      (toHashMap optionsMap)
  returnA -< HashMap.catMaybes maybeDataConnectorCapabilities
  where
    getDataConnectorCapabilitiesIfNeeded ::
      (Inc.Dependency (Maybe (HashMap DC.DataConnectorName Inc.InvalidationKey)), DC.DataConnectorName, DC.DataConnectorOptions) `arr` Maybe DC.DataConnectorInfo
    getDataConnectorCapabilitiesIfNeeded = Inc.cache proc (invalidationKeys, dataConnectorName, dataConnectorOptions) -> do
      let metadataObj = MetadataObject (MODataConnectorAgent dataConnectorName) $ J.toJSON dataConnectorName
      httpMgr <- bindA -< askHTTPManager
      Inc.dependOn -< Inc.selectMaybeD (Inc.ConstS dataConnectorName) invalidationKeys
      (|
        withRecordInconsistency
          ( bindErrorA -< ExceptT $ getDataConnectorCapabilities dataConnectorOptions httpMgr
          )
        |)
        metadataObj

    getDataConnectorCapabilities ::
      DC.DataConnectorOptions ->
      HTTP.Manager ->
      m (Either QErr DC.DataConnectorInfo)
    getDataConnectorCapabilities options@DC.DataConnectorOptions {..} manager = runExceptT do
      API.CapabilitiesResponse {..} <-
        ignoreTraceT
          . flip runAgentClientT (AgentClientContext logger _dcoUri manager Nothing Nothing)
          $ Client.capabilities
      pure $ DC.DataConnectorInfo options _crCapabilities _crConfigSchemaResponse _crDisplayName _crReleaseName

    toHashMap = HashMap.fromList . Map.toList

resolveSourceConfig' ::
  (Monad m) =>
  SourceName ->
  DC.ConnSourceConfig ->
  BackendSourceKind 'DataConnector ->
  HashMap DC.DataConnectorName DC.DataConnectorInfo ->
  Environment ->
  HTTP.Manager ->
  m (Either QErr DC.SourceConfig)
resolveSourceConfig'
  sourceName
  csc@DC.ConnSourceConfig {template, timeout, value = originalConfig}
  (DataConnectorKind dataConnectorName)
  backendInfo
  env
  manager = runExceptT do
    DC.DataConnectorInfo {_dciOptions = DC.DataConnectorOptions {_dcoUri}, ..} <- getDataConnectorInfo dataConnectorName backendInfo

    validateConnSourceConfig dataConnectorName sourceName _dciConfigSchemaResponse csc Nothing env

    pure
      DC.SourceConfig
        { _scEndpoint = _dcoUri,
          _scConfig = originalConfig,
          _scTemplate = template,
          _scCapabilities = _dciCapabilities,
          _scManager = manager,
          _scTimeoutMicroseconds = (DC.sourceTimeoutMicroseconds <$> timeout),
          _scDataConnectorName = dataConnectorName,
          _scEnvironment = env
        }

getDataConnectorInfo :: (MonadError QErr m) => DC.DataConnectorName -> HashMap DC.DataConnectorName DC.DataConnectorInfo -> m DC.DataConnectorInfo
getDataConnectorInfo dataConnectorName backendInfo =
  onNothing (HashMap.lookup dataConnectorName backendInfo)
    $ throw400 DataConnectorError ("Data connector named " <> toTxt dataConnectorName <<> " was not found in the data connector backend info")

mkRawColumnType :: API.Capabilities -> API.ColumnType -> RQL.T.C.RawColumnType 'DataConnector
mkRawColumnType capabilities = \case
  API.ColumnTypeScalar scalarType -> RQL.T.C.RawColumnTypeScalar $ DC.mkScalarType capabilities scalarType
  API.ColumnTypeObject name -> RQL.T.C.RawColumnTypeObject () name
  API.ColumnTypeArray columnType isNullable -> RQL.T.C.RawColumnTypeArray () (mkRawColumnType capabilities columnType) isNullable

resolveDatabaseMetadata' ::
  ( MonadIO m,
    MonadBaseControl IO m
  ) =>
  Logger Hasura ->
  SourceMetadata 'DataConnector ->
  DC.SourceConfig ->
  m (Either QErr (DBObjectsIntrospection 'DataConnector))
resolveDatabaseMetadata' logger SourceMetadata {_smName} sourceConfig@DC.SourceConfig {_scCapabilities} = runExceptT do
  API.SchemaResponse {..} <- requestDatabaseSchema logger _smName sourceConfig
  let customObjectTypes =
        maybe mempty (HashMap.fromList . mapMaybe (toTableObjectType _scCapabilities) . toList) _srObjectTypes
      tables = HashMap.fromList $ do
        API.TableInfo {..} <- _srTables
        let primaryKeyColumns = fmap Witch.from . NESeq.fromList <$> _tiPrimaryKey
        let meta =
              RQL.T.T.DBTableMetadata
                { _ptmiOid = OID 0, -- TODO: This is wrong and needs to be fixed. It is used for diffing tables and seeing what's new/deleted/altered, so reusing 0 for all tables is problematic.
                  _ptmiColumns = do
                    API.ColumnInfo {..} <- _tiColumns
                    pure
                      $ RQL.T.C.RawColumnInfo
                        { rciName = Witch.from _ciName,
                          rciPosition = 1, -- TODO: This is very wrong and needs to be fixed. It is used for diffing tables and seeing what's new/deleted/altered, so reusing 1 for all columns is problematic.
                          rciType = mkRawColumnType _scCapabilities _ciType,
                          rciIsNullable = _ciNullable,
                          rciDescription = fmap GQL.Description _ciDescription,
                          rciMutability = RQL.T.C.ColumnMutability _ciInsertable _ciUpdatable
                        },
                  _ptmiPrimaryKey = RQL.T.T.PrimaryKey (RQL.T.T.Constraint (DC.ConstraintName "") (OID 0)) <$> primaryKeyColumns,
                  _ptmiUniqueConstraints = mempty,
                  _ptmiForeignKeys = buildForeignKeySet _tiForeignKeys,
                  _ptmiViewInfo =
                    ( if _tiType == API.Table && _tiInsertable && _tiUpdatable && _tiDeletable
                        then Nothing
                        else Just $ RQL.T.T.ViewInfo _tiInsertable _tiUpdatable _tiDeletable
                    ),
                  _ptmiDescription = fmap PGDescription _tiDescription,
                  _ptmiExtraTableMetadata =
                    DC.ExtraTableMetadata
                      { _etmTableType = _tiType,
                        _etmExtraColumnMetadata =
                          _tiColumns
                            & fmap (\API.ColumnInfo {..} -> (Witch.from _ciName, DC.ExtraColumnMetadata _ciValueGenerated))
                            & HashMap.fromList
                      },
                  _ptmiCustomObjectTypes = Just customObjectTypes
                }
        pure (Witch.into _tiName, meta)
      functions =
        let sorted = sortOn _fiName _srFunctions
            grouped = NEList.groupBy ((==) `on` _fiName) sorted
         in HashMap.fromList do
              infos@(API.FunctionInfo {..} NEList.:| _) <- grouped
              pure (Witch.into _fiName, FunctionOverloads infos)
   in pure
        $ DBObjectsIntrospection
          { _rsTables = tables,
            _rsFunctions = functions,
            _rsScalars = mempty
          }

requestDatabaseSchema ::
  (MonadIO m, MonadBaseControl IO m, MonadError QErr m) =>
  Logger Hasura ->
  SourceName ->
  DC.SourceConfig ->
  m API.SchemaResponse
requestDatabaseSchema logger sourceName sourceConfig = do
  transformedSourceConfig <- transformSourceConfig sourceConfig Nothing
  ignoreTraceT
    . flip runAgentClientT (AgentClientContext logger (DC._scEndpoint transformedSourceConfig) (DC._scManager transformedSourceConfig) (DC._scTimeoutMicroseconds transformedSourceConfig) Nothing)
    $ Client.schema sourceName (DC._scConfig transformedSourceConfig)

getFieldType :: API.Capabilities -> API.ColumnType -> Maybe (RQL.T.T.TableObjectFieldType 'DataConnector)
getFieldType capabilities = \case
  API.ColumnTypeScalar scalarType -> RQL.T.T.TOFTScalar <$> G.mkName (API.getScalarType scalarType) <*> pure (DC.mkScalarType capabilities scalarType)
  API.ColumnTypeObject objectTypeName -> pure $ RQL.T.T.TOFTObject objectTypeName
  API.ColumnTypeArray columnType isNullable -> RQL.T.T.TOFTArray () <$> getFieldType capabilities columnType <*> pure isNullable

getGraphQLType :: Bool -> RQL.T.T.TableObjectFieldType 'DataConnector -> G.GType
getGraphQLType isNullable = \case
  RQL.T.T.TOFTScalar name _ -> G.TypeNamed (G.Nullability isNullable) name
  RQL.T.T.TOFTObject name -> G.TypeNamed (G.Nullability isNullable) name
  RQL.T.T.TOFTArray _ fieldType isNullable' ->
    G.TypeList (G.Nullability isNullable) $ getGraphQLType isNullable' fieldType

toTableObjectType :: API.Capabilities -> API.ObjectTypeDefinition -> Maybe (G.Name, RQL.T.T.TableObjectType 'DataConnector)
toTableObjectType capabilities API.ObjectTypeDefinition {..} =
  (_otdName,) . RQL.T.T.TableObjectType _otdName (G.Description <$> _otdDescription) <$> traverse toTableObjectFieldDefinition _otdColumns
  where
    toTableObjectFieldDefinition API.ColumnInfo {..} = do
      fieldType <- getFieldType capabilities _ciType
      fieldName <- G.mkName $ API.unColumnName _ciName
      pure
        $ RQL.T.T.TableObjectFieldDefinition
          { _tofdColumn = Witch.from _ciName,
            _tofdName = fieldName,
            _tofdDescription = G.Description <$> _ciDescription,
            _tofdGType = GraphQLType $ getGraphQLType _ciNullable fieldType,
            _tofdFieldType = fieldType
          }

-- | Construct a 'HashSet' 'RQL.T.T.ForeignKeyMetadata'
-- 'DataConnector' to build the foreign key constraints in the table
-- metadata.
buildForeignKeySet :: API.ForeignKeys -> HashSet (RQL.T.T.ForeignKeyMetadata 'DataConnector)
buildForeignKeySet (API.ForeignKeys constraints) =
  HashSet.fromList
    $ constraints
    & HashMap.foldMapWithKey @[RQL.T.T.ForeignKeyMetadata 'DataConnector]
      \constraintName API.Constraint {..} -> maybeToList do
        let columnMapAssocList = HashMap.foldrWithKey' (\(API.ColumnName k) (API.ColumnName v) acc -> (DC.ColumnName k, DC.ColumnName v) : acc) [] _cColumnMapping
        columnMapping <- NEHashMap.fromList columnMapAssocList
        let foreignKey =
              RQL.T.T.ForeignKey
                { _fkConstraint = RQL.T.T.Constraint (Witch.from constraintName) (OID 1),
                  _fkForeignTable = Witch.from _cForeignTable,
                  _fkColumnMapping = columnMapping
                }
        pure $ RQL.T.T.ForeignKeyMetadata foreignKey

-- | This is needed to get permissions to work
parseBoolExpOperations' ::
  forall m v.
  (MonadError QErr m) =>
  RQL.T.C.ValueParser 'DataConnector m v ->
  RQL.T.T.FieldInfoMap (RQL.T.T.FieldInfo 'DataConnector) ->
  RQL.T.T.FieldInfoMap (RQL.T.T.FieldInfo 'DataConnector) ->
  RQL.T.C.ColumnReference 'DataConnector ->
  J.Value ->
  m [OpExpG 'DataConnector v]
parseBoolExpOperations' rhsParser rootFieldInfoMap fieldInfoMap columnRef value =
  withPathK (toTxt columnRef) $ parseOperations value
  where
    columnType :: RQL.T.C.ColumnType 'DataConnector
    columnType = RQL.T.C.columnReferenceType columnRef

    parseWithTy ty = rhsParser (CollectableTypeScalar ty)

    parseOperations :: J.Value -> m [OpExpG 'DataConnector v]
    parseOperations = \case
      J.Object o -> traverse (parseOperation . first K.toText) $ KM.toList o
      v -> pure . AEQ False <$> parseWithTy columnType v

    parseOperation :: (Text, J.Value) -> m (OpExpG 'DataConnector v)
    parseOperation (opStr, val) = withPathK opStr
      $ case opStr of
        "_eq" -> parseEq
        "$eq" -> parseEq
        "_neq" -> parseNeq
        "$neq" -> parseNeq
        "_gt" -> parseGt
        "$gt" -> parseGt
        "_lt" -> parseLt
        "$lt" -> parseLt
        "_gte" -> parseGte
        "$gte" -> parseGte
        "_lte" -> parseLte
        "$lte" -> parseLte
        "_in" -> parseIn
        "$in" -> parseIn
        "_nin" -> parseNin
        "$nin" -> parseNin
        "_is_null" -> parseIsNull
        "$is_null" -> parseIsNull
        "_ceq" -> parseCeq
        "$ceq" -> parseCeq
        "_cneq" -> parseCne
        "$cneq" -> parseCne
        "_cgt" -> parseCgt
        "$cgt" -> parseCgt
        "_clt" -> parseClt
        "$clt" -> parseClt
        "_cgte" -> parseCgte
        "$cgte" -> parseCgte
        "_clte" -> parseClte
        "$clte" -> parseClte
        -- "_like"          -> parseLike
        -- "$like"          -> parseLike
        --
        -- "_nlike"         -> parseNlike
        -- "$nlike"         -> parseNlike
        --
        -- "_cast" -> parseCast
        -- "$cast" -> parseCast

        x -> throw400 UnexpectedPayload $ "Unknown operator: " <> x
      where
        parseOne = parseWithTy columnType val
        parseManyWithType ty = rhsParser (CollectableTypeArray ty) val

        parseEq = AEQ False <$> parseOne
        parseNeq = ANE False <$> parseOne
        parseIn = AIN <$> parseManyWithType columnType
        parseNin = ANIN <$> parseManyWithType columnType
        parseGt = AGT <$> parseOne
        parseLt = ALT <$> parseOne
        parseGte = AGTE <$> parseOne
        parseLte = ALTE <$> parseOne
        parseIsNull = bool ANISNOTNULL ANISNULL <$> decodeValue val
        parseCeq = CEQ <$> decodeAndValidateRhsCol val
        parseCne = CNE <$> decodeAndValidateRhsCol val
        parseCgt = CGT <$> decodeAndValidateRhsCol val
        parseClt = CLT <$> decodeAndValidateRhsCol val
        parseCgte = CGTE <$> decodeAndValidateRhsCol val
        parseClte = CLTE <$> decodeAndValidateRhsCol val

        decodeAndValidateRhsCol :: J.Value -> m (RootOrCurrentColumn 'DataConnector)
        decodeAndValidateRhsCol v = case v of
          J.String _ -> go IsCurrent fieldInfoMap v
          J.Array path -> case toList path of
            [] -> throw400 Unexpected "path cannot be empty"
            [col] -> go IsCurrent fieldInfoMap col
            [J.String "$", col] -> go IsRoot rootFieldInfoMap col
            _ -> throw400 NotSupported "Relationship references are not supported in column comparison RHS"
          _ -> throw400 Unexpected "a boolean expression JSON must be either a string or an array"
          where
            go rootInfo fieldInfoMap' columnValue = do
              colName <- decodeValue columnValue
              colInfo <- validateRhsColumn fieldInfoMap' colName
              pure $ RootOrCurrentColumn rootInfo colInfo

        validateRhsColumn :: RQL.T.T.FieldInfoMap (RQL.T.T.FieldInfo 'DataConnector) -> DC.ColumnName -> m DC.ColumnName
        validateRhsColumn fieldInfoMap' rhsCol = do
          rhsType <- RQL.T.T.askColumnType fieldInfoMap' rhsCol "column operators can only compare table columns"
          when (columnType /= rhsType)
            $ throw400 UnexpectedPayload
            $ "incompatible column types: "
            <> columnRef
            <<> " has type "
            <> columnType
            <<> ", but "
            <> rhsCol
            <<> " has type "
            <>> rhsType
          pure rhsCol

parseCollectableType' ::
  (MonadError QErr m) =>
  CollectableType (RQL.T.C.ColumnType 'DataConnector) ->
  J.Value ->
  m (PartialSQLExp 'DataConnector)
parseCollectableType' collectableType = \case
  J.String t
    | HSU.isSessionVariable t -> pure $ mkTypedSessionVar collectableType $ mkSessionVariable t
    | HSU.isReqUserId t -> pure $ mkTypedSessionVar collectableType HSU.userIdHeader
  val -> case collectableType of
    CollectableTypeScalar columnType ->
      PSESQLExp . DC.ValueLiteral (columnTypeToScalarType columnType) <$> RQL.T.C.parseScalarValueColumnType columnType val
    CollectableTypeArray columnType -> do
      vals <- runAesonParser J.parseJSON val
      scalarValues <- RQL.T.C.parseScalarValuesColumnType columnType vals
      pure . PSESQLExp $ DC.ArrayLiteral (columnTypeToScalarType columnType) scalarValues

mkTypedSessionVar ::
  CollectableType (RQL.T.C.ColumnType 'DataConnector) ->
  SessionVariable ->
  PartialSQLExp 'DataConnector
mkTypedSessionVar columnType =
  PSESessVar (columnTypeToScalarType <$> columnType)

buildObjectRelationshipInfo' ::
  (MonadError QErr m) =>
  DC.SourceConfig ->
  SourceName ->
  HashMap DC.TableName (HashSet (ForeignKey 'DataConnector)) ->
  DC.TableName ->
  ObjRelDef 'DataConnector ->
  m (RelInfo 'DataConnector, Seq SchemaDependency)
buildObjectRelationshipInfo' sourceConfig sourceName fks tableName objRel = do
  ifSupportsLocalRelationships sourceName sourceConfig
    $ defaultBuildObjectRelationshipInfo sourceName fks tableName objRel

buildArrayRelationshipInfo' ::
  (MonadError QErr m) =>
  DC.SourceConfig ->
  SourceName ->
  HashMap DC.TableName (HashSet (ForeignKey 'DataConnector)) ->
  DC.TableName ->
  ArrRelDef 'DataConnector ->
  m (RelInfo 'DataConnector, Seq SchemaDependency)
buildArrayRelationshipInfo' sourceConfig sourceName fks tableName arrRel =
  ifSupportsLocalRelationships sourceName sourceConfig
    $ defaultBuildArrayRelationshipInfo sourceName fks tableName arrRel

ifSupportsLocalRelationships :: (MonadError QErr m) => SourceName -> DC.SourceConfig -> m a -> m a
ifSupportsLocalRelationships sourceName DC.SourceConfig {..} action = do
  let supportsRelationships = isJust $ API._cRelationships _scCapabilities
  let supportsRemoteRelationships = isJust $ API._qcForeach =<< API._cQueries _scCapabilities
  if supportsRelationships
    then action
    else
      let suggestion =
            if supportsRemoteRelationships
              then " Instead consider using remote relationships to join between tables on the same source."
              else ""
       in throw400 NotSupported $ "Local object and array relationships are not supported for '" <> toTxt sourceName <> "'." <> suggestion

supportsBeingRemoteRelationshipTarget' :: DC.SourceConfig -> Bool
supportsBeingRemoteRelationshipTarget' DC.SourceConfig {..} =
  isJust $ API._qcForeach =<< API._cQueries _scCapabilities

listAllTables' :: (CacheRM m, Has (Logger Hasura) r, MonadIO m, MonadBaseControl IO m, MonadReader r m, MonadError QErr m, MetadataM m) => SourceName -> m [DC.TableName]
listAllTables' sourceName = do
  (logger :: Logger Hasura) <- asks getter
  sourceConfig <- askSourceConfig @'DataConnector sourceName
  schemaResponse <- requestDatabaseSchema logger sourceName sourceConfig
  pure $ fmap (Witch.from . API._tiName) $ API._srTables schemaResponse

listAllTrackables' :: (CacheRM m, Has (Logger Hasura) r, MonadIO m, MonadBaseControl IO m, MonadReader r m, MonadError QErr m, MetadataM m) => SourceName -> m (TrackableInfo 'DataConnector)
listAllTrackables' sourceName = do
  (logger :: Logger Hasura) <- asks getter
  sourceConfig <- askSourceConfig @'DataConnector sourceName
  schemaResponse <- requestDatabaseSchema logger sourceName sourceConfig
  let functions = fmap (\fi -> TrackableFunctionInfo (Witch.into (API._fiName fi)) (getVolatility (API._fiFunctionType fi))) $ API._srFunctions schemaResponse
  let tables = fmap (TrackableTableInfo . Witch.into . API._tiName) $ API._srTables schemaResponse
  pure
    TrackableInfo
      { trackableTables = tables,
        trackableFunctions = functions
      }

getVolatility :: API.FunctionType -> FunctionVolatility
getVolatility API.FRead = FTSTABLE
getVolatility API.FWrite = FTVOLATILE

getTableInfo' :: (CacheRM m, MetadataM m, MonadError QErr m) => SourceName -> DC.TableName -> m (Maybe (SourceTableInfo 'DataConnector))
getTableInfo' sourceName tableName = do
  SourceInfo {_siDbObjectsIntrospection} <- askSourceInfo @'DataConnector sourceName

  let tables :: HashMap DC.TableName (RQL.T.T.DBTableMetadata 'DataConnector)
      tables = _rsTables _siDbObjectsIntrospection

  pure $ fmap (convertTableMetadataToTableInfo tableName) (HashMap.lookup tableName tables)

convertTableMetadataToTableInfo :: DC.TableName -> RQL.T.T.DBTableMetadata 'DataConnector -> SourceTableInfo 'DataConnector
convertTableMetadataToTableInfo tableName RQL.T.T.DBTableMetadata {..} =
  SourceTableInfo
    { _stiName = Witch.from tableName,
      _stiType = case DC._etmTableType _ptmiExtraTableMetadata of
        DC.Table -> Table
        DC.View -> View,
      _stiColumns = convertColumn <$> _ptmiColumns,
      _stiPrimaryKey = fmap Witch.from . toNonEmpty . RQL.T.T._pkColumns <$> _ptmiPrimaryKey,
      _stiForeignKeys = convertForeignKeys _ptmiForeignKeys,
      _stiDescription = getPGDescription <$> _ptmiDescription,
      _stiInsertable = all RQL.T.T.viIsInsertable _ptmiViewInfo,
      _stiUpdatable = all RQL.T.T.viIsUpdatable _ptmiViewInfo,
      _stiDeletable = all RQL.T.T.viIsDeletable _ptmiViewInfo
    }
  where
    convertColumn :: RQL.T.C.RawColumnInfo 'DataConnector -> SourceColumnInfo 'DataConnector
    convertColumn RQL.T.C.RawColumnInfo {..} =
      SourceColumnInfo
        { _sciName = Witch.from rciName,
          _sciType = Witch.from rciType,
          _sciNullable = rciIsNullable,
          _sciDescription = G.unDescription <$> rciDescription,
          _sciInsertable = RQL.T.C._cmIsInsertable rciMutability,
          _sciUpdatable = RQL.T.C._cmIsUpdatable rciMutability,
          _sciValueGenerated =
            extraColumnMetadata
              >>= DC._ecmValueGenerated
              <&> \case
                API.AutoIncrement -> AutoIncrement
                API.UniqueIdentifier -> UniqueIdentifier
                API.DefaultValue -> DefaultValue
        }
      where
        extraColumnMetadata = HashMap.lookup rciName . DC._etmExtraColumnMetadata $ _ptmiExtraTableMetadata

    convertForeignKeys :: HashSet (RQL.T.T.ForeignKeyMetadata 'DataConnector) -> SourceForeignKeys 'DataConnector
    convertForeignKeys foreignKeys =
      foreignKeys
        & HashSet.toList
        & fmap
          ( \(RQL.T.T.ForeignKeyMetadata RQL.T.T.ForeignKey {..}) ->
              let constraintName = RQL.T.T._cName _fkConstraint
                  constraint =
                    SourceConstraint
                      { _scForeignTable = Witch.from _fkForeignTable,
                        _scColumnMapping = HashMap.fromList $ bimap Witch.from Witch.from <$> NEHashMap.toList _fkColumnMapping
                      }
               in (constraintName, constraint)
          )
        & HashMap.fromList
        & SourceForeignKeys