diff --git a/server/src-lib/Hasura/Backends/BigQuery/Meta.hs b/server/src-lib/Hasura/Backends/BigQuery/Meta.hs index 16d7f11e03b..e5dd49a6a3b 100644 --- a/server/src-lib/Hasura/Backends/BigQuery/Meta.hs +++ b/server/src-lib/Hasura/Backends/BigQuery/Meta.hs @@ -185,6 +185,24 @@ instance FromJSON RestType where "STRUCT" -> pure STRUCT _ -> fail ("invalid type " ++ show s) +instance ToJSON RestType where + toJSON = + String . \case + STRING -> "STRING" + BYTES -> "BYTES" + INTEGER -> "INTEGER" + FLOAT -> "FLOAT" + BOOL -> "BOOLEAN" + TIMESTAMP -> "TIMESTAMP" + DATE -> "DATE" + TIME -> "TIME" + DATETIME -> "DATETIME" + GEOGRAPHY -> "GEOGRAPHY" + DECIMAL -> "DECIMAL" + BIGDECIMAL -> "BIGDECIMAL" + JSON -> "JSON" + STRUCT -> "STRUCT" + -------------------------------------------------------------------------------- -- REST request @@ -304,6 +322,8 @@ data RestRoutineType instance FromJSON RestRoutineType +instance ToJSON RestRoutineType + -- | Input argument of a function/routine. -- Ref: https://cloud.google.com/bigquery/docs/reference/rest/v2/routines#Argument data RestArgument = RestArgument @@ -331,6 +351,13 @@ instance FromJSON RestArgument where pure $ RestArgument name type' ) +instance ToJSON RestArgument where + toJSON (RestArgument name ty) = + object + [ "name" .= name, + "dataType" .= object ["typeKind" .= ty] + ] + -- | A field or a column. -- Ref: https://cloud.google.com/bigquery/docs/reference/rest/v2/StandardSqlField data RestStandardSqlField = RestStandardSqlField @@ -358,6 +385,10 @@ instance FromJSON RestStandardSqlField where pure $ RestStandardSqlField name type' ) +instance ToJSON RestStandardSqlField where + toJSON (RestStandardSqlField name ty) = + object ["name" .= name, "type" .= (object ["typeKind" .= ty])] + -- | A table type, which has only list of columns with names and types. -- Ref: https://cloud.google.com/bigquery/docs/reference/rest/v2/routines#StandardSqlTableType data RestStandardSqlTableType = RestStandardSqlTableType @@ -368,6 +399,9 @@ data RestStandardSqlTableType = RestStandardSqlTableType instance FromJSON RestStandardSqlTableType where parseJSON = genericParseJSON hasuraJSON +instance ToJSON RestStandardSqlTableType where + toJSON = genericToJSON hasuraJSON + -- | Id path of a routine. -- Ref: https://cloud.google.com/bigquery/docs/reference/rest/v2/routines#RoutineReference data RestRoutineReference = RestRoutineReference @@ -379,6 +413,8 @@ data RestRoutineReference = RestRoutineReference instance FromJSON RestRoutineReference +instance ToJSON RestRoutineReference + routineReferenceToFunctionName :: RestRoutineReference -> FunctionName routineReferenceToFunctionName RestRoutineReference {..} = FunctionName {functionName = routineId, functionNameSchema = Just datasetId} @@ -399,6 +435,8 @@ data RestRoutine = RestRoutine instance FromJSON RestRoutine +instance ToJSON RestRoutine + -- | List of routines -- Ref: https://cloud.google.com/bigquery/docs/reference/rest/v2/routines/list data RestRoutineList = RestRoutineList diff --git a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs index 727f9ed66dd..28c8ae6573a 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs @@ -217,7 +217,7 @@ resolveBackendInfo' :: ( ArrowChoice arr, Inc.ArrowCache m arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadBaseControl IO m, ProvidesNetwork m diff --git a/server/src-lib/Hasura/Function/Cache.hs b/server/src-lib/Hasura/Function/Cache.hs index db007b58c3a..86a28fbc134 100644 --- a/server/src-lib/Hasura/Function/Cache.hs +++ b/server/src-lib/Hasura/Function/Cache.hs @@ -344,6 +344,8 @@ deriving newtype instance (Backend b) => Show (FunctionOverloads b) deriving newtype instance (FromJSON (RawFunctionInfo b)) => FromJSON (FunctionOverloads b) +deriving newtype instance (ToJSON (RawFunctionInfo b)) => ToJSON (FunctionOverloads b) + data FunctionArgsExpG a = FunctionArgsExp { _faePositional :: [a], _faeNamed :: (HashMap.HashMap Text a) diff --git a/server/src-lib/Hasura/Metadata/Class.hs b/server/src-lib/Hasura/Metadata/Class.hs index 7c713b1d30c..967299057dc 100644 --- a/server/src-lib/Hasura/Metadata/Class.hs +++ b/server/src-lib/Hasura/Metadata/Class.hs @@ -21,7 +21,6 @@ import Data.Aeson import Hasura.Base.Error import Hasura.Eventing.ScheduledTrigger.Types import Hasura.Prelude -import Hasura.RQL.DDL.Schema.Cache.Common (StoredIntrospection) import Hasura.RQL.Types.Action import Hasura.RQL.Types.EECredentials import Hasura.RQL.Types.EventTrigger diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 2c63f673cad..6873f72e0ca 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -173,7 +173,7 @@ buildRebuildableSchemaCacheWithReason reason logger env metadataWithVersion dyna flip runReaderT reason $ Inc.build (buildSchemaCacheRule logger env mSchemaRegistryContext) (metadataWithVersion, dynamicConfig, initialInvalidationKeys, Nothing) - pure $ RebuildableSchemaCache (Inc.result result) initialInvalidationKeys (Inc.rebuildRule result) + pure $ RebuildableSchemaCache (fst $ Inc.result result) initialInvalidationKeys (Inc.rebuildRule result) newtype CacheRWT m a = -- The CacheInvalidations component of the state could actually be collected @@ -253,7 +253,7 @@ instance runCacheBuildM $ flip runReaderT buildReason $ Inc.build rule (metadataWithVersion, dynamicConfig, newInvalidationKeys, storedIntrospection) - let schemaCache = Inc.result result + let (schemaCache, _storedIntrospectionStatus) = Inc.result result prunedInvalidationKeys = pruneInvalidationKeys schemaCache newInvalidationKeys !newCache = RebuildableSchemaCache schemaCache prunedInvalidationKeys (Inc.rebuildRule result) !newInvalidations = oldInvalidations <> invalidations @@ -315,6 +315,45 @@ buildSourcePingCache sources = connection = _smConfiguration sourceMetadata in SourcePingInfo sourceName connection +partitionCollectedInfo :: + Seq CollectItem -> ([InconsistentMetadata], [MetadataDependency], [StoredIntrospectionItem]) +partitionCollectedInfo = + let go item = case item of + CollectInconsistentMetadata inconsistentMetadata -> + _1 %~ ([inconsistentMetadata] <>) + CollectMetadataDependency dependency -> + _2 %~ ([dependency] <>) + CollectStoredIntrospection storedIntrospection -> + _3 %~ ([storedIntrospection] <>) + in foldr go ([], [], []) . toList + +buildStoredIntrospectionStatus :: + Sources -> RemoteSchemas -> [StoredIntrospectionItem] -> StoredIntrospectionStatus +buildStoredIntrospectionStatus sourcesMetadata remoteSchemasMetadata = \case + [] -> StoredIntrospectionUnchanged + items -> + let go item (sources, remoteSchemas) = case item of + SourceIntrospectionItem name introspection -> + (sources <> [(name, introspection)], remoteSchemas) + RemoteSchemaIntrospectionItem name introspection -> + (sources, remoteSchemas <> [(name, introspection)]) + (allSources, allRemoteSchemas) = foldr go ([], []) items + storedIntrospection = StoredIntrospection (HashMap.fromList allSources) (HashMap.fromList allRemoteSchemas) + in if allSourcesAndRemoteSchemasCollected allSources allRemoteSchemas + then StoredIntrospectionChangedFull storedIntrospection + else StoredIntrospectionChangedPartial storedIntrospection + where + allSourcesAndRemoteSchemasCollected :: + [(SourceName, sourceIntrospection)] -> + [(RemoteSchemaName, remoteSchemaIntrospection)] -> + Bool + allSourcesAndRemoteSchemasCollected sources remoteSchemas = + allPresent sourcesMetadata (map fst sources) + && allPresent remoteSchemasMetadata (map fst remoteSchemas) + + allPresent :: (Hashable a) => InsOrdHashMap a b -> [a] -> Bool + allPresent hashMap = all (`InsOrdHashMap.member` hashMap) + {- Note [Avoiding GraphQL schema rebuilds when changing irrelevant Metadata] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are many Metadata operations that don't influence the GraphQL schema. So @@ -359,17 +398,18 @@ buildSchemaCacheRule :: Logger Hasura -> Env.Environment -> Maybe SchemaRegistryContext -> - (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) `arr` SchemaCache + (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) `arr` (SchemaCache, StoredIntrospectionStatus) buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResourceVersion metadataNoDefaults metadataResourceVersion, dynamicConfig, invalidationKeys, storedIntrospection) -> do invalidationKeysDep <- Inc.newDependency -< invalidationKeys let metadataDefaults = _cdcMetadataDefaults dynamicConfig metadata@Metadata {..} = overrideMetadataDefaults metadataNoDefaults metadataDefaults metadataDep <- Inc.newDependency -< metadata - (inconsistentObjects, (resolvedOutputs, dependencyInconsistentObjects, resolvedDependencies), ((adminIntrospection, gqlContext, gqlContextUnauth, inconsistentRemoteSchemas), (relayContext, relayContextUnauth), schemaRegistryAction)) <- + (inconsistentObjects, storedIntrospections, (resolvedOutputs, dependencyInconsistentObjects, resolvedDependencies), ((adminIntrospection, gqlContext, gqlContextUnauth, inconsistentRemoteSchemas), (relayContext, relayContextUnauth), schemaRegistryAction)) <- Inc.cache buildOutputsAndSchema -< (metadataDep, dynamicConfig, invalidationKeysDep, storedIntrospection) - let (resolvedEndpoints, endpointCollectedInfo) = runIdentity $ runWriterT $ buildRESTEndpoints _metaQueryCollections (InsOrdHashMap.elems _metaRestEndpoints) + let storedIntrospectionStatus = buildStoredIntrospectionStatus _metaSources _metaRemoteSchemas storedIntrospections + (resolvedEndpoints, endpointCollectedInfo) = runIdentity $ runWriterT $ buildRESTEndpoints _metaQueryCollections (InsOrdHashMap.elems _metaRestEndpoints) (cronTriggersMap, cronTriggersCollectedInfo) = runIdentity $ runWriterT $ buildCronTriggers (InsOrdHashMap.elems _metaCronTriggers) (openTelemetryInfo, openTelemetryCollectedInfo) = runIdentity $ runWriterT $ buildOpenTelemetry _metaOpenTelemetryConfig @@ -408,13 +448,13 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou globalAllowLists = HS.toList . iaGlobal $ inlinedAllowlist -- Endpoints don't generate any dependencies - endpointInconsistencies = either id absurd <$> toList endpointCollectedInfo + (endpointInconsistencies, _, _) = partitionCollectedInfo endpointCollectedInfo -- Cron triggers don't generate any dependencies - cronTriggersInconsistencies = either id absurd <$> toList cronTriggersCollectedInfo + (cronTriggersInconsistencies, _, _) = partitionCollectedInfo cronTriggersCollectedInfo -- OpenTelemerty doesn't generate any dependencies - openTelemetryInconsistencies = either id absurd <$> toList openTelemetryCollectedInfo + (openTelemetryInconsistencies, _, _) = partitionCollectedInfo openTelemetryCollectedInfo inconsistentQueryCollections = getInconsistentQueryCollections adminIntrospection _metaQueryCollections listedQueryObjects endpoints globalAllowLists @@ -425,53 +465,53 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou for_ schemaRegistryAction $ \action -> do liftIO $ action metadataResourceVersion - returnA - -< - SchemaCache - { scSources = _boSources resolvedOutputs, - scActions = _boActions resolvedOutputs, - -- TODO this is not the right value: we should track what part of the schema - -- we can stitch without consistencies, I think. - scRemoteSchemas = fmap fst (_boRemoteSchemas resolvedOutputs), -- remoteSchemaMap - scAllowlist = inlinedAllowlist, - -- , scCustomTypes = _boCustomTypes resolvedOutputs - scAdminIntrospection = adminIntrospection, - scGQLContext = gqlContext, - scUnauthenticatedGQLContext = gqlContextUnauth, - scRelayContext = relayContext, - scUnauthenticatedRelayContext = relayContextUnauth, - -- , scGCtxMap = gqlSchema - -- , scDefaultRemoteGCtx = remoteGQLSchema - scDepMap = resolvedDependencies, - scCronTriggers = cronTriggersMap, - scEndpoints = endpoints, - scInconsistentObjs = - inconsistentObjects - <> dependencyInconsistentObjects - <> toList inconsistentRemoteSchemas - <> duplicateRestVariables - <> invalidRestSegments - <> ambiguousRestEndpoints - <> endpointInconsistencies - <> cronTriggersInconsistencies - <> openTelemetryInconsistencies - <> inconsistentQueryCollections, - scApiLimits = _metaApiLimits, - scMetricsConfig = _metaMetricsConfig, - scMetadataResourceVersion = metadataResourceVersion, - scSetGraphqlIntrospectionOptions = _metaSetGraphqlIntrospectionOptions, - scTlsAllowlist = networkTlsAllowlist _metaNetwork, - scQueryCollections = _metaQueryCollections, - scBackendCache = _boBackendCache resolvedOutputs, - scSourceHealthChecks = buildHealthCheckCache _metaSources, - scSourcePingConfig = buildSourcePingCache _metaSources, - scOpenTelemetryConfig = openTelemetryInfo - } + let schemaCache = + SchemaCache + { scSources = _boSources resolvedOutputs, + scActions = _boActions resolvedOutputs, + -- TODO this is not the right value: we should track what part of the schema + -- we can stitch without consistencies, I think. + scRemoteSchemas = fmap fst (_boRemoteSchemas resolvedOutputs), -- remoteSchemaMap + scAllowlist = inlinedAllowlist, + -- , scCustomTypes = _boCustomTypes resolvedOutputs + scAdminIntrospection = adminIntrospection, + scGQLContext = gqlContext, + scUnauthenticatedGQLContext = gqlContextUnauth, + scRelayContext = relayContext, + scUnauthenticatedRelayContext = relayContextUnauth, + -- , scGCtxMap = gqlSchema + -- , scDefaultRemoteGCtx = remoteGQLSchema + scDepMap = resolvedDependencies, + scCronTriggers = cronTriggersMap, + scEndpoints = endpoints, + scInconsistentObjs = + inconsistentObjects + <> dependencyInconsistentObjects + <> toList inconsistentRemoteSchemas + <> duplicateRestVariables + <> invalidRestSegments + <> ambiguousRestEndpoints + <> endpointInconsistencies + <> cronTriggersInconsistencies + <> openTelemetryInconsistencies + <> inconsistentQueryCollections, + scApiLimits = _metaApiLimits, + scMetricsConfig = _metaMetricsConfig, + scMetadataResourceVersion = metadataResourceVersion, + scSetGraphqlIntrospectionOptions = _metaSetGraphqlIntrospectionOptions, + scTlsAllowlist = networkTlsAllowlist _metaNetwork, + scQueryCollections = _metaQueryCollections, + scBackendCache = _boBackendCache resolvedOutputs, + scSourceHealthChecks = buildHealthCheckCache _metaSources, + scSourcePingConfig = buildSourcePingCache _metaSources, + scOpenTelemetryConfig = openTelemetryInfo + } + returnA -< (schemaCache, storedIntrospectionStatus) where -- See Note [Avoiding GraphQL schema rebuilds when changing irrelevant Metadata] buildOutputsAndSchema = proc (metadataDep, dynamicConfig, invalidationKeysDep, storedIntrospection) -> do (outputs, collectedInfo) <- runWriterA buildAndCollectInfo -< (dynamicConfig, metadataDep, invalidationKeysDep, storedIntrospection) - let (inconsistentObjects, unresolvedDependencies) = partitionEithers $ toList collectedInfo + let (inconsistentObjects, unresolvedDependencies, storedIntrospections) = partitionCollectedInfo collectedInfo out2@(resolvedOutputs, _dependencyInconsistentObjects, _resolvedDependencies) <- resolveDependencies -< (outputs, unresolvedDependencies) out3 <- bindA @@ -488,7 +528,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou (_boCustomTypes resolvedOutputs) mSchemaRegistryContext logger - returnA -< (inconsistentObjects, out2, out3) + returnA -< (inconsistentObjects, storedIntrospections, out2, out3) resolveBackendInfo' :: forall arr m b. @@ -496,7 +536,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou ArrowChoice arr, Inc.ArrowCache m arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadBaseControl IO m, ProvidesNetwork m @@ -514,7 +554,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou ( ArrowChoice arr, Inc.ArrowCache m arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadBaseControl IO m, ProvidesNetwork m, @@ -534,7 +574,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou forall b arr m. ( ArrowChoice arr, Inc.ArrowCache m arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadBaseControl IO m, MonadResolveSource m, @@ -567,7 +607,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou forall b arr m. ( ArrowChoice arr, Inc.ArrowCache m arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadBaseControl IO m, MonadResolveSource m, @@ -589,7 +629,10 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou Just sourceConfig -> do databaseResponse <- bindA -< resolveDatabaseMetadata logger _bcasmSourceMetadata sourceConfig case databaseResponse of - Right databaseMetadata -> returnA -< Just (sourceConfig, databaseMetadata) + Right databaseMetadata -> do + -- Collect database introspection to persist in the storage + tellA -< pure (CollectStoredIntrospection $ SourceIntrospectionItem sourceName $ encJFromJValue databaseMetadata) + returnA -< Just (sourceConfig, databaseMetadata) Left databaseError -> -- If database exception occurs, try to lookup from stored introspection case sourceIntrospection >>= decode' of @@ -626,7 +669,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou forall b arr m. ( ArrowChoice arr, Inc.ArrowCache m arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, BackendMetadata b, MonadBaseControl IO m, @@ -684,7 +727,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou forall b arr m. ( ArrowChoice arr, ArrowKleisli m arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadError QErr m, HasCacheStaticConfig m, BackendMetadata b, @@ -962,7 +1005,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou ( ArrowChoice arr, Inc.ArrowDistribute arr, Inc.ArrowCache m arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadError QErr m, MonadReader BuildReason m, @@ -1165,7 +1208,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou } buildOpenTelemetry :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => + (MonadWriter (Seq CollectItem) m) => OpenTelemetryConfig -> m OpenTelemetryInfo buildOpenTelemetry OpenTelemetryConfig {..} = do @@ -1194,7 +1237,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou ) buildRESTEndpoints :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => + (MonadWriter (Seq CollectItem) m) => QueryCollections -> [CreateEndpoint] -> m (HashMap EndpointName (EndpointMetadata GQLQueryWithText)) @@ -1284,7 +1327,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou forall arr m b. ( ArrowChoice arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, Inc.ArrowCache m arr, MonadIO m, MonadBaseControl IO m, @@ -1422,7 +1465,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou primaryKey buildCronTriggers :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => + (MonadWriter (Seq CollectItem) m) => [CronTriggerMetadata] -> m (HashMap TriggerName CronTriggerInfo) buildCronTriggers = buildInfoMapM ctName mkCronTriggerMetadataObject buildCronTrigger @@ -1435,7 +1478,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou $ resolveCronTrigger env cronTrigger buildInheritedRoles :: - (MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m) => + (MonadWriter (Seq CollectItem) m) => HashSet RoleName -> [InheritedRole] -> m (HashMap RoleName Role) @@ -1451,7 +1494,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou pure resolvedInheritedRole buildActions :: - (MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m) => + (MonadWriter (Seq CollectItem) m) => AnnotatedCustomTypes -> BackendMap ScalarMap -> OrderedRoles -> @@ -1471,7 +1514,7 @@ buildSchemaCacheRule logger env mSchemaRegistryContext = proc (MetadataWithResou return $ ActionInfo name (outputType, outObject) resolvedDef permissionsMap forwardClientHeaders comment buildRemoteSchemaRemoteRelationship :: - (MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m) => + (MonadWriter (Seq CollectItem) m) => HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) -> PartiallyResolvedRemoteSchemaMap -> RemoteSchemaName -> diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs index 20a7cd6b29b..27230d11a6f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs @@ -13,7 +13,6 @@ module Hasura.RQL.DDL.Schema.Cache.Common CacheBuild, CacheBuildParams (CacheBuildParams), InvalidationKeys (..), - StoredIntrospection (..), ikMetadata, ikRemoteSchemas, ikSources, @@ -40,6 +39,7 @@ module Hasura.RQL.DDL.Schema.Cache.Common runCacheBuild, runCacheBuildM, withRecordDependencies, + StoredIntrospectionStatus (..), ) where @@ -47,13 +47,11 @@ import Control.Arrow.Extended import Control.Arrow.Interpret import Control.Lens hiding ((.=)) import Control.Monad.Trans.Control (MonadBaseControl) -import Data.Aeson.Extended import Data.HashMap.Strict.Extended qualified as HashMap import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap import Data.Sequence qualified as Seq import Data.Text.Extended import Hasura.Base.Error -import Hasura.EncJSON import Hasura.Incremental qualified as Inc import Hasura.LogicalModel.Types (LogicalModelName) import Hasura.Prelude @@ -132,29 +130,6 @@ invalidateKeys CacheInvalidations {..} InvalidationKeys {..} = invalidateDataConnectors (BackendInvalidationKeysWrapper invalidationKeys) = BackendInvalidationKeysWrapper $ foldl' (flip invalidate) invalidationKeys ciDataConnectors -data StoredIntrospection = StoredIntrospection - { -- Just catalog introspection - not including enums - siBackendIntrospection :: HashMap SourceName EncJSON, - siRemotes :: HashMap RemoteSchemaName EncJSON - } - deriving stock (Generic) - --- Note that we don't want to introduce an `Eq EncJSON` instance, as this is a --- bit of a footgun. But for Stored Introspection purposes, it's fine: the --- worst-case effect of a semantically inaccurate `Eq` instance is that we --- rebuild the Schema Cache too often. --- --- However, this does mean that we have to spell out this instance a bit. -instance Eq StoredIntrospection where - StoredIntrospection bs1 rs1 == StoredIntrospection bs2 rs2 = - (encJToLBS <$> bs1) == (encJToLBS <$> bs2) && (encJToLBS <$> rs1) == (encJToLBS <$> rs2) - -instance FromJSON StoredIntrospection where - parseJSON = genericParseJSON hasuraJSON - -instance ToJSON StoredIntrospection where - toJSON = genericToJSON hasuraJSON - data TableBuildInput b = TableBuildInput { _tbiName :: TableName b, _tbiIsEnum :: Bool, @@ -286,14 +261,23 @@ runCacheBuildM m = do <*> askCacheStaticConfig runCacheBuild params m +-- | The status of collection of stored introspections of remote schemas and data sources. +data StoredIntrospectionStatus + = -- | A full introspection collection of all available remote schemas and data sources. + StoredIntrospectionChangedFull StoredIntrospection + | -- | A partial introspection collection. Does not include all configured remote schemas and data sources, because they were not available. + StoredIntrospectionChangedPartial StoredIntrospection + | -- | None of remote schemas or data sources introspection is refetched. + StoredIntrospectionUnchanged + data RebuildableSchemaCache = RebuildableSchemaCache { lastBuiltSchemaCache :: SchemaCache, _rscInvalidationMap :: InvalidationKeys, - _rscRebuild :: Inc.Rule (ReaderT BuildReason CacheBuild) (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) SchemaCache + _rscRebuild :: Inc.Rule (ReaderT BuildReason CacheBuild) (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) (SchemaCache, StoredIntrospectionStatus) } withRecordDependencies :: - (ArrowWriter (Seq (Either im MetadataDependency)) arr) => + (ArrowWriter (Seq CollectItem) arr) => WriterA (Seq SchemaDependency) arr (e, s) a -> arr (e, (MetadataObject, (SchemaObjId, s))) a withRecordDependencies f = proc (e, (metadataObject, (schemaObjectId, s))) -> do @@ -303,7 +287,7 @@ withRecordDependencies f = proc (e, (metadataObject, (schemaObjectId, s))) -> do {-# INLINEABLE withRecordDependencies #-} noDuplicates :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => + (MonadWriter (Seq CollectItem) m) => (a -> MetadataObject) -> [a] -> m (Maybe a) @@ -313,7 +297,7 @@ noDuplicates mkMetadataObject = \case values@(value : _) -> do let objectId = _moId $ mkMetadataObject value definitions = map (_moDefinition . mkMetadataObject) values - tell $ Seq.singleton $ Left (DuplicateObjects objectId definitions) + tell $ Seq.singleton $ CollectInconsistentMetadata (DuplicateObjects objectId definitions) return Nothing -- | Processes a list of catalog metadata into a map of processed information, marking any duplicate @@ -321,7 +305,7 @@ noDuplicates mkMetadataObject = \case buildInfoMap :: ( ArrowChoice arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata md)) arr, + ArrowWriter (Seq CollectItem) arr, Hashable k ) => (a -> k) -> @@ -345,7 +329,7 @@ buildInfoMap extractKey mkMetadataObject buildInfo = proc (e, infos) -> do {-# INLINEABLE buildInfoMap #-} buildInfoMapM :: - ( MonadWriter (Seq (Either InconsistentMetadata md)) m, + ( MonadWriter (Seq CollectItem) m, Hashable k ) => (a -> k) -> @@ -369,7 +353,7 @@ buildInfoMapM extractKey mkMetadataObject buildInfo infos = do buildInfoMapPreservingMetadata :: ( ArrowChoice arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata md)) arr, + ArrowWriter (Seq CollectItem) arr, Hashable k ) => (a -> k) -> @@ -385,7 +369,7 @@ buildInfoMapPreservingMetadata extractKey mkMetadataObject buildInfo = {-# INLINEABLE buildInfoMapPreservingMetadata #-} buildInfoMapPreservingMetadataM :: - ( MonadWriter (Seq (Either InconsistentMetadata md)) m, + ( MonadWriter (Seq CollectItem) m, Hashable k ) => (a -> k) -> diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs index 0787b5558f3..4b5a192c510 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs @@ -32,7 +32,7 @@ import Language.GraphQL.Draft.Syntax qualified as G addNonColumnFields :: forall b m. - ( MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + ( MonadWriter (Seq CollectItem) m, BackendMetadata b ) => HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) -> @@ -129,7 +129,7 @@ addNonColumnFields allSources sourceName sourceConfig rawTableInfos columns remo These (_, thisMetadata) (_, thatMetadata) -> do tell $ Seq.singleton - $ Left + $ CollectInconsistentMetadata $ ConflictingObjects ("conflicting definitions for field " <>> fieldName) [thisMetadata, thatMetadata] @@ -175,7 +175,7 @@ mkRelationshipMetadataObject relType source table relDef = in MetadataObject objectId $ toJSON $ WithTable @b source table relDef buildObjectRelationship :: - ( MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + ( MonadWriter (Seq CollectItem) m, BackendMetadata b ) => HashMap (TableName b) (HashSet (ForeignKey b)) -> @@ -189,7 +189,7 @@ buildObjectRelationship fkeysMap sourceName sourceConfig table relDef = do buildRelationship sourceName table buildRelInfo ObjRel relDef buildArrayRelationship :: - ( MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + ( MonadWriter (Seq CollectItem) m, BackendMetadata b ) => HashMap (TableName b) (HashSet (ForeignKey b)) -> @@ -204,7 +204,7 @@ buildArrayRelationship fkeysMap sourceName sourceConfig table relDef = do buildRelationship :: forall m b a. - ( MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + ( MonadWriter (Seq CollectItem) m, ToJSON a, Backend b ) => @@ -247,7 +247,7 @@ mkComputedFieldMetadataObject source table ComputedFieldMetadata {..} = buildComputedField :: forall b m. - ( MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + ( MonadWriter (Seq CollectItem) m, BackendMetadata b ) => HashSet (TableName b) -> @@ -268,7 +268,6 @@ buildComputedField trackedTableNames tableColumns source pgFunctions table cf@Co onNothing (HashMap.lookup function pgFunctions) (throw400 NotExists $ "no such function exists: " <>> function) - rawfi <- getSingleUniqueFunctionOverload @b (computedFieldFunction @b _cfmDefinition) funcDefs buildComputedFieldInfo trackedTableNames table tableColumns _cfmName _cfmDefinition rawfi _cfmComment @@ -294,7 +293,7 @@ mkRemoteRelationshipMetadataObject source table RemoteRelationship {..} = -- dependencies on the remote relationship on the LHS entity are computed here buildRemoteRelationship :: forall b m. - ( MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + ( MonadWriter (Seq CollectItem) m, BackendMetadata b ) => HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) -> diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs index b56cdc4118b..29318da3f48 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs @@ -147,7 +147,7 @@ orderRoles allRoles = do -- | `resolveCheckPermission` is a helper function which will convert the indermediate -- type `CheckPermission` to its original type. It will record any metadata inconsistencies, if exists. resolveCheckPermission :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => + (MonadWriter (Seq CollectItem) m) => CheckPermission p -> RoleName -> InconsistentRoleEntity -> @@ -157,7 +157,7 @@ resolveCheckPermission checkPermission roleName inconsistentEntity = do CPInconsistent -> do let inconsistentObj = -- check `Conflicts while inheriting permissions` in `rfcs/inherited-roles-improvements.md` - Left + CollectInconsistentMetadata $ ConflictingInheritedPermission roleName inconsistentEntity tell $ Seq.singleton inconsistentObj pure Nothing @@ -165,7 +165,7 @@ resolveCheckPermission checkPermission roleName inconsistentEntity = do CPUndefined -> pure Nothing resolveCheckTablePermission :: - ( MonadWriter (Seq (Either InconsistentMetadata md)) m, + ( MonadWriter (Seq CollectItem) m, BackendMetadata b ) => CheckPermission perm -> @@ -186,7 +186,7 @@ resolveCheckTablePermission inheritedRolePermission accumulatedRolePermInfo perm buildTablePermissions :: forall b m. ( MonadError QErr m, - MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + MonadWriter (Seq CollectItem) m, BackendMetadata b, GetAggregationPredicatesDeps b ) => @@ -289,7 +289,7 @@ buildTablePermissions source tableCache tableFields tablePermissions orderedRole buildLogicalModelPermissions :: forall b m. ( MonadError QErr m, - MonadWriter (Seq (Either InconsistentMetadata MetadataDependency)) m, + MonadWriter (Seq CollectItem) m, BackendMetadata b, GetAggregationPredicatesDeps b ) => diff --git a/server/src-lib/Hasura/RQL/Types/Backend.hs b/server/src-lib/Hasura/RQL/Types/Backend.hs index 67a49103391..f75501cf293 100644 --- a/server/src-lib/Hasura/RQL/Types/Backend.hs +++ b/server/src-lib/Hasura/RQL/Types/Backend.hs @@ -135,6 +135,7 @@ class ToJSON (FunctionArgument b), ToJSON (FunctionName b), ToJSON (FunctionReturnType b), + ToJSON (RawFunctionInfo b), ToJSON (ScalarType b), ToJSON (TableName b), ToJSON (ExtraTableMetadata b), diff --git a/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs b/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs index abb0db2dba7..4ceada792c9 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs @@ -24,7 +24,6 @@ import Hasura.RQL.Types.Common import Hasura.RQL.Types.ComputedField import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.Metadata -import Hasura.RQL.Types.Metadata.Object import Hasura.RQL.Types.NamingCase (NamingCase) import Hasura.RQL.Types.Relationships.Local import Hasura.RQL.Types.SchemaCache @@ -78,7 +77,7 @@ class ( ArrowChoice arr, Inc.ArrowCache m arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadBaseControl IO m, ProvidesNetwork m diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs index 1ea142162b7..18ded9c12c9 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs @@ -31,6 +31,9 @@ module Hasura.RQL.Types.SchemaCache.Build throwOnInconsistencies, withNewInconsistentObjsCheck, getInconsistentQueryCollections, + StoredIntrospection (..), + StoredIntrospectionItem (..), + CollectItem (..), ) where @@ -51,6 +54,7 @@ import Database.PG.Query qualified as PG import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName) import Hasura.Backends.Postgres.Connection import Hasura.Base.Error +import Hasura.EncJSON import Hasura.GraphQL.Analyse import Hasura.GraphQL.Transport.HTTP.Protocol import Hasura.Prelude @@ -75,22 +79,22 @@ import Language.GraphQL.Draft.Syntax qualified as G -- * Inconsistencies recordInconsistencies :: - (ArrowWriter (Seq (Either InconsistentMetadata md)) arr, Functor f, Foldable f) => ((Maybe Value, f MetadataObject), Text) `arr` () + (ArrowWriter (Seq CollectItem) arr, Functor f, Foldable f) => ((Maybe Value, f MetadataObject), Text) `arr` () recordInconsistencies = proc ((val, mo), reason) -> - tellA -< Seq.fromList $ toList $ fmap (Left . InconsistentObject reason val) mo + tellA -< Seq.fromList $ toList $ fmap (CollectInconsistentMetadata . InconsistentObject reason val) mo recordInconsistencyM :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => Maybe Value -> MetadataObject -> Text -> m () + (MonadWriter (Seq CollectItem) m) => Maybe Value -> MetadataObject -> Text -> m () recordInconsistencyM val mo reason = recordInconsistenciesM' [(val, mo)] reason recordInconsistenciesM :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => [MetadataObject] -> Text -> m () + (MonadWriter (Seq CollectItem) m) => [MetadataObject] -> Text -> m () recordInconsistenciesM metadataObjects reason = recordInconsistenciesM' ((Nothing,) <$> metadataObjects) reason recordInconsistenciesM' :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => [(Maybe Value, MetadataObject)] -> Text -> m () + (MonadWriter (Seq CollectItem) m) => [(Maybe Value, MetadataObject)] -> Text -> m () recordInconsistenciesM' metadataObjects reason = - tell $ Seq.fromList $ map (Left . uncurry (InconsistentObject reason)) metadataObjects + tell $ Seq.fromList $ map (CollectInconsistentMetadata . uncurry (InconsistentObject reason)) metadataObjects -- * Dependencies @@ -100,28 +104,28 @@ data MetadataDependency MetadataObject SchemaObjId SchemaDependency - deriving (Eq) + deriving (Eq, Show) recordDependencies :: - (ArrowWriter (Seq (Either im MetadataDependency)) arr) => + (ArrowWriter (Seq CollectItem) arr) => (MetadataObject, SchemaObjId, Seq SchemaDependency) `arr` () recordDependencies = proc (metadataObject, schemaObjectId, dependencies) -> - tellA -< Right . MetadataDependency metadataObject schemaObjectId <$> dependencies + tellA -< CollectMetadataDependency . MetadataDependency metadataObject schemaObjectId <$> dependencies recordDependenciesM :: - (MonadWriter (Seq (Either im MetadataDependency)) m) => + (MonadWriter (Seq CollectItem) m) => MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m () recordDependenciesM metadataObject schemaObjectId dependencies = do - tell $ Right . MetadataDependency metadataObject schemaObjectId <$> dependencies + tell $ CollectMetadataDependency . MetadataDependency metadataObject schemaObjectId <$> dependencies -- * Helpers -- | Monadic version of 'withRecordInconsistency' withRecordInconsistencyM :: - (MonadWriter (Seq (Either InconsistentMetadata md)) m) => + (MonadWriter (Seq CollectItem) m) => MetadataObject -> ExceptT QErr m a -> m (Maybe a) @@ -146,8 +150,8 @@ withRecordInconsistencyM metadataObject f = do Right v -> return $ Just v recordInconsistenciesWith :: - (ArrowChoice arr, ArrowWriter (Seq (Either InconsistentMetadata md)) arr) => - ((ArrowWriter (Seq (Either InconsistentMetadata md)) arr) => ((Maybe Value, mo), Text) `arr` ()) -> + (ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) => + ((ArrowWriter (Seq CollectItem) arr) => ((Maybe Value, mo), Text) `arr` ()) -> ErrorA QErr arr (e, s) a -> arr (e, (mo, s)) (Maybe a) recordInconsistenciesWith recordInconsistency' f = proc (e, (metadataObject, s)) -> do @@ -173,7 +177,7 @@ recordInconsistenciesWith recordInconsistency' f = proc (e, (metadataObject, s)) -- | Record any errors resulting from a computation as inconsistencies withRecordInconsistency :: - (ArrowChoice arr, ArrowWriter (Seq (Either InconsistentMetadata md)) arr) => + (ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) => ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a) withRecordInconsistency err = proc (e, (mo, s)) -> @@ -181,7 +185,7 @@ withRecordInconsistency err = proc (e, (mo, s)) -> {-# INLINEABLE withRecordInconsistency #-} withRecordInconsistencies :: - (ArrowChoice arr, ArrowWriter (Seq (Either InconsistentMetadata md)) arr) => + (ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) => ErrorA QErr arr (e, s) a -> arr (e, ([MetadataObject], s)) (Maybe a) withRecordInconsistencies = recordInconsistenciesWith recordInconsistencies @@ -487,3 +491,52 @@ getInconsistentQueryCollections rs qcs lqToMetadataObj restEndpoints allowLst = -- perform the validation for_ (diagnoseGraphQLQuery rs singleOperation) \errors -> throwError (lqToMetadataObj eMeta, formatError eMeta errors) + +data StoredIntrospection = StoredIntrospection + { -- Just catalog introspection - not including enums + siBackendIntrospection :: HashMap SourceName EncJSON, + siRemotes :: HashMap RemoteSchemaName EncJSON + } + deriving stock (Generic) + +-- Note that we don't want to introduce an `Eq EncJSON` instance, as this is a +-- bit of a footgun. But for Stored Introspection purposes, it's fine: the +-- worst-case effect of a semantically inaccurate `Eq` instance is that we +-- rebuild the Schema Cache too often. +-- +-- However, this does mean that we have to spell out this instance a bit. +instance Eq StoredIntrospection where + StoredIntrospection bs1 rs1 == StoredIntrospection bs2 rs2 = + (encJToLBS <$> bs1) == (encJToLBS <$> bs2) && (encJToLBS <$> rs1) == (encJToLBS <$> rs2) + +instance FromJSON StoredIntrospection where + parseJSON = genericParseJSON hasuraJSON + +instance ToJSON StoredIntrospection where + toJSON = genericToJSON hasuraJSON + +-- | Represents remote schema or source introspection data to be persisted in a storage (database). +data StoredIntrospectionItem + = SourceIntrospectionItem SourceName EncJSON + | RemoteSchemaIntrospectionItem RemoteSchemaName EncJSON + +-- The same comment as above for `Eq StoredIntrospection` applies here as well: our refusal to have an `Eq EncJSON` instance means that we can't `stock`-derive this instance. +instance Eq StoredIntrospectionItem where + SourceIntrospectionItem lSource lIntrospection == SourceIntrospectionItem rSource rIntrospection = + (lSource == rSource) && (encJToLBS lIntrospection) == (encJToLBS rIntrospection) + RemoteSchemaIntrospectionItem lRemoteSchema lIntrospection == RemoteSchemaIntrospectionItem rRemoteSchema rIntrospection = + (lRemoteSchema == rRemoteSchema) && (encJToLBS lIntrospection) == (encJToLBS rIntrospection) + _ == _ = False + +instance Show StoredIntrospectionItem where + show = \case + SourceIntrospectionItem sourceName _ -> "introspection data of source " ++ show sourceName + RemoteSchemaIntrospectionItem remoteSchemaName _ -> "introspection data of source " ++ show remoteSchemaName + +-- | Items to be collected while building schema cache +-- See @'buildSchemaCacheRule' for more details. +data CollectItem + = CollectInconsistentMetadata InconsistentMetadata + | CollectMetadataDependency MetadataDependency + | CollectStoredIntrospection StoredIntrospectionItem + deriving (Show, Eq) diff --git a/server/src-lib/Hasura/RQL/Types/Source.hs b/server/src-lib/Hasura/RQL/Types/Source.hs index cc344f447d8..bc54e7da8df 100644 --- a/server/src-lib/Hasura/RQL/Types/Source.hs +++ b/server/src-lib/Hasura/RQL/Types/Source.hs @@ -156,6 +156,7 @@ data DBObjectsIntrospection b = DBObjectsIntrospection instance (Backend b) => FromJSON (DBObjectsIntrospection b) where parseJSON = withObject "DBObjectsIntrospection" \o -> do + -- "tables": [["", ""], ["", ""]] tables <- o .: "tables" functions <- o .: "functions" scalars <- o .: "scalars" @@ -168,6 +169,16 @@ instance (Backend b) => FromJSON (DBObjectsIntrospection b) where _rsLogicalModels = InsOrdHashMap.fromList logicalModels } +instance (Backend b) => ToJSON (DBObjectsIntrospection b) where + toJSON (DBObjectsIntrospection tables functions (ScalarMap scalars) logicalModels) = + -- "tables": [["", ""], ["", ""]] + object + [ "tables" .= HashMap.toList tables, + "functions" .= HashMap.toList functions, + "scalars" .= HashMap.toList scalars, + "logical_models" .= InsOrdHashMap.toList logicalModels + ] + instance (L.ToEngineLog (DBObjectsIntrospection b) L.Hasura) where toEngineLog _ = (L.LevelDebug, L.ELTStartup, toJSON rsLog) where diff --git a/server/src-lib/Hasura/RemoteSchema/SchemaCache/Build.hs b/server/src-lib/Hasura/RemoteSchema/SchemaCache/Build.hs index 74e18d9609b..01b832ed3ec 100644 --- a/server/src-lib/Hasura/RemoteSchema/SchemaCache/Build.hs +++ b/server/src-lib/Hasura/RemoteSchema/SchemaCache/Build.hs @@ -16,6 +16,7 @@ import Data.HashMap.Strict.Extended qualified as HashMap import Data.Text qualified as T import Data.Text.Extended import Hasura.Base.Error +import Hasura.EncJSON (encJFromLBS) import Hasura.GraphQL.RemoteServer import Hasura.Incremental qualified as Inc import Hasura.Prelude @@ -38,7 +39,7 @@ import Hasura.Tracing qualified as Tracing buildRemoteSchemas :: ( ArrowChoice arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, Inc.ArrowCache m arr, MonadIO m, MonadBaseControl IO m, @@ -64,7 +65,10 @@ buildRemoteSchemas env = upstreamResponse <- bindA -< runExceptT (noopTrace $ addRemoteSchemaP2Setup env defn) remoteSchemaContextParts <- case upstreamResponse of - Right upstream -> returnA -< Just upstream + Right upstream@(_, byteString, _) -> do + -- Collect upstream introspection response to persist in the storage + tellA -< pure (CollectStoredIntrospection $ RemoteSchemaIntrospectionItem name $ encJFromLBS byteString) + returnA -< Just upstream Left upstreamError -> do -- If upstream is not available, try to lookup from stored introspection case (HashMap.lookup name =<< storedIntrospection) of @@ -123,7 +127,7 @@ buildRemoteSchemas env = buildRemoteSchemaPermissions :: ( ArrowChoice arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, ArrowKleisli m arr, MonadError QErr m ) => diff --git a/server/src-lib/Hasura/Table/API.hs b/server/src-lib/Hasura/Table/API.hs index eac2e21efbb..bb2c6a9d0b8 100644 --- a/server/src-lib/Hasura/Table/API.hs +++ b/server/src-lib/Hasura/Table/API.hs @@ -691,7 +691,7 @@ buildTableCache :: forall arr m b. ( ArrowChoice arr, Inc.ArrowDistribute arr, - ArrowWriter (Seq (Either InconsistentMetadata MetadataDependency)) arr, + ArrowWriter (Seq CollectItem) arr, Inc.ArrowCache m arr, MonadIO m, MonadBaseControl IO m, diff --git a/server/src-lib/Hasura/Table/Cache.hs b/server/src-lib/Hasura/Table/Cache.hs index d90b2072243..2c442348031 100644 --- a/server/src-lib/Hasura/Table/Cache.hs +++ b/server/src-lib/Hasura/Table/Cache.hs @@ -1115,6 +1115,16 @@ instance (Backend b) => FromJSON (ForeignKeyMetadata b) where $ NE.zip columns foreignColumns } +instance (Backend b) => ToJSON (ForeignKeyMetadata b) where + toJSON (ForeignKeyMetadata (ForeignKey constraint foreignTable columnMapping)) = + let (columns, foreignColumns) = NE.unzip $ NEHashMap.toList columnMapping + in object + [ "constraint" .= constraint, + "foreign_table" .= foreignTable, + "columns" .= columns, + "foreign_columns" .= foreignColumns + ] + -- | Metadata of any Backend table which is being extracted from source database data DBTableMetadata (b :: BackendType) = DBTableMetadata { _ptmiOid :: OID, @@ -1138,6 +1148,9 @@ instance (Backend b) => NFData (DBTableMetadata b) instance (Backend b) => FromJSON (DBTableMetadata b) where parseJSON = genericParseJSON hasuraJSON +instance (Backend b) => ToJSON (DBTableMetadata b) where + toJSON = genericToJSON hasuraJSON + type DBTablesMetadata b = HashMap (TableName b) (DBTableMetadata b) getFieldInfoM :: diff --git a/server/src-test/Hasura/RQL/Types/CommonSpec.hs b/server/src-test/Hasura/RQL/Types/CommonSpec.hs index 7c8df62aaca..543b738a6b5 100644 --- a/server/src-test/Hasura/RQL/Types/CommonSpec.hs +++ b/server/src-test/Hasura/RQL/Types/CommonSpec.hs @@ -15,7 +15,6 @@ import Hasura.Generator.Common import Hasura.Prelude import Hasura.QuickCheck.Instances () import Hasura.RQL.Types.Common -import Hasura.RQL.Types.Metadata.Object import Hasura.RQL.Types.SchemaCache.Build import Hedgehog.Gen qualified as Gen import Hedgehog.Generic @@ -97,7 +96,7 @@ withRecordInconsistencyEqualSpec = prop "Should equal withRecordInconsistencyM" $ \inputMetadata (errOrUnit :: Either QErr ()) -> let arrowInputArr = ErrorA (arr (const errOrUnit)) - arrow = withRecordInconsistency @_ @InconsistentMetadata arrowInputArr + arrow = withRecordInconsistency arrowInputArr arrowOutput = runWriter $ runKleisli arrow ((), (inputMetadata, ())) monadInput = liftEither errOrUnit