{-# 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 (capabilitiesCase, errorResponseSummary, schemaCase) import Hasura.Backends.DataConnector.API qualified as API import Hasura.Backends.DataConnector.API.V0 (FunctionInfo (_fiDescription, _fiName)) import Hasura.Backends.DataConnector.API.V0.ErrorResponse (_crDetails) 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.Postgres.SQL.Types (PGDescription (..)) import Hasura.Base.Error (Code (..), QErr (..), decodeValue, throw400, throw400WithDetail, 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 Servant.Client ((//)) import Servant.Client.Generic (genericClient) 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." columnInfoToFieldInfo = columnInfoToFieldInfo' 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 capabilitiesU <- ignoreTraceT . flip runAgentClientT (AgentClientContext logger _dcoUri manager Nothing Nothing) $ genericClient @API.Routes // API._capabilities let defaultAction = throw400 DataConnectorError "Unexpected data connector capabilities response - Unexpected Type" capabilitiesAction API.CapabilitiesResponse {..} = pure $ DC.DataConnectorInfo options _crCapabilities _crConfigSchemaResponse _crDisplayName _crReleaseName capabilitiesCase defaultAction capabilitiesAction errorAction capabilitiesU 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") 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 typeNames = maybe mempty (HashSet.fromList . toList . fmap API._otdName) _srObjectTypes customObjectTypes = maybe mempty (HashMap.fromList . mapMaybe (toTableObjectType _scCapabilities typeNames) . 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 = DC.mkScalarType _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 schemaResponseU <- ignoreTraceT . flip runAgentClientT (AgentClientContext logger (DC._scEndpoint transformedSourceConfig) (DC._scManager transformedSourceConfig) (DC._scTimeoutMicroseconds transformedSourceConfig) Nothing) $ (genericClient // API._schema) (toTxt sourceName) (DC._scConfig transformedSourceConfig) let defaultAction = throw400 DataConnectorError "Unexpected data connector schema response - Unexpected Type" schemaCase defaultAction pure errorAction schemaResponseU toTableObjectType :: API.Capabilities -> HashSet G.Name -> API.ObjectTypeDefinition -> Maybe (G.Name, RQL.T.T.TableObjectType 'DataConnector) toTableObjectType capabilities typeNames API.ObjectTypeDefinition {..} = (_otdName,) . RQL.T.T.TableObjectType _otdName (G.Description <$> _otdDescription) <$> traverse toTableObjectFieldDefinition _otdColumns where toTableObjectFieldDefinition API.ColumnInfo {..} = do fieldTypeName <- G.mkName $ API.getScalarType _ciType fieldName <- G.mkName $ API.unColumnName _ciName pure $ RQL.T.T.TableObjectFieldDefinition { _tofdColumn = Witch.from _ciName, _tofdName = fieldName, _tofdDescription = G.Description <$> _ciDescription, _tofdGType = GraphQLType $ G.TypeNamed (G.Nullability _ciNullable) fieldTypeName, _tofdFieldType = if HashSet.member fieldTypeName typeNames then RQL.T.T.TOFTObject fieldTypeName else RQL.T.T.TOFTScalar fieldTypeName $ DC.mkScalarType capabilities _ciType } -- | 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 _ -> throw400 NotSupported "Array types are not supported by the Data Connector backend" mkTypedSessionVar :: CollectableType (RQL.T.C.ColumnType 'DataConnector) -> SessionVariable -> PartialSQLExp 'DataConnector mkTypedSessionVar columnType = PSESessVar (columnTypeToScalarType <$> columnType) errorAction :: (MonadError QErr m) => API.ErrorResponse -> m a errorAction e = throw400WithDetail DataConnectorError (errorResponseSummary e) (_crDetails e) -- | This function assumes that if a type name is present in the custom object types for the table then it -- refers to a nested object of that type. -- Otherwise it is a normal (scalar) column. columnInfoToFieldInfo' :: HashMap G.Name (RQL.T.T.TableObjectType 'DataConnector) -> RQL.T.C.ColumnInfo 'DataConnector -> RQL.T.T.FieldInfo 'DataConnector columnInfoToFieldInfo' gqlTypes columnInfo@RQL.T.C.ColumnInfo {..} = maybe (RQL.T.T.FIColumn columnInfo) RQL.T.T.FINestedObject getNestedObjectInfo where getNestedObjectInfo = case ciType of RQL.T.C.ColumnScalar (DC.ScalarType scalarTypeName _) -> do gqlName <- GQL.mkName scalarTypeName guard $ HashMap.member gqlName gqlTypes pure $ RQL.T.C.NestedObjectInfo { RQL.T.C._noiSupportsNestedObjects = (), RQL.T.C._noiColumn = ciColumn, RQL.T.C._noiName = ciName, RQL.T.C._noiType = gqlName, RQL.T.C._noiIsNullable = ciIsNullable, RQL.T.C._noiDescription = ciDescription, RQL.T.C._noiMutability = ciMutability } RQL.T.C.ColumnEnumReference {} -> Nothing 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 >>= pure . \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