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

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

import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Environment (Environment)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as HashSet
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text qualified as Text
import Data.Text.Extended (toTxt, (<<>), (<>>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformConnSourceConfig)
import Hasura.Backends.DataConnector.Adapter.Types (ConnSourceConfig (ConnSourceConfig))
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
import Hasura.Backends.DataConnector.IR.Column qualified as IR.C
import Hasura.Backends.DataConnector.IR.Name qualified as IR.N
import Hasura.Backends.DataConnector.IR.Scalar.Type qualified as IR.S.T
import Hasura.Backends.DataConnector.IR.Scalar.Value qualified as IR.S.V
import Hasura.Backends.DataConnector.IR.Table qualified as IR.T
import Hasura.Backends.Postgres.SQL.Types (PGDescription (..))
import Hasura.Base.Error (Code (..), QErr, decodeValue, throw400, throw500, withPathK)
import Hasura.Logging (Hasura, Logger)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (OpExpG (..), PartialSQLExp (..), RootOrCurrent (..), RootOrCurrentColumn (..))
import Hasura.RQL.Types.Column qualified as RQL.T.C
import Hasura.RQL.Types.Common (OID (..), SourceName)
import Hasura.RQL.Types.EventTrigger (RecreateEventTriggers (RETDoNothing))
import Hasura.RQL.Types.Metadata (SourceMetadata (..))
import Hasura.RQL.Types.Metadata.Backend (BackendMetadata (..))
import Hasura.RQL.Types.SchemaCache qualified as SchemaCache
import Hasura.RQL.Types.Source (ResolvedSource (..))
import Hasura.RQL.Types.SourceCustomization (SourceTypeCustomization)
import Hasura.RQL.Types.Table (ForeignKey (_fkConstraint))
import Hasura.RQL.Types.Table qualified as RQL.T.T
import Hasura.SQL.Backend (BackendSourceKind (..), BackendType (..))
import Hasura.SQL.Types (CollectableType (..))
import Hasura.Server.Utils qualified as HSU
import Hasura.Session (SessionVariable, mkSessionVariable)
import Hasura.Tracing (noReporter, runTraceTWithReporter)
import Language.GraphQL.Draft.Syntax qualified as GQL
import Network.HTTP.Client qualified as HTTP
import Servant.Client.Core.HasClient ((//))
import Servant.Client.Generic (genericClient)
import Witch qualified

instance BackendMetadata 'DataConnector where
  prepareCatalog :: SourceConfig 'DataConnector -> ExceptT QErr m RecreateEventTriggers
prepareCatalog SourceConfig 'DataConnector
_ = RecreateEventTriggers -> ExceptT QErr m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETDoNothing
  resolveSourceConfig :: Logger Hasura
-> SourceName
-> SourceConnConfiguration 'DataConnector
-> BackendSourceKind 'DataConnector
-> BackendConfig 'DataConnector
-> Environment
-> Manager
-> m (Either QErr (SourceConfig 'DataConnector))
resolveSourceConfig = Logger Hasura
-> SourceName
-> SourceConnConfiguration 'DataConnector
-> BackendSourceKind 'DataConnector
-> BackendConfig 'DataConnector
-> Environment
-> Manager
-> m (Either QErr (SourceConfig 'DataConnector))
forall (m :: * -> *).
MonadIO m =>
Logger Hasura
-> SourceName
-> ConnSourceConfig
-> BackendSourceKind 'DataConnector
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> Environment
-> Manager
-> m (Either QErr SourceConfig)
resolveSourceConfig'
  resolveDatabaseMetadata :: SourceMetadata 'DataConnector
-> SourceConfig 'DataConnector
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource 'DataConnector))
resolveDatabaseMetadata = SourceMetadata 'DataConnector
-> SourceConfig 'DataConnector
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource 'DataConnector))
forall (m :: * -> *).
Applicative m =>
SourceMetadata 'DataConnector
-> SourceConfig
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource 'DataConnector))
resolveDatabaseMetadata'
  parseBoolExpOperations :: ValueParser 'DataConnector m v
-> TableName 'DataConnector
-> FieldInfoMap (FieldInfo 'DataConnector)
-> ColumnReference 'DataConnector
-> Value
-> m [OpExpG 'DataConnector v]
parseBoolExpOperations = ValueParser 'DataConnector m v
-> TableName 'DataConnector
-> FieldInfoMap (FieldInfo 'DataConnector)
-> ColumnReference 'DataConnector
-> Value
-> m [OpExpG 'DataConnector v]
forall (m :: * -> *) v.
(MonadError QErr m, TableCoreInfoRM 'DataConnector m) =>
ValueParser 'DataConnector m v
-> Name
-> FieldInfoMap (FieldInfo 'DataConnector)
-> ColumnReference 'DataConnector
-> Value
-> m [OpExpG 'DataConnector v]
parseBoolExpOperations'
  parseCollectableType :: CollectableType (ColumnType 'DataConnector)
-> Value -> m (PartialSQLExp 'DataConnector)
parseCollectableType = CollectableType (ColumnType 'DataConnector)
-> Value -> m (PartialSQLExp 'DataConnector)
forall (m :: * -> *).
MonadError QErr m =>
CollectableType (ColumnType 'DataConnector)
-> Value -> m (PartialSQLExp 'DataConnector)
parseCollectableType'
  buildComputedFieldInfo :: HashSet (TableName 'DataConnector)
-> TableName 'DataConnector
-> HashSet (Column 'DataConnector)
-> ComputedFieldName
-> ComputedFieldDefinition 'DataConnector
-> RawFunctionInfo 'DataConnector
-> Comment
-> m (ComputedFieldInfo 'DataConnector)
buildComputedFieldInfo = [Char]
-> HashSet Name
-> Name
-> HashSet Name
-> ComputedFieldName
-> ()
-> XDisable
-> Comment
-> m (ComputedFieldInfo 'DataConnector)
forall a. HasCallStack => [Char] -> a
error [Char]
"buildComputedFieldInfo: not implemented for the Data Connector backend."
  fetchAndValidateEnumValues :: SourceConfig 'DataConnector
-> TableName 'DataConnector
-> Maybe (PrimaryKey 'DataConnector (RawColumnInfo 'DataConnector))
-> [RawColumnInfo 'DataConnector]
-> m (Either QErr EnumValues)
fetchAndValidateEnumValues = [Char]
-> SourceConfig
-> Name
-> Maybe (PrimaryKey 'DataConnector (RawColumnInfo 'DataConnector))
-> [RawColumnInfo 'DataConnector]
-> m (Either QErr EnumValues)
forall a. HasCallStack => [Char] -> a
error [Char]
"fetchAndValidateEnumValues: not implemented for the Data Connector backend."
  buildFunctionInfo :: SourceName
-> FunctionName 'DataConnector
-> SystemDefined
-> FunctionConfig
-> FunctionPermissionsMap
-> RawFunctionInfo 'DataConnector
-> Maybe Text
-> NamingCase
-> m (FunctionInfo 'DataConnector, SchemaDependency)
buildFunctionInfo = [Char]
-> SourceName
-> Name
-> SystemDefined
-> FunctionConfig
-> FunctionPermissionsMap
-> XDisable
-> Maybe Text
-> NamingCase
-> m (FunctionInfo 'DataConnector, SchemaDependency)
forall a. HasCallStack => [Char] -> a
error [Char]
"buildFunctionInfo: not implemented for the Data Connector backend."
  updateColumnInEventTrigger :: TableName 'DataConnector
-> Column 'DataConnector
-> Column 'DataConnector
-> TableName 'DataConnector
-> EventTriggerConf 'DataConnector
-> EventTriggerConf 'DataConnector
updateColumnInEventTrigger = [Char]
-> Name
-> Name
-> Name
-> Name
-> EventTriggerConf 'DataConnector
-> EventTriggerConf 'DataConnector
forall a. HasCallStack => [Char] -> a
error [Char]
"updateColumnInEventTrigger: not implemented for the Data Connector backend."
  postDropSourceHook :: SourceConfig 'DataConnector
-> TableEventTriggers 'DataConnector -> m ()
postDropSourceHook SourceConfig 'DataConnector
_sourceConfig TableEventTriggers 'DataConnector
_tableTriggerMap = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  buildComputedFieldBooleanExp :: BoolExpResolver 'DataConnector m v
-> BoolExpRHSParser 'DataConnector m v
-> TableName 'DataConnector
-> FieldInfoMap (FieldInfo 'DataConnector)
-> ComputedFieldInfo 'DataConnector
-> Value
-> m (AnnComputedFieldBoolExp 'DataConnector v)
buildComputedFieldBooleanExp BoolExpResolver 'DataConnector m v
_ BoolExpRHSParser 'DataConnector m v
_ TableName 'DataConnector
_ FieldInfoMap (FieldInfo 'DataConnector)
_ ComputedFieldInfo 'DataConnector
_ Value
_ =
    [Char] -> m (AnnComputedFieldBoolExp 'DataConnector v)
forall a. HasCallStack => [Char] -> a
error [Char]
"buildComputedFieldBooleanExp: not implemented for the Data Connector backend."

resolveSourceConfig' ::
  MonadIO m =>
  Logger Hasura ->
  SourceName ->
  DC.ConnSourceConfig ->
  BackendSourceKind 'DataConnector ->
  InsOrdHashMap DC.DataConnectorName DC.DataConnectorOptions ->
  Environment ->
  HTTP.Manager ->
  m (Either QErr DC.SourceConfig)
resolveSourceConfig' :: Logger Hasura
-> SourceName
-> ConnSourceConfig
-> BackendSourceKind 'DataConnector
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> Environment
-> Manager
-> m (Either QErr SourceConfig)
resolveSourceConfig' Logger Hasura
logger SourceName
sourceName csc :: ConnSourceConfig
csc@ConnSourceConfig {Maybe Text
template :: ConnSourceConfig -> Maybe Text
template :: Maybe Text
template, Maybe SourceTimeout
timeout :: ConnSourceConfig -> Maybe SourceTimeout
timeout :: Maybe SourceTimeout
timeout, value :: ConnSourceConfig -> Config
value = Config
originalConfig} (DataConnectorKind DataConnectorName
dataConnectorName) InsOrdHashMap DataConnectorName DataConnectorOptions
backendConfig Environment
env Manager
manager = ExceptT QErr m SourceConfig -> m (Either QErr SourceConfig)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  DC.DataConnectorOptions {BaseUrl
_dcoUri :: DataConnectorOptions -> BaseUrl
_dcoUri :: BaseUrl
..} <-
    DataConnectorName
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> Maybe DataConnectorOptions
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OMap.lookup DataConnectorName
dataConnectorName InsOrdHashMap DataConnectorName DataConnectorOptions
backendConfig
      Maybe DataConnectorOptions
-> ExceptT QErr m DataConnectorOptions
-> ExceptT QErr m DataConnectorOptions
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> ExceptT QErr m DataConnectorOptions
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DataConnectorError (Text
"Data connector named " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataConnectorName -> Text
forall a. ToTxt a => a -> Text
toTxt DataConnectorName
dataConnectorName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was not found in the data connector backend config")

  Config
transformedConfig <- ConnSourceConfig
-> [(Text, Value)] -> Environment -> ExceptT QErr m Config
forall (m :: * -> *).
MonadError QErr m =>
ConnSourceConfig -> [(Text, Value)] -> Environment -> m Config
transformConnSourceConfig ConnSourceConfig
csc [(Text
"$session", [Pair] -> Value
J.object []), (Text
"$env", Environment -> Value
forall a. ToJSON a => a -> Value
J.toJSON Environment
env)] Environment
env

  -- TODO: capabilities applies to all sources for an agent.
  -- We should be able to call it once per agent and store it in the SchemaCache
  API.CapabilitiesResponse {Capabilities
ConfigSchemaResponse
crCapabilities :: CapabilitiesResponse -> Capabilities
crConfigSchemaResponse :: CapabilitiesResponse -> ConfigSchemaResponse
crConfigSchemaResponse :: ConfigSchemaResponse
crCapabilities :: Capabilities
..} <-
    Reporter
-> Text
-> TraceT (ExceptT QErr m) CapabilitiesResponse
-> ExceptT QErr m CapabilitiesResponse
forall (m :: * -> *) a.
MonadIO m =>
Reporter -> Text -> TraceT m a -> m a
runTraceTWithReporter Reporter
noReporter Text
"capabilities"
      (TraceT (ExceptT QErr m) CapabilitiesResponse
 -> ExceptT QErr m CapabilitiesResponse)
-> (AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
    -> TraceT (ExceptT QErr m) CapabilitiesResponse)
-> AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
-> ExceptT QErr m CapabilitiesResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
 -> AgentClientContext
 -> TraceT (ExceptT QErr m) CapabilitiesResponse)
-> AgentClientContext
-> AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
-> TraceT (ExceptT QErr m) CapabilitiesResponse
forall a b c. (a -> b -> c) -> b -> a -> c
flip AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
-> AgentClientContext
-> TraceT (ExceptT QErr m) CapabilitiesResponse
forall (m :: * -> *) a.
AgentClientT m a -> AgentClientContext -> m a
runAgentClientT (Logger Hasura
-> BaseUrl -> Manager -> Maybe Int -> AgentClientContext
AgentClientContext Logger Hasura
logger BaseUrl
_dcoUri Manager
manager (SourceTimeout -> Int
DC.sourceTimeoutMicroseconds (SourceTimeout -> Int) -> Maybe SourceTimeout -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceTimeout
timeout))
      (AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
 -> ExceptT QErr m CapabilitiesResponse)
-> AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
-> ExceptT QErr m CapabilitiesResponse
forall a b. (a -> b) -> a -> b
$ Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
-> (Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
    -> AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse)
-> AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
forall a b. a -> (a -> b) -> b
// Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
-> AgentClientT (TraceT (ExceptT QErr m)) CapabilitiesResponse
forall mode. Routes mode -> mode :- CapabilitiesApi
API._capabilities

  SourceName
-> DataConnectorName
-> ConfigSchemaResponse
-> Config
-> ExceptT QErr m ()
forall (m :: * -> *).
MonadError QErr m =>
SourceName
-> DataConnectorName -> ConfigSchemaResponse -> Config -> m ()
validateConfiguration SourceName
sourceName DataConnectorName
dataConnectorName ConfigSchemaResponse
crConfigSchemaResponse Config
transformedConfig

  SchemaResponse
schemaResponse <-
    Reporter
-> Text
-> TraceT (ExceptT QErr m) SchemaResponse
-> ExceptT QErr m SchemaResponse
forall (m :: * -> *) a.
MonadIO m =>
Reporter -> Text -> TraceT m a -> m a
runTraceTWithReporter Reporter
noReporter Text
"resolve source"
      (TraceT (ExceptT QErr m) SchemaResponse
 -> ExceptT QErr m SchemaResponse)
-> (AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
    -> TraceT (ExceptT QErr m) SchemaResponse)
-> AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
-> ExceptT QErr m SchemaResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
 -> AgentClientContext -> TraceT (ExceptT QErr m) SchemaResponse)
-> AgentClientContext
-> AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
-> TraceT (ExceptT QErr m) SchemaResponse
forall a b c. (a -> b -> c) -> b -> a -> c
flip AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
-> AgentClientContext -> TraceT (ExceptT QErr m) SchemaResponse
forall (m :: * -> *) a.
AgentClientT m a -> AgentClientContext -> m a
runAgentClientT (Logger Hasura
-> BaseUrl -> Manager -> Maybe Int -> AgentClientContext
AgentClientContext Logger Hasura
logger BaseUrl
_dcoUri Manager
manager (SourceTimeout -> Int
DC.sourceTimeoutMicroseconds (SourceTimeout -> Int) -> Maybe SourceTimeout -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceTimeout
timeout))
      (AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
 -> ExceptT QErr m SchemaResponse)
-> AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
-> ExceptT QErr m SchemaResponse
forall a b. (a -> b) -> a -> b
$ (Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
-> (Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
    -> Text
    -> Config
    -> AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse)
-> Text
-> Config
-> AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
forall a b. a -> (a -> b) -> b
// Routes (AsClientT (AgentClientT (TraceT (ExceptT QErr m))))
-> Text
-> Config
-> AgentClientT (TraceT (ExceptT QErr m)) SchemaResponse
forall mode. Routes mode -> mode :- SchemaApi
API._schema) (SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
sourceName) Config
transformedConfig

  SourceConfig -> ExceptT QErr m SourceConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SourceConfig :: BaseUrl
-> Config
-> Maybe Text
-> Capabilities
-> SchemaResponse
-> Manager
-> Maybe Int
-> DataConnectorName
-> SourceConfig
DC.SourceConfig
      { _scEndpoint :: BaseUrl
_scEndpoint = BaseUrl
_dcoUri,
        _scConfig :: Config
_scConfig = Config
originalConfig,
        _scTemplate :: Maybe Text
_scTemplate = Maybe Text
template,
        _scCapabilities :: Capabilities
_scCapabilities = Capabilities
crCapabilities,
        _scSchema :: SchemaResponse
_scSchema = SchemaResponse
schemaResponse,
        _scManager :: Manager
_scManager = Manager
manager,
        _scTimeoutMicroseconds :: Maybe Int
_scTimeoutMicroseconds = (SourceTimeout -> Int
DC.sourceTimeoutMicroseconds (SourceTimeout -> Int) -> Maybe SourceTimeout -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceTimeout
timeout),
        _scDataConnectorName :: DataConnectorName
_scDataConnectorName = DataConnectorName
dataConnectorName
      }

validateConfiguration ::
  MonadError QErr m =>
  SourceName ->
  DC.DataConnectorName ->
  API.ConfigSchemaResponse ->
  API.Config ->
  m ()
validateConfiguration :: SourceName
-> DataConnectorName -> ConfigSchemaResponse -> Config -> m ()
validateConfiguration SourceName
sourceName DataConnectorName
dataConnectorName ConfigSchemaResponse
configSchema Config
config = do
  let errors :: [[Char]]
errors = ConfigSchemaResponse -> Config -> [[Char]]
API.validateConfigAgainstConfigSchema ConfigSchemaResponse
configSchema Config
config
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
errors) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    let errorsText :: Text
errorsText = [Text] -> Text
Text.unlines ((Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> Text) -> [[Char]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
errors)
     in Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
          Code
DataConnectorError
          (Text
"Configuration for source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not valid based on the configuration schema declared by the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataConnectorName
dataConnectorName DataConnectorName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" data connector agent. Errors:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errorsText)

resolveDatabaseMetadata' ::
  Applicative m =>
  SourceMetadata 'DataConnector ->
  DC.SourceConfig ->
  SourceTypeCustomization ->
  m (Either QErr (ResolvedSource 'DataConnector))
resolveDatabaseMetadata' :: SourceMetadata 'DataConnector
-> SourceConfig
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource 'DataConnector))
resolveDatabaseMetadata' SourceMetadata 'DataConnector
_ sc :: SourceConfig
sc@(DC.SourceConfig {_scSchema :: SourceConfig -> SchemaResponse
_scSchema = API.SchemaResponse {[TableInfo]
srTables :: SchemaResponse -> [TableInfo]
srTables :: [TableInfo]
..}}) SourceTypeCustomization
customization =
  -- We need agents to provide the foreign key contraints inside 'API.SchemaResponse'
  let foreignKeys :: [Maybe ForeignKeys]
foreignKeys = (TableInfo -> Maybe ForeignKeys)
-> [TableInfo] -> [Maybe ForeignKeys]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableInfo -> Maybe ForeignKeys
API.dtiForeignKeys [TableInfo]
srTables
      tables :: HashMap Name (DBTableMetadata 'DataConnector)
tables = [(Name, DBTableMetadata 'DataConnector)]
-> HashMap Name (DBTableMetadata 'DataConnector)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, DBTableMetadata 'DataConnector)]
 -> HashMap Name (DBTableMetadata 'DataConnector))
-> [(Name, DBTableMetadata 'DataConnector)]
-> HashMap Name (DBTableMetadata 'DataConnector)
forall a b. (a -> b) -> a -> b
$ do
        API.TableInfo {[ColumnInfo]
Maybe [ColumnName]
Maybe ForeignKeys
Maybe Text
TableName
dtiName :: TableInfo -> TableName
dtiColumns :: TableInfo -> [ColumnInfo]
dtiPrimaryKey :: TableInfo -> Maybe [ColumnName]
dtiDescription :: TableInfo -> Maybe Text
dtiForeignKeys :: Maybe ForeignKeys
dtiDescription :: Maybe Text
dtiPrimaryKey :: Maybe [ColumnName]
dtiColumns :: [ColumnInfo]
dtiName :: TableName
dtiForeignKeys :: TableInfo -> Maybe ForeignKeys
..} <- [TableInfo]
srTables
        let primaryKeyColumns :: Seq Name
primaryKeyColumns = [Name] -> Seq Name
forall a. [a] -> Seq a
Seq.fromList ([Name] -> Seq Name) -> [Name] -> Seq Name
forall a b. (a -> b) -> a -> b
$ ColumnName -> Name
coerce (ColumnName -> Name) -> [ColumnName] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnName] -> Maybe [ColumnName] -> [ColumnName]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ColumnName]
dtiPrimaryKey
        let meta :: DBTableMetadata 'DataConnector
meta =
              DBTableMetadata :: forall (b :: BackendType).
OID
-> [RawColumnInfo b]
-> Maybe (PrimaryKey b (Column b))
-> HashSet (UniqueConstraint b)
-> HashSet (ForeignKeyMetadata b)
-> Maybe ViewInfo
-> Maybe PGDescription
-> ExtraTableMetadata b
-> DBTableMetadata b
RQL.T.T.DBTableMetadata
                { _ptmiOid :: OID
_ptmiOid = Int -> OID
OID Int
0,
                  _ptmiColumns :: [RawColumnInfo 'DataConnector]
_ptmiColumns = do
                    API.ColumnInfo {Bool
Maybe Text
ColumnName
Type
dciName :: ColumnInfo -> ColumnName
dciType :: ColumnInfo -> Type
dciNullable :: ColumnInfo -> Bool
dciDescription :: ColumnInfo -> Maybe Text
dciDescription :: Maybe Text
dciNullable :: Bool
dciType :: Type
dciName :: ColumnName
..} <- [ColumnInfo]
dtiColumns
                    RawColumnInfo 'DataConnector -> [RawColumnInfo 'DataConnector]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawColumnInfo 'DataConnector -> [RawColumnInfo 'DataConnector])
-> RawColumnInfo 'DataConnector -> [RawColumnInfo 'DataConnector]
forall a b. (a -> b) -> a -> b
$
                      RawColumnInfo :: forall (b :: BackendType).
Column b
-> Int
-> ScalarType b
-> Bool
-> Maybe Description
-> ColumnMutability
-> RawColumnInfo b
RQL.T.C.RawColumnInfo
                        { rciName :: Column 'DataConnector
rciName = ColumnName -> Name
forall source target. From source target => source -> target
Witch.from ColumnName
dciName,
                          rciPosition :: Int
rciPosition = Int
1,
                          rciType :: ScalarType 'DataConnector
rciType = Type -> Type
forall source target. From source target => source -> target
Witch.from Type
dciType,
                          rciIsNullable :: Bool
rciIsNullable = Bool
dciNullable,
                          rciDescription :: Maybe Description
rciDescription = (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Description
GQL.Description Maybe Text
dciDescription,
                          -- TODO: Add Column Mutability to the 'TableInfo'
                          rciMutability :: ColumnMutability
rciMutability = Bool -> Bool -> ColumnMutability
RQL.T.C.ColumnMutability Bool
False Bool
False
                        },
                  _ptmiPrimaryKey :: Maybe (PrimaryKey 'DataConnector (Column 'DataConnector))
_ptmiPrimaryKey = Constraint 'DataConnector
-> NESeq Name -> PrimaryKey 'DataConnector Name
forall (b :: BackendType) a.
Constraint b -> NESeq a -> PrimaryKey b a
RQL.T.T.PrimaryKey (ConstraintName 'DataConnector -> OID -> Constraint 'DataConnector
forall (b :: BackendType). ConstraintName b -> OID -> Constraint b
RQL.T.T.Constraint (Text -> ConstraintName
IR.T.ConstraintName Text
"") (Int -> OID
OID Int
0)) (NESeq Name -> PrimaryKey 'DataConnector Name)
-> Maybe (NESeq Name) -> Maybe (PrimaryKey 'DataConnector Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Name -> Maybe (NESeq Name)
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq Seq Name
primaryKeyColumns,
                  _ptmiUniqueConstraints :: HashSet (UniqueConstraint 'DataConnector)
_ptmiUniqueConstraints = HashSet (UniqueConstraint 'DataConnector)
forall a. Monoid a => a
mempty,
                  _ptmiForeignKeys :: HashSet (ForeignKeyMetadata 'DataConnector)
_ptmiForeignKeys = [Maybe ForeignKeys] -> HashSet (ForeignKeyMetadata 'DataConnector)
buildForeignKeySet [Maybe ForeignKeys]
foreignKeys,
                  _ptmiViewInfo :: Maybe ViewInfo
_ptmiViewInfo = ViewInfo -> Maybe ViewInfo
forall a. a -> Maybe a
Just (ViewInfo -> Maybe ViewInfo) -> ViewInfo -> Maybe ViewInfo
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> ViewInfo
RQL.T.T.ViewInfo Bool
False Bool
False Bool
False,
                  _ptmiDescription :: Maybe PGDescription
_ptmiDescription = (Text -> PGDescription) -> Maybe Text -> Maybe PGDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> PGDescription
PGDescription Maybe Text
dtiDescription,
                  _ptmiExtraTableMetadata :: ExtraTableMetadata 'DataConnector
_ptmiExtraTableMetadata = ()
                }
        (Name, DBTableMetadata 'DataConnector)
-> [(Name, DBTableMetadata 'DataConnector)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableName -> Name
coerce TableName
dtiName, DBTableMetadata 'DataConnector
meta)
   in Either QErr (ResolvedSource 'DataConnector)
-> m (Either QErr (ResolvedSource 'DataConnector))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr (ResolvedSource 'DataConnector)
 -> m (Either QErr (ResolvedSource 'DataConnector)))
-> Either QErr (ResolvedSource 'DataConnector)
-> m (Either QErr (ResolvedSource 'DataConnector))
forall a b. (a -> b) -> a -> b
$
        ResolvedSource 'DataConnector
-> Either QErr (ResolvedSource 'DataConnector)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolvedSource 'DataConnector
 -> Either QErr (ResolvedSource 'DataConnector))
-> ResolvedSource 'DataConnector
-> Either QErr (ResolvedSource 'DataConnector)
forall a b. (a -> b) -> a -> b
$
          ResolvedSource :: forall (b :: BackendType).
SourceConfig b
-> SourceTypeCustomization
-> DBTablesMetadata b
-> DBFunctionsMetadata b
-> ScalarMap b
-> ResolvedSource b
ResolvedSource
            { _rsConfig :: SourceConfig 'DataConnector
_rsConfig = SourceConfig
SourceConfig 'DataConnector
sc,
              _rsCustomization :: SourceTypeCustomization
_rsCustomization = SourceTypeCustomization
customization,
              _rsTables :: DBTablesMetadata 'DataConnector
_rsTables = HashMap Name (DBTableMetadata 'DataConnector)
DBTablesMetadata 'DataConnector
tables,
              _rsFunctions :: DBFunctionsMetadata 'DataConnector
_rsFunctions = DBFunctionsMetadata 'DataConnector
forall a. Monoid a => a
mempty,
              _rsScalars :: ScalarMap 'DataConnector
_rsScalars = ScalarMap 'DataConnector
forall a. Monoid a => a
mempty
            }

-- | Construct a 'HashSet' 'RQL.T.T.ForeignKeyMetadata'
-- 'DataConnector' to build the foreign key constraints in the table
-- metadata.
buildForeignKeySet :: [Maybe API.ForeignKeys] -> HashSet (RQL.T.T.ForeignKeyMetadata 'DataConnector)
buildForeignKeySet :: [Maybe ForeignKeys] -> HashSet (ForeignKeyMetadata 'DataConnector)
buildForeignKeySet ([Maybe ForeignKeys] -> [ForeignKeys]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes -> [ForeignKeys]
foreignKeys) =
  [ForeignKeyMetadata 'DataConnector]
-> HashSet (ForeignKeyMetadata 'DataConnector)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([ForeignKeyMetadata 'DataConnector]
 -> HashSet (ForeignKeyMetadata 'DataConnector))
-> [ForeignKeyMetadata 'DataConnector]
-> HashSet (ForeignKeyMetadata 'DataConnector)
forall a b. (a -> b) -> a -> b
$
    [[ForeignKeyMetadata 'DataConnector]]
-> [ForeignKeyMetadata 'DataConnector]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[ForeignKeyMetadata 'DataConnector]]
 -> [ForeignKeyMetadata 'DataConnector])
-> [[ForeignKeyMetadata 'DataConnector]]
-> [ForeignKeyMetadata 'DataConnector]
forall a b. (a -> b) -> a -> b
$
      [ForeignKeys]
foreignKeys [ForeignKeys]
-> (ForeignKeys -> [ForeignKeyMetadata 'DataConnector])
-> [[ForeignKeyMetadata 'DataConnector]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(API.ForeignKeys HashMap ConstraintName Constraint
constraints) ->
        HashMap ConstraintName Constraint
constraints HashMap ConstraintName Constraint
-> (HashMap ConstraintName Constraint
    -> [ForeignKeyMetadata 'DataConnector])
-> [ForeignKeyMetadata 'DataConnector]
forall a b. a -> (a -> b) -> b
& (ConstraintName
 -> Constraint -> [ForeignKeyMetadata 'DataConnector])
-> HashMap ConstraintName Constraint
-> [ForeignKeyMetadata 'DataConnector]
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
HashMap.foldMapWithKey @[RQL.T.T.ForeignKeyMetadata 'DataConnector]
          \ConstraintName
constraintName API.Constraint {Text
HashMap Text Text
cForeignTable :: Constraint -> Text
cColumnMapping :: Constraint -> HashMap Text Text
cColumnMapping :: HashMap Text Text
cForeignTable :: Text
..} -> Maybe (ForeignKeyMetadata 'DataConnector)
-> [ForeignKeyMetadata 'DataConnector]
forall a. Maybe a -> [a]
maybeToList do
            let columnMapAssocList :: [(Name, Name)]
columnMapAssocList = (Text -> Text -> [(Name, Name)] -> [(Name, Name)])
-> [(Name, Name)] -> HashMap Text Text -> [(Name, Name)]
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey' (\Text
k Text
v [(Name, Name)]
acc -> (Text -> Name
forall source target. From source target => source -> target
Witch.from Text
k, Text -> Name
forall source target. From source target => source -> target
Witch.from Text
v) (Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
: [(Name, Name)]
acc) [] HashMap Text Text
cColumnMapping
            NEHashMap Name Name
columnMapping <- [(Name, Name)] -> Maybe (NEHashMap Name Name)
forall k v. (Eq k, Hashable k) => [(k, v)] -> Maybe (NEHashMap k v)
NEHashMap.fromList [(Name, Name)]
columnMapAssocList
            let foreignKey :: ForeignKey 'DataConnector
foreignKey =
                  ForeignKey :: forall (b :: BackendType).
Constraint b
-> TableName b -> NEHashMap (Column b) (Column b) -> ForeignKey b
RQL.T.T.ForeignKey
                    { _fkConstraint :: Constraint 'DataConnector
_fkConstraint = ConstraintName 'DataConnector -> OID -> Constraint 'DataConnector
forall (b :: BackendType). ConstraintName b -> OID -> Constraint b
RQL.T.T.Constraint (ConstraintName -> ConstraintName
forall source target. From source target => source -> target
Witch.from ConstraintName
constraintName) (Int -> OID
OID Int
1),
                      _fkForeignTable :: TableName 'DataConnector
_fkForeignTable = Text -> Name
forall source target. From source target => source -> target
Witch.from Text
cForeignTable,
                      _fkColumnMapping :: NEHashMap (Column 'DataConnector) (Column 'DataConnector)
_fkColumnMapping = NEHashMap Name Name
NEHashMap (Column 'DataConnector) (Column 'DataConnector)
columnMapping
                    }
            ForeignKeyMetadata 'DataConnector
-> Maybe (ForeignKeyMetadata 'DataConnector)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignKeyMetadata 'DataConnector
 -> Maybe (ForeignKeyMetadata 'DataConnector))
-> ForeignKeyMetadata 'DataConnector
-> Maybe (ForeignKeyMetadata 'DataConnector)
forall a b. (a -> b) -> a -> b
$ ForeignKey 'DataConnector -> ForeignKeyMetadata 'DataConnector
forall (b :: BackendType). ForeignKey b -> ForeignKeyMetadata b
RQL.T.T.ForeignKeyMetadata ForeignKey 'DataConnector
foreignKey

-- | This is needed to get permissions to work
parseBoolExpOperations' ::
  forall m v.
  (MonadError QErr m, SchemaCache.TableCoreInfoRM 'DataConnector m) =>
  RQL.T.C.ValueParser 'DataConnector m v ->
  IR.T.Name ->
  RQL.T.T.FieldInfoMap (RQL.T.T.FieldInfo 'DataConnector) ->
  RQL.T.C.ColumnReference 'DataConnector ->
  J.Value ->
  m [OpExpG 'DataConnector v]
parseBoolExpOperations' :: ValueParser 'DataConnector m v
-> Name
-> FieldInfoMap (FieldInfo 'DataConnector)
-> ColumnReference 'DataConnector
-> Value
-> m [OpExpG 'DataConnector v]
parseBoolExpOperations' ValueParser 'DataConnector m v
rhsParser Name
rootTable FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap ColumnReference 'DataConnector
columnRef Value
value =
  Text -> m [OpExpG 'DataConnector v] -> m [OpExpG 'DataConnector v]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (ColumnReference 'DataConnector -> Text
forall a. ToTxt a => a -> Text
toTxt ColumnReference 'DataConnector
columnRef) (m [OpExpG 'DataConnector v] -> m [OpExpG 'DataConnector v])
-> m [OpExpG 'DataConnector v] -> m [OpExpG 'DataConnector v]
forall a b. (a -> b) -> a -> b
$ Value -> m [OpExpG 'DataConnector v]
parseOperations Value
value
  where
    columnType :: RQL.T.C.ColumnType 'DataConnector
    columnType :: ColumnType 'DataConnector
columnType = ColumnReference 'DataConnector -> ColumnType 'DataConnector
forall (backend :: BackendType).
ColumnReference backend -> ColumnType backend
RQL.T.C.columnReferenceType ColumnReference 'DataConnector
columnRef

    parseWithTy :: ColumnType 'DataConnector -> Value -> m v
parseWithTy ColumnType 'DataConnector
ty = ValueParser 'DataConnector m v
rhsParser (ColumnType 'DataConnector
-> CollectableType (ColumnType 'DataConnector)
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType 'DataConnector
ty)

    parseOperations :: J.Value -> m [OpExpG 'DataConnector v]
    parseOperations :: Value -> m [OpExpG 'DataConnector v]
parseOperations = \case
      J.Object Object
o -> (Pair -> m (OpExpG 'DataConnector v))
-> [Pair] -> m [OpExpG 'DataConnector v]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text, Value) -> m (OpExpG 'DataConnector v)
parseOperation ((Text, Value) -> m (OpExpG 'DataConnector v))
-> (Pair -> (Text, Value)) -> Pair -> m (OpExpG 'DataConnector v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Text) -> Pair -> (Text, Value)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Key -> Text
K.toText) ([Pair] -> m [OpExpG 'DataConnector v])
-> [Pair] -> m [OpExpG 'DataConnector v]
forall a b. (a -> b) -> a -> b
$ Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
o
      Value
v -> OpExpG 'DataConnector v -> [OpExpG 'DataConnector v]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpExpG 'DataConnector v -> [OpExpG 'DataConnector v])
-> (v -> OpExpG 'DataConnector v) -> v -> [OpExpG 'DataConnector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
Bool -> field -> OpExpG backend field
AEQ Bool
False (v -> [OpExpG 'DataConnector v])
-> m v -> m [OpExpG 'DataConnector v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'DataConnector -> Value -> m v
parseWithTy ColumnType 'DataConnector
columnType Value
v

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

        Text
x -> Code -> Text -> m (OpExpG 'DataConnector v)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (OpExpG 'DataConnector v))
-> Text -> m (OpExpG 'DataConnector v)
forall a b. (a -> b) -> a -> b
$ Text
"Unknown operator : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
      where
        parseOne :: m v
parseOne = ColumnType 'DataConnector -> Value -> m v
parseWithTy ColumnType 'DataConnector
columnType Value
val
        parseManyWithType :: ColumnType 'DataConnector -> m v
parseManyWithType ColumnType 'DataConnector
ty = ValueParser 'DataConnector m v
rhsParser (ColumnType 'DataConnector
-> CollectableType (ColumnType 'DataConnector)
forall a. a -> CollectableType a
CollectableTypeArray ColumnType 'DataConnector
ty) Value
val

        parseEq :: m (OpExpG 'DataConnector v)
parseEq = Bool -> v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
Bool -> field -> OpExpG backend field
AEQ Bool
False (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseNeq :: m (OpExpG 'DataConnector v)
parseNeq = Bool -> v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
Bool -> field -> OpExpG backend field
ANE Bool
False (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseIn :: m (OpExpG 'DataConnector v)
parseIn = v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
field -> OpExpG backend field
AIN (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'DataConnector -> m v
parseManyWithType ColumnType 'DataConnector
columnType
        parseNin :: m (OpExpG 'DataConnector v)
parseNin = v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANIN (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'DataConnector -> m v
parseManyWithType ColumnType 'DataConnector
columnType
        parseGt :: m (OpExpG 'DataConnector v)
parseGt = v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
field -> OpExpG backend field
AGT (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseLt :: m (OpExpG 'DataConnector v)
parseLt = v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALT (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseGte :: m (OpExpG 'DataConnector v)
parseGte = v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
field -> OpExpG backend field
AGTE (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseLte :: m (OpExpG 'DataConnector v)
parseLte = v -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALTE (v -> OpExpG 'DataConnector v)
-> m v -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseIsNull :: m (OpExpG 'DataConnector v)
parseIsNull = OpExpG 'DataConnector v
-> OpExpG 'DataConnector v -> Bool -> OpExpG 'DataConnector v
forall a. a -> a -> Bool -> a
bool OpExpG 'DataConnector v
forall (backend :: BackendType) field. OpExpG backend field
ANISNOTNULL OpExpG 'DataConnector v
forall (backend :: BackendType) field. OpExpG backend field
ANISNULL (Bool -> OpExpG 'DataConnector v)
-> m Bool -> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m Bool
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
val
        parseCeq :: m (OpExpG 'DataConnector v)
parseCeq = RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
RootOrCurrentColumn backend -> OpExpG backend field
CEQ (RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v)
-> m (RootOrCurrentColumn 'DataConnector)
-> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
val
        parseCne :: m (OpExpG 'DataConnector v)
parseCne = RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
RootOrCurrentColumn backend -> OpExpG backend field
CNE (RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v)
-> m (RootOrCurrentColumn 'DataConnector)
-> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
val
        parseCgt :: m (OpExpG 'DataConnector v)
parseCgt = RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
RootOrCurrentColumn backend -> OpExpG backend field
CGT (RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v)
-> m (RootOrCurrentColumn 'DataConnector)
-> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
val
        parseClt :: m (OpExpG 'DataConnector v)
parseClt = RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
RootOrCurrentColumn backend -> OpExpG backend field
CLT (RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v)
-> m (RootOrCurrentColumn 'DataConnector)
-> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
val
        parseCgte :: m (OpExpG 'DataConnector v)
parseCgte = RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
RootOrCurrentColumn backend -> OpExpG backend field
CGTE (RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v)
-> m (RootOrCurrentColumn 'DataConnector)
-> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
val
        parseClte :: m (OpExpG 'DataConnector v)
parseClte = RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v
forall (backend :: BackendType) field.
RootOrCurrentColumn backend -> OpExpG backend field
CLTE (RootOrCurrentColumn 'DataConnector -> OpExpG 'DataConnector v)
-> m (RootOrCurrentColumn 'DataConnector)
-> m (OpExpG 'DataConnector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
val

        decodeAndValidateRhsCol :: J.Value -> m (RootOrCurrentColumn 'DataConnector)
        decodeAndValidateRhsCol :: Value -> m (RootOrCurrentColumn 'DataConnector)
decodeAndValidateRhsCol Value
v = case Value
v of
          J.String Text
_ -> RootOrCurrent
-> FieldInfoMap (FieldInfo 'DataConnector)
-> Value
-> m (RootOrCurrentColumn 'DataConnector)
go RootOrCurrent
IsCurrent FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap Value
v
          J.Array Array
path -> case Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
path of
            [] -> Code -> Text -> m (RootOrCurrentColumn 'DataConnector)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
Unexpected Text
"path cannot be empty"
            [Value
col] -> RootOrCurrent
-> FieldInfoMap (FieldInfo 'DataConnector)
-> Value
-> m (RootOrCurrentColumn 'DataConnector)
go RootOrCurrent
IsCurrent FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap Value
col
            [J.String Text
"$", Value
col] -> do
              TableCoreInfo 'DataConnector
rootTableInfo <-
                TableName 'DataConnector
-> m (Maybe (TableCoreInfo 'DataConnector))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
SchemaCache.lookupTableCoreInfo Name
TableName 'DataConnector
rootTable
                  m (Maybe (TableCoreInfo 'DataConnector))
-> (Maybe (TableCoreInfo 'DataConnector)
    -> m (TableCoreInfo 'DataConnector))
-> m (TableCoreInfo 'DataConnector)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (TableCoreInfo 'DataConnector)
 -> m (TableCoreInfo 'DataConnector)
 -> m (TableCoreInfo 'DataConnector))
-> m (TableCoreInfo 'DataConnector)
-> Maybe (TableCoreInfo 'DataConnector)
-> m (TableCoreInfo 'DataConnector)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (TableCoreInfo 'DataConnector)
-> m (TableCoreInfo 'DataConnector)
-> m (TableCoreInfo 'DataConnector)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> m (TableCoreInfo 'DataConnector)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (TableCoreInfo 'DataConnector))
-> Text -> m (TableCoreInfo 'DataConnector)
forall a b. (a -> b) -> a -> b
$ Text
"unexpected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
rootTable Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" doesn't exist")
              RootOrCurrent
-> FieldInfoMap (FieldInfo 'DataConnector)
-> Value
-> m (RootOrCurrentColumn 'DataConnector)
go RootOrCurrent
IsRoot (TableCoreInfo 'DataConnector
-> FieldInfoMap (FieldInfo 'DataConnector)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
RQL.T.T._tciFieldInfoMap TableCoreInfo 'DataConnector
rootTableInfo) Value
col
            [Value]
_ -> Code -> Text -> m (RootOrCurrentColumn 'DataConnector)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Relationship references are not supported in column comparison RHS"
          Value
_ -> Code -> Text -> m (RootOrCurrentColumn 'DataConnector)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
Unexpected Text
"a boolean expression JSON must be either a string or an array"
          where
            go :: RootOrCurrent
-> FieldInfoMap (FieldInfo 'DataConnector)
-> Value
-> m (RootOrCurrentColumn 'DataConnector)
go RootOrCurrent
rootInfo FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap' Value
columnValue = do
              Name
colName <- Value -> m Name
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
columnValue
              Name
colInfo <- FieldInfoMap (FieldInfo 'DataConnector) -> Name -> m Name
validateRhsColumn FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap' Name
colName
              RootOrCurrentColumn 'DataConnector
-> m (RootOrCurrentColumn 'DataConnector)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RootOrCurrentColumn 'DataConnector
 -> m (RootOrCurrentColumn 'DataConnector))
-> RootOrCurrentColumn 'DataConnector
-> m (RootOrCurrentColumn 'DataConnector)
forall a b. (a -> b) -> a -> b
$ RootOrCurrent
-> Column 'DataConnector -> RootOrCurrentColumn 'DataConnector
forall (b :: BackendType).
RootOrCurrent -> Column b -> RootOrCurrentColumn b
RootOrCurrentColumn RootOrCurrent
rootInfo Name
Column 'DataConnector
colInfo

        validateRhsColumn :: RQL.T.T.FieldInfoMap (RQL.T.T.FieldInfo 'DataConnector) -> IR.C.Name -> m IR.C.Name
        validateRhsColumn :: FieldInfoMap (FieldInfo 'DataConnector) -> Name -> m Name
validateRhsColumn FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap' Name
rhsCol = do
          ColumnType 'DataConnector
rhsType <- FieldInfoMap (FieldInfo 'DataConnector)
-> Column 'DataConnector -> Text -> m (ColumnType 'DataConnector)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
RQL.T.T.askColumnType FieldInfoMap (FieldInfo 'DataConnector)
fieldInfoMap' Name
Column 'DataConnector
rhsCol Text
"column operators can only compare table columns"
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ColumnType 'DataConnector
columnType ColumnType 'DataConnector -> ColumnType 'DataConnector -> Bool
forall a. Eq a => a -> a -> Bool
/= ColumnType 'DataConnector
rhsType) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
              Text
"incompatible column types: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnReference 'DataConnector
columnRef ColumnReference 'DataConnector -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has type "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnType 'DataConnector
columnType ColumnType 'DataConnector -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
", but "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
rhsCol Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has type " Text -> ColumnType 'DataConnector -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ColumnType 'DataConnector
rhsType
          Name -> m Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
rhsCol

parseCollectableType' ::
  MonadError QErr m =>
  CollectableType (RQL.T.C.ColumnType 'DataConnector) ->
  J.Value ->
  m (PartialSQLExp 'DataConnector)
parseCollectableType' :: CollectableType (ColumnType 'DataConnector)
-> Value -> m (PartialSQLExp 'DataConnector)
parseCollectableType' CollectableType (ColumnType 'DataConnector)
collectableType = \case
  J.String Text
t
    | Text -> Bool
HSU.isSessionVariable Text
t -> PartialSQLExp 'DataConnector -> m (PartialSQLExp 'DataConnector)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialSQLExp 'DataConnector -> m (PartialSQLExp 'DataConnector))
-> PartialSQLExp 'DataConnector -> m (PartialSQLExp 'DataConnector)
forall a b. (a -> b) -> a -> b
$ CollectableType (ColumnType 'DataConnector)
-> SessionVariable -> PartialSQLExp 'DataConnector
mkTypedSessionVar CollectableType (ColumnType 'DataConnector)
collectableType (SessionVariable -> PartialSQLExp 'DataConnector)
-> SessionVariable -> PartialSQLExp 'DataConnector
forall a b. (a -> b) -> a -> b
$ Text -> SessionVariable
mkSessionVariable Text
t
    | Text -> Bool
HSU.isReqUserId Text
t -> PartialSQLExp 'DataConnector -> m (PartialSQLExp 'DataConnector)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialSQLExp 'DataConnector -> m (PartialSQLExp 'DataConnector))
-> PartialSQLExp 'DataConnector -> m (PartialSQLExp 'DataConnector)
forall a b. (a -> b) -> a -> b
$ CollectableType (ColumnType 'DataConnector)
-> SessionVariable -> PartialSQLExp 'DataConnector
mkTypedSessionVar CollectableType (ColumnType 'DataConnector)
collectableType SessionVariable
forall a. IsString a => a
HSU.userIdHeader
  Value
val -> case CollectableType (ColumnType 'DataConnector)
collectableType of
    CollectableTypeScalar ColumnType 'DataConnector
scalarType ->
      Literal -> PartialSQLExp 'DataConnector
forall (backend :: BackendType).
SQLExpression backend -> PartialSQLExp backend
PSESQLExp (Literal -> PartialSQLExp 'DataConnector)
-> (Value -> Literal) -> Value -> PartialSQLExp 'DataConnector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Literal
IR.S.V.ValueLiteral (Value -> PartialSQLExp 'DataConnector)
-> m Value -> m (PartialSQLExp 'DataConnector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'DataConnector
-> Value -> m (ScalarValue 'DataConnector)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ColumnType b -> Value -> m (ScalarValue b)
RQL.T.C.parseScalarValueColumnType ColumnType 'DataConnector
scalarType Value
val
    CollectableTypeArray ColumnType 'DataConnector
_ ->
      Code -> Text -> m (PartialSQLExp 'DataConnector)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array types are not supported by the Data Connector backend"

mkTypedSessionVar ::
  CollectableType (RQL.T.C.ColumnType 'DataConnector) ->
  SessionVariable ->
  PartialSQLExp 'DataConnector
mkTypedSessionVar :: CollectableType (ColumnType 'DataConnector)
-> SessionVariable -> PartialSQLExp 'DataConnector
mkTypedSessionVar CollectableType (ColumnType 'DataConnector)
columnType =
  SessionVarType 'DataConnector
-> SessionVariable -> PartialSQLExp 'DataConnector
forall (backend :: BackendType).
SessionVarType backend -> SessionVariable -> PartialSQLExp backend
PSESessVar (ColumnType 'DataConnector -> Type
columnTypeToScalarType (ColumnType 'DataConnector -> Type)
-> CollectableType (ColumnType 'DataConnector)
-> CollectableType Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CollectableType (ColumnType 'DataConnector)
columnType)

columnTypeToScalarType :: RQL.T.C.ColumnType 'DataConnector -> IR.S.T.Type
columnTypeToScalarType :: ColumnType 'DataConnector -> Type
columnTypeToScalarType = \case
  RQL.T.C.ColumnScalar ScalarType 'DataConnector
scalarType -> Type
ScalarType 'DataConnector
scalarType
  -- NOTE: This should be unreachable:
  RQL.T.C.ColumnEnumReference EnumReference 'DataConnector
_ -> Type
IR.S.T.String