diff --git a/server/src-lib/Hasura/App.hs b/server/src-lib/Hasura/App.hs index fdbe1783eebc9..7a74369128e7a 100644 --- a/server/src-lib/Hasura/App.hs +++ b/server/src-lib/Hasura/App.hs @@ -61,6 +61,7 @@ import Hasura.GraphQL.Transport.HTTP.Protocol (toParsed) import Hasura.Logging import Hasura.Prelude import Hasura.RQL.DDL.Schema.Cache +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.Types import Hasura.RQL.Types.Run import Hasura.Server.API.Query @@ -228,7 +229,7 @@ initialiseCtx env (HGEOptionsG rci metadataDbUrl hgeCmd) = do migrateCatalogSchema logger pgLogger env connParams rci metadataDbUrl schemaCacheE <- runExceptT - $ peelMetadataRun (RunCtx adminUserInfo httpManager sqlGenCtx) metadata + $ peelMetadataRun (RunCtx adminUserInfo httpManager sqlGenCtx {- TODO: -} defaultResolveCustomSource) metadata $ buildRebuildableSchemaCache env schemaCache <- fmap fst $ onLeft schemaCacheE $ \err -> do @@ -326,6 +327,7 @@ runHGEServer , Tracing.HasReporter m , MonadQueryInstrumentation m , MonadMetadataStorage m + , HasResolveCustomSource m ) => Env.Environment -> ServeOptions impl @@ -357,6 +359,8 @@ runHGEServer env ServeOptions{..} InitCtx{..} _ initTime Loggers loggerCtx logger _ = _icLoggers SchemaSyncCtx schemaSyncListenerThread schemaSyncEventRef = schemaSyncCtx + srcResolver <- askResolveCustomSource + authModeRes <- runExceptT $ setupAuthMode soAdminSecret soAuthHook soJwtSecret soUnAuthRole _icHttpManager logger @@ -393,7 +397,7 @@ runHGEServer env ServeOptions{..} InitCtx{..} _ initTime -- start background thread for schema sync event processing schemaSyncProcessorThread <- - startSchemaSyncProcessorThread sqlGenCtx + startSchemaSyncProcessorThread sqlGenCtx srcResolver logger _icHttpManager schemaSyncEventRef cacheRef _icInstanceId let @@ -631,7 +635,7 @@ runAsAdmin -> m (Either QErr a) runAsAdmin sqlGenCtx httpManager metadata m = fmap (fmap fst) $ runExceptT $ - peelMetadataRun (RunCtx adminUserInfo httpManager sqlGenCtx) metadata m + peelMetadataRun (RunCtx adminUserInfo httpManager sqlGenCtx {- TODO: -} defaultResolveCustomSource) metadata m execQuery :: ( HasVersion @@ -646,7 +650,7 @@ execQuery env httpManager metadata queryBs = runExceptT do QueryWithSource source query <- case A.decode queryBs of Just jVal -> decodeValue jVal Nothing -> throw400 InvalidJSON "invalid json" - let runCtx = RunCtx adminUserInfo httpManager (SQLGenCtx False) + let runCtx = RunCtx adminUserInfo httpManager (SQLGenCtx False) {- TODO: -} defaultResolveCustomSource actionM = do buildSchemaCacheStrict noMetadataModify encJToLBS <$> runQueryM env source query @@ -667,6 +671,9 @@ execQuery env httpManager metadata queryBs = runExceptT do instance Tracing.HasReporter ServerAppM +instance HasResolveCustomSource ServerAppM where + askResolveCustomSource = pure defaultResolveCustomSource + instance MonadQueryInstrumentation ServerAppM where askInstrumentQuery _ = pure (id, noProfile) diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 4c9a0e7a77531..2276fcac90c3d 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -69,7 +69,8 @@ runClearMetadata _ = do Nothing -> emptyMetadata Just defaultSourceMetadata -> let emptyDefaultSource = SourceMetadata defaultSource mempty mempty - $ _smConfiguration defaultSourceMetadata + (_smConfiguration defaultSourceMetadata) + (_smReplicas defaultSourceMetadata) in emptyMetadata & metaSources %~ HM.insert defaultSource emptyDefaultSource pure successMsg @@ -405,7 +406,7 @@ fetchMetadataFromHdbTables defaultSourceConfig = liftTx do let tableMetadatas = mapFromL _tmTable $ HM.elems postRelMap sources = HM.singleton defaultSource $ - SourceMetadata defaultSource tableMetadatas functions defaultSourceConfig + SourceMetadata defaultSource tableMetadatas functions defaultSourceConfig [] {- TODO: not sure what to do here -} pure $ Metadata sources remoteSchemas collections allowlist customTypes actions cronTriggers diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 5e70c99d69ee8..40e97b7167f29 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -53,7 +53,8 @@ import Hasura.RQL.DDL.Schema.Cache.Permission import Hasura.RQL.DDL.Schema.Diff import Hasura.RQL.DDL.Schema.Enum (fetchEnumValuesFromDb) import Hasura.RQL.DDL.Schema.Function -import Hasura.RQL.DDL.Schema.Source (fetchPgScalars, resolveSource) +import Hasura.RQL.DDL.Schema.Source (HasResolveCustomSource, + fetchPgScalars, resolveSource) import Hasura.RQL.DDL.Schema.Table import Hasura.RQL.Types hiding (tmTable) import Hasura.Server.Version (HasVersion) @@ -62,6 +63,7 @@ import Hasura.SQL.Types buildRebuildableSchemaCache :: ( HasVersion, MonadIO m, MonadError QErr m , HasHttpManager m, HasSQLGenCtx m, MonadMetadata m + , HasResolveCustomSource m ) => Env.Environment -> m RebuildableSchemaCache @@ -96,7 +98,7 @@ instance (Monad m) => CacheRM (CacheRWT m) where askSchemaCache = CacheRWT $ gets (lastBuiltSchemaCache . (^. _1)) instance ( MonadIO m , MonadMetadata m, MonadError QErr m - , HasHttpManager m, HasSQLGenCtx m + , HasHttpManager m, HasSQLGenCtx m, HasResolveCustomSource m ) => CacheRWM (CacheRWT m) where buildSchemaCacheWithOptions buildReason invalidations metadataModifier = CacheRWT do (RebuildableSchemaCache _ invalidationKeys rule, oldInvalidations, resolvedSources) <- get @@ -128,7 +130,7 @@ buildSchemaCacheRule :: ( HasVersion, ArrowChoice arr, Inc.ArrowDistribute arr, Inc.ArrowCache m arr , MonadIO m, MonadUnique m, MonadError QErr m , MonadReader BuildContext m, HasHttpManager m, HasSQLGenCtx m - , MonadBaseControl IO m + , MonadBaseControl IO m, HasResolveCustomSource m ) => Env.Environment -> (Metadata, InvalidationKeys) `arr` SchemaCache @@ -193,6 +195,7 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do , ArrowWriter (Seq CollectedInfo) arr , MonadIO m, MonadBaseControl IO m , MonadReader BuildContext m + , HasResolveCustomSource m ) => ( Inc.Dependency (HashMap SourceName Inc.InvalidationKey) , SourceMetadata @@ -203,14 +206,14 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do Inc.dependOn -< Inc.selectKeyD sourceName invalidationKeys (| withRecordInconsistency ( liftEitherA <<< bindA -< (getResolvedSourceFromBuildContext sourceName <$> ask) >>= \case - Nothing -> resolveSource env $ _smConfiguration sourceMetadata + Nothing -> resolveSource env (_smConfiguration sourceMetadata) (_smReplicas sourceMetadata) Just rs -> pure $ Right rs) |) metadataObj buildSource :: ( ArrowChoice arr, Inc.ArrowDistribute arr, Inc.ArrowCache m arr , ArrowWriter (Seq CollectedInfo) arr, MonadReader BuildContext m - , HasSQLGenCtx m, MonadIO m, MonadError QErr m) + , HasSQLGenCtx m, MonadIO m, MonadError QErr m, HasResolveCustomSource m) => ( SourceMetadata , PGSourceConfig , PostgresTablesMetadata @@ -220,7 +223,7 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do , Inc.Dependency InvalidationKeys ) `arr` SourceOutput buildSource = proc (sourceMetadata, sourceConfig, pgTables, pgFunctions, enumTables, remoteSchemaMap, invalidationKeys) -> do - let SourceMetadata source tables functions _ = sourceMetadata + let SourceMetadata source tables functions _ _ = sourceMetadata (tableInputs, nonColumnInputs, permissions) = unzip3 $ map mkTableInputs $ M.elems tables eventTriggers = map (_tmTable &&& (M.elems . _tmEventTriggers)) (M.elems tables) -- HashMap k a -> HashMap k b -> HashMap k (a, b) @@ -281,7 +284,7 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do :: ( ArrowChoice arr, Inc.ArrowDistribute arr, Inc.ArrowCache m arr , ArrowWriter (Seq CollectedInfo) arr, MonadIO m, MonadBaseControl IO m , MonadError QErr m, MonadUnique m, MonadReader BuildContext m - , HasHttpManager m, HasSQLGenCtx m ) + , HasHttpManager m, HasSQLGenCtx m, HasResolveCustomSource m ) => (Metadata, Inc.Dependency InvalidationKeys) `arr` BuildOutputs buildAndCollectInfo = proc (metadata, invalidationKeys) -> do let Metadata sources remoteSchemas collections allowlists 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 3d0c1fbf0276b..926ff963f66ba 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs @@ -20,6 +20,7 @@ import Control.Monad.Unique import qualified Hasura.Incremental as Inc +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.Types import Hasura.SQL.Types @@ -124,8 +125,9 @@ $(makeLenses ''BuildOutputs) -- | Parameters required for schema cache build data CacheBuildParams = CacheBuildParams - { _cbpManager :: !HTTP.Manager - , _cbpSqlGenCtx :: !SQLGenCtx + { _cbpManager :: !HTTP.Manager + , _cbpSqlGenCtx :: !SQLGenCtx + , _cbpRslvCustomSrc :: !ResolveCustomSource } -- | The monad in which @'RebuildableSchemaCache' is being run @@ -145,18 +147,23 @@ instance HasHttpManager CacheBuild where instance HasSQLGenCtx CacheBuild where askSQLGenCtx = asks _cbpSqlGenCtx + +instance HasResolveCustomSource CacheBuild where + askResolveCustomSource = asks _cbpRslvCustomSrc runCacheBuild :: ( MonadIO m , MonadError QErr m , HasHttpManager m , HasSQLGenCtx m + , HasResolveCustomSource m ) => CacheBuild a -> m a runCacheBuild (CacheBuild m) = do httpManager <- askHttpManager sqlGenCtx <- askSQLGenCtx - let params = CacheBuildParams httpManager sqlGenCtx + rslvCustomSrc <- askResolveCustomSource + let params = CacheBuildParams httpManager sqlGenCtx rslvCustomSrc liftEitherM $ liftIO $ runExceptT (runReaderT m params) data RebuildableSchemaCache diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Source.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Source.hs index 2f3f25b365b33..616a6fe7f30b7 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Source.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Source.hs @@ -8,18 +8,35 @@ import Hasura.RQL.DDL.Deps import Hasura.RQL.DDL.Schema.Common import Hasura.RQL.Types import Hasura.SQL.Types +import Hasura.Tracing import qualified Data.Environment as Env import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as S import qualified Database.PG.Query as Q -resolveSource - :: (MonadIO m, MonadBaseControl IO m) - => Env.Environment -> SourceConfiguration -> m (Either QErr ResolvedSource) -resolveSource env config = runExceptT do - let SourceConfiguration urlConf connSettings = config - SourceConnSettings maxConns idleTimeout retries = connSettings +type ResolveCustomSource = + Env.Environment + -> SourceConfiguration + -> [SourceConfiguration] + -> IO (Either QErr PGSourceConfig) + +class Monad m => HasResolveCustomSource m where + askResolveCustomSource :: m ResolveCustomSource + + -- A default for monad transformer instances + default askResolveCustomSource + :: (m ~ t n, MonadTrans t, HasResolveCustomSource n) + => m ResolveCustomSource + askResolveCustomSource = lift askResolveCustomSource + +instance HasResolveCustomSource m => HasResolveCustomSource (ReaderT r m) +instance HasResolveCustomSource m => HasResolveCustomSource (ExceptT e m) +instance HasResolveCustomSource m => HasResolveCustomSource (TraceT m) + +defaultResolveCustomSource :: ResolveCustomSource +defaultResolveCustomSource env (SourceConfiguration urlConf connSettings) _replicas = runExceptT do + let SourceConnSettings maxConns idleTimeout retries = connSettings urlText <- resolveUrlConf env urlConf let connInfo = Q.ConnInfo retries $ Q.CDDatabaseURI $ txtToBs urlText connParams = Q.defaultConnParams{ Q.cpIdleTime = idleTimeout @@ -27,7 +44,17 @@ resolveSource env config = runExceptT do } pgPool <- liftIO $ Q.initPGPool connInfo connParams (\_ -> pure ()) -- FIXME? Pg logger let pgExecCtx = mkPGExecCtx Q.ReadCommitted pgPool - sourceConfig = PGSourceConfig pgExecCtx connInfo + pure $ PGSourceConfig pgExecCtx connInfo + +resolveSource + :: (MonadIO m, MonadBaseControl IO m, HasResolveCustomSource m) + => Env.Environment + -> SourceConfiguration + -> [SourceConfiguration] + -> m (Either QErr ResolvedSource) +resolveSource env config replicas = runExceptT do + resolver <- askResolveCustomSource + sourceConfig <- ExceptT . liftIO $ resolver env config replicas (tablesMeta, functionsMeta, pgScalars) <- runLazyTx (_pscExecCtx sourceConfig) Q.ReadWrite $ do initSource diff --git a/server/src-lib/Hasura/RQL/Types/Metadata.hs b/server/src-lib/Hasura/RQL/Types/Metadata.hs index 8609a898d4c7f..4454a32339210 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata.hs @@ -311,6 +311,7 @@ data SourceMetadata , _smTables :: !Tables , _smFunctions :: !Functions , _smConfiguration :: !SourceConfiguration + , _smReplicas :: ![SourceConfiguration] } deriving (Show, Eq, Lift, Generic) instance Cacheable SourceMetadata $(makeLenses ''SourceMetadata) @@ -320,12 +321,15 @@ instance FromJSON SourceMetadata where _smTables <- mapFromL _tmTable <$> o .: "tables" _smFunctions <- mapFromL _fmFunction <$> o .:? "functions" .!= [] _smConfiguration <- o .: "configuration" + _smReplicas <- o .:? "read_replicas" .!= [] pure SourceMetadata{..} mkSourceMetadata :: SourceName -> UrlConf -> SourceConnSettings -> SourceMetadata mkSourceMetadata name urlConf connSettings = - SourceMetadata name mempty mempty $ SourceConfiguration urlConf connSettings + SourceMetadata name mempty mempty + (SourceConfiguration urlConf connSettings) + mempty type Sources = M.HashMap SourceName SourceMetadata @@ -464,7 +468,8 @@ metadataToOrdJSON ( Metadata tablesPair = ("tables", AO.array $ map tableMetaToOrdJSON $ M.elems _smTables) functionsPair = listToMaybeOrdPair "functions" functionMetadataToOrdJSON $ M.elems _smFunctions configurationPair = [("configuration", AO.toOrdered _smConfiguration)] - in AO.object $ [sourceNamePair, tablesPair] <> maybeToList functionsPair <> configurationPair + replicasPair = [("read_replicas", AO.toOrdered _smReplicas) | not (null _smReplicas)] + in AO.object $ [sourceNamePair, tablesPair] <> maybeToList functionsPair <> configurationPair <> replicasPair tableMetaToOrdJSON :: TableMetadata -> AO.Value tableMetaToOrdJSON ( TableMetadata diff --git a/server/src-lib/Hasura/RQL/Types/Run.hs b/server/src-lib/Hasura/RQL/Types/Run.hs index 7af7cfb3bf8aa..4dda2e300d16b 100644 --- a/server/src-lib/Hasura/RQL/Types/Run.hs +++ b/server/src-lib/Hasura/RQL/Types/Run.hs @@ -22,6 +22,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Unique import Data.Aeson +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.Types import qualified Hasura.Tracing as Tracing @@ -30,6 +31,7 @@ data RunCtx { _rcUserInfo :: !UserInfo , _rcHttpMgr :: !HTTP.Manager , _rcSqlGenCtx :: !SQLGenCtx + , _rcRslvCustomSrc :: !ResolveCustomSource } newtype BaseRunT m a @@ -58,6 +60,9 @@ instance (Monad m) => MonadMetadata (BaseRunT m) where fetchMetadata = get updateMetadata = put +instance (Monad m) => HasResolveCustomSource (BaseRunT m) where + askResolveCustomSource = asks _rcRslvCustomSrc + runBaseRunT :: RunCtx -> Metadata -> BaseRunT m a -> m (a, Metadata) runBaseRunT runCtx metadata (BaseRunT m) = runStateT (runReaderT m runCtx) metadata @@ -73,6 +78,7 @@ newtype MetadataRun m a , UserInfoM , HasHttpManager , HasSQLGenCtx + , HasResolveCustomSource ) runInMetadataRun :: (Monad m) => MetadataStorageT m a -> MetadataRun m a @@ -117,6 +123,7 @@ newtype QueryRun a , UserInfoM , HasHttpManager , HasSQLGenCtx + , HasResolveCustomSource ) peelQueryRun diff --git a/server/src-lib/Hasura/Server/API/Metadata.hs b/server/src-lib/Hasura/Server/API/Metadata.hs index 66456432d3697..f049e66ff511f 100644 --- a/server/src-lib/Hasura/Server/API/Metadata.hs +++ b/server/src-lib/Hasura/Server/API/Metadata.hs @@ -146,15 +146,16 @@ runMetadataRequest -> UserInfo -> HTTP.Manager -> SQLGenCtx + -> ResolveCustomSource -> RebuildableSchemaCache -> Metadata -> RQLMetadata -> m (EncJSON, MetadataStateResult) -runMetadataRequest env userInfo httpManager sqlGenCtx schemaCache metadata request = do +runMetadataRequest env userInfo httpManager sqlGenCtx srcResolver schemaCache metadata request = do ((r, modSchemaCache, cacheInvalidations), modMetadata) <- runMetadataRequestM env request & runCacheRWT schemaCache - & peelMetadataRun (RunCtx userInfo httpManager sqlGenCtx) metadata + & peelMetadataRun (RunCtx userInfo httpManager sqlGenCtx srcResolver) metadata & runExceptT & liftEitherM pure (r, MetadataStateResult modSchemaCache cacheInvalidations modMetadata) diff --git a/server/src-lib/Hasura/Server/API/Query.hs b/server/src-lib/Hasura/Server/API/Query.hs index 7d002539a512f..bc48f6bab1a8c 100644 --- a/server/src-lib/Hasura/Server/API/Query.hs +++ b/server/src-lib/Hasura/Server/API/Query.hs @@ -4,6 +4,7 @@ module Hasura.Server.API.Query where import Hasura.EncJSON import Hasura.Prelude import Hasura.RQL.DDL.Schema +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.DML.Count import Hasura.RQL.DML.Delete import Hasura.RQL.DML.Insert @@ -79,11 +80,12 @@ runQuery -> UserInfo -> HTTP.Manager -> SQLGenCtx + -> ResolveCustomSource -> RebuildableSchemaCache -> Metadata -> QueryWithSource -> m (EncJSON, Maybe MetadataStateResult) -runQuery env userInfo httpManager sqlGenCtx schemaCache metadata request = do +runQuery env userInfo httpManager sqlGenCtx srcResolver schemaCache metadata request = do traceCtx <- Tracing.currentContext accessMode <- fromMaybe Q.ReadWrite <$> getQueryAccessMode rqlQuery let sc = lastBuiltSchemaCache schemaCache @@ -93,7 +95,7 @@ runQuery env userInfo httpManager sqlGenCtx schemaCache metadata request = do (((r, tracemeta), rsc, ci), meta) <- x & runCacheRWT schemaCache & peelQueryRun sourceConfig accessMode (Just traceCtx) - (RunCtx userInfo httpManager sqlGenCtx) metadata + (RunCtx userInfo httpManager sqlGenCtx srcResolver) metadata & runExceptT & liftEitherM let metadataStateRes = MetadataStateResult rsc ci meta diff --git a/server/src-lib/Hasura/Server/API/V1Query.hs b/server/src-lib/Hasura/Server/API/V1Query.hs index f3bc84f528490..ef7eb1018125f 100644 --- a/server/src-lib/Hasura/Server/API/V1Query.hs +++ b/server/src-lib/Hasura/Server/API/V1Query.hs @@ -33,6 +33,7 @@ import Hasura.RQL.DDL.RemoteRelationship import Hasura.RQL.DDL.RemoteSchema import Hasura.RQL.DDL.ScheduledTrigger import Hasura.RQL.DDL.Schema +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.DML.Count import Hasura.RQL.DML.Delete import Hasura.RQL.DML.Insert @@ -76,6 +77,7 @@ newtype Run m a = Run {unRun :: BaseRunT (LazyTxT QErr m) a} , UserInfoM , HasHttpManager , HasSQLGenCtx + , HasResolveCustomSource ) deriving instance (MonadIO m, MonadBaseControl IO m) => MonadBaseControl IO (Run m) diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 91065b8798bdb..817652f892f2d 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -42,6 +42,7 @@ import Hasura.EncJSON import Hasura.GraphQL.Logging (MonadQueryLog (..)) import Hasura.HTTP import Hasura.RQL.DDL.Schema +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.Types import Hasura.RQL.Types.Run import Hasura.Server.API.Config (runGetConfig) @@ -382,6 +383,7 @@ v1QueryHandler , MonadBaseControl IO m , Tracing.MonadTrace m , MonadMetadataStorage m + , HasResolveCustomSource m ) => V1Q.RQLQuery -> Handler m (HttpResponse EncJSON) @@ -395,9 +397,10 @@ v1QueryHandler v1Query = do httpMgr <- asks (scManager . hcServerCtx) sqlGenCtx <- asks (scSQLGenCtx . hcServerCtx) env <- asks (scEnvironment . hcServerCtx) - + srcResolver <- askResolveCustomSource + let sources = scPostgres $ lastBuiltSchemaCache schemaCache - runCtx = RunCtx userInfo httpMgr sqlGenCtx + runCtx = RunCtx userInfo httpMgr sqlGenCtx srcResolver (sourceName, sourceConfig) <- case M.toList sources of [] -> throw400 NotSupported "no postgres source exist" @@ -428,6 +431,7 @@ v1MetadataHandler , MonadMetadataStorage m , MonadApiAuthorization m , MonadUnique m + , HasResolveCustomSource m ) => RQLMetadata -> Handler m (HttpResponse EncJSON) v1MetadataHandler request = do @@ -441,9 +445,10 @@ v1MetadataHandler request = do env <- asks (scEnvironment . hcServerCtx) instanceId <- asks (scInstanceId . hcServerCtx) logger <- asks (scLogger . hcServerCtx) + srcResolver <- askResolveCustomSource r <- withSCUpdate scRef instanceId logger $ second Just <$> runMetadataRequest env userInfo httpMgr sqlGenCtx - schemaCache metadata request + srcResolver schemaCache metadata request pure $ HttpResponse r [] v2QueryHandler @@ -453,6 +458,7 @@ v2QueryHandler , MonadMetadataStorage m , Tracing.MonadTrace m , MonadApiAuthorization m + , HasResolveCustomSource m ) => QueryWithSource -> Handler m (HttpResponse EncJSON) v2QueryHandler request = do @@ -466,8 +472,10 @@ v2QueryHandler request = do env <- asks (scEnvironment . hcServerCtx) instanceId <- asks (scInstanceId . hcServerCtx) logger <- asks (scLogger . hcServerCtx) + srcResolver <- askResolveCustomSource r <- withSCUpdate scRef instanceId logger $ - runQuery env userInfo httpMgr sqlGenCtx schemaCache metadata request + runQuery env userInfo httpMgr sqlGenCtx srcResolver + schemaCache metadata request pure $ HttpResponse r [] v1Alpha1GQHandler @@ -640,6 +648,7 @@ legacyQueryHandler , MonadBaseControl IO m , Tracing.MonadTrace m , MonadMetadataStorage m + , HasResolveCustomSource m ) => TableName -> T.Text -> Object -> Handler m (HttpResponse EncJSON) @@ -690,6 +699,7 @@ mkWaiApp , GH.MonadExecuteQuery m , EQ.MonadQueryInstrumentation m , MonadMetadataStorage m + , HasResolveCustomSource m ) => Env.Environment -- ^ Set of environment variables for reference in UIs @@ -800,6 +810,7 @@ httpApp , GH.MonadExecuteQuery m , EQ.MonadQueryInstrumentation m , MonadMetadataStorage m + , HasResolveCustomSource m ) => CorsConfig -> ServerCtx diff --git a/server/src-lib/Hasura/Server/Migrate.hs b/server/src-lib/Hasura/Server/Migrate.hs index 6d43ecded1ceb..f72786d1d2ffc 100644 --- a/server/src-lib/Hasura/Server/Migrate.hs +++ b/server/src-lib/Hasura/Server/Migrate.hs @@ -218,7 +218,7 @@ migrateMetadataStorageCatalog env connParams logger pgLogger databaseUrlM Just metadata -> pure (migrationResult, metadata) Nothing -> do let defaultSourceMetadata = - SourceMetadata defaultSource mempty mempty defaultSourceConfig + SourceMetadata defaultSource mempty mempty defaultSourceConfig {- TODO: -} [] defaultMetadata = emptyMetadata{_metaSources = HM.singleton defaultSource defaultSourceMetadata} liftTx $ setMetadataTx defaultMetadata diff --git a/server/src-lib/Hasura/Server/SchemaUpdate.hs b/server/src-lib/Hasura/Server/SchemaUpdate.hs index b88023d3cd92b..8b43930b174b9 100644 --- a/server/src-lib/Hasura/Server/SchemaUpdate.hs +++ b/server/src-lib/Hasura/Server/SchemaUpdate.hs @@ -20,6 +20,7 @@ import Hasura.Class import Hasura.Logging import Hasura.Prelude import Hasura.RQL.DDL.Schema (runCacheRWT) +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.Types import Hasura.RQL.Types.Run import Hasura.Server.App (SchemaCacheRef (..), updateStateRefs) @@ -129,17 +130,18 @@ startSchemaSyncListenerThread defPgSource logger instanceId = do startSchemaSyncProcessorThread :: (C.ForkableMonadIO m, MonadMetadataStorage m) => SQLGenCtx + -> ResolveCustomSource -> Logger Hasura -> HTTP.Manager -> SchemaSyncEventRef -> SchemaCacheRef -> InstanceId -> m Immortal.Thread -startSchemaSyncProcessorThread sqlGenCtx logger httpMgr +startSchemaSyncProcessorThread sqlGenCtx srcResolver logger httpMgr schemaSyncEventRef cacheRef instanceId = do -- Start processor thread processorThread <- C.forkImmortal "SchemeUpdate.processor" logger $ - processor sqlGenCtx logger httpMgr schemaSyncEventRef cacheRef instanceId + processor sqlGenCtx srcResolver logger httpMgr schemaSyncEventRef cacheRef instanceId logThreadStarted logger instanceId TTProcessor processorThread pure processorThread @@ -183,13 +185,14 @@ listener defPgSource logger schemaSyncEventRef = processor :: forall m void. (C.ForkableMonadIO m, MonadMetadataStorage m) => SQLGenCtx + -> ResolveCustomSource -> Logger Hasura -> HTTP.Manager -> SchemaSyncEventRef -> SchemaCacheRef -> InstanceId -> m void -processor sqlGenCtx logger httpMgr schemaSyncEventRef +processor sqlGenCtx srcResolver logger httpMgr schemaSyncEventRef cacheRef instanceId = -- Never exits forever $ do @@ -200,7 +203,7 @@ processor sqlGenCtx logger httpMgr schemaSyncEventRef Left e -> logError logger threadType $ TEPayloadParse $ qeError e Right (SchemaSyncEventProcessResult shouldReload invalidations) -> when shouldReload $ - refreshSchemaCache sqlGenCtx logger httpMgr cacheRef invalidations + refreshSchemaCache sqlGenCtx srcResolver logger httpMgr cacheRef invalidations threadType "schema cache reloaded" where -- checks if there is an event @@ -220,13 +223,14 @@ refreshSchemaCache , MonadBaseControl IO m ) => SQLGenCtx + -> ResolveCustomSource -> Logger Hasura -> HTTP.Manager -> SchemaCacheRef -> CacheInvalidations -> ThreadType -> T.Text -> m () -refreshSchemaCache sqlGenCtx logger httpManager cacheRef invalidations threadType msg = do +refreshSchemaCache sqlGenCtx srcResolver logger httpManager cacheRef invalidations threadType msg = do -- Reload schema cache from catalog resE <- runExceptT $ withRefUpdate $ do rebuildableCache <- fst <$> liftIO (readIORef $ _scrCache cacheRef) @@ -242,7 +246,7 @@ refreshSchemaCache sqlGenCtx logger httpManager cacheRef invalidations threadTyp Left e -> logError logger threadType $ TEQueryError e Right () -> logInfo logger threadType $ object ["message" .= msg] where - runCtx = RunCtx adminUserInfo httpManager sqlGenCtx + runCtx = RunCtx adminUserInfo httpManager sqlGenCtx srcResolver withRefUpdate action = withMVarMasked (_scrLock cacheRef) $ \() -> do diff --git a/server/src-test/Hasura/Server/MigrateSpec.hs b/server/src-test/Hasura/Server/MigrateSpec.hs index dadec1ddaf9c0..8f3a0795ed268 100644 --- a/server/src-test/Hasura/Server/MigrateSpec.hs +++ b/server/src-test/Hasura/Server/MigrateSpec.hs @@ -18,6 +18,7 @@ import qualified Database.PG.Query as Q import Hasura.RQL.DDL.Metadata (ClearMetadata (..), runClearMetadata) import Hasura.RQL.DDL.Schema +import Hasura.RQL.DDL.Schema.Source import Hasura.RQL.Types import Hasura.Server.API.PGDump import Hasura.Server.Init (DowngradeOptions (..)) @@ -41,7 +42,7 @@ instance (MonadBase IO m) => CacheRM (CacheRefT m) where askSchemaCache = CacheRefT (fmap lastBuiltSchemaCache . readMVar) instance (MonadIO m, MonadBaseControl IO m, MonadTx m, MonadMetadata m - , HasHttpManager m, HasSQLGenCtx m) => CacheRWM (CacheRefT m) where + , HasHttpManager m, HasSQLGenCtx m, HasResolveCustomSource m) => CacheRWM (CacheRefT m) where buildSchemaCacheWithOptions reason invalidations metadataModifier = CacheRefT $ flip modifyMVar \schemaCache -> do ((), cache, _) <- runCacheRWT schemaCache (buildSchemaCacheWithOptions reason invalidations metadataModifier) pure (cache, ())