add feature flag to enable remote schema permissions

server/src-exec/Main.hs

@@ -44,17 +44,17 @@ runApp env (HGEOptionsG rci hgeCmd) =
   withVersion $$(getVersionFromEnvironment) $ case hgeCmd of
     HCServe serveOptions -> do
       (initCtx, initTime) <- initialiseCtx env hgeCmd rci
-      
+
       ekgStore <- liftIO do
         s <- EKG.newStore
         EKG.registerGcMetrics s
-        
+
         let getTimeMs :: IO Int64
             getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime
 
         EKG.registerCounter "ekg.server_timestamp_ms" getTimeMs s
         pure s
-        
+
       let shutdownApp = return ()
       -- Catches the SIGTERM signal and initiates a graceful shutdown.
       -- Graceful shutdown for regular HTTP requests is already implemented in
@@ -81,7 +81,8 @@ runApp env (HGEOptionsG rci hgeCmd) =
       (InitCtx{..}, _) <- initialiseCtx env hgeCmd rci
       queryBs <- liftIO BL.getContents
       let sqlGenCtx = SQLGenCtx False
-      res <- runAsAdmin _icPgPool sqlGenCtx _icHttpManager $ do
+          enableRSPermsCtx = EnableRemoteSchemaPermsCtx False
+      res <- runAsAdmin _icPgPool sqlGenCtx enableRSPermsCtx _icHttpManager  $ do
         schemaCache <- buildRebuildableSchemaCache env
         execQuery env queryBs
           & Tracing.runTraceTWithReporter Tracing.noReporter "execute"
@@ -93,8 +94,9 @@ runApp env (HGEOptionsG rci hgeCmd) =
     HCDowngrade opts -> do
       (InitCtx{..}, initTime) <- initialiseCtx env hgeCmd rci
       let sqlGenCtx = SQLGenCtx False
+          enableRSPermsCtx = EnableRemoteSchemaPermsCtx False
       res <- downgradeCatalog opts initTime
-             & runAsAdmin _icPgPool sqlGenCtx _icHttpManager
+             & runAsAdmin _icPgPool sqlGenCtx enableRSPermsCtx _icHttpManager
       either (printErrJExit DowngradeProcessError) (liftIO . print) res
 
     HCVersion -> liftIO $ putStrLn $ "Hasura GraphQL Engine: " ++ convertText currentVersion

server/src-lib/Hasura/App.hs

@@ -61,6 +61,7 @@ import           Hasura.RQL.Types                          (CacheRWM, Code (..),
                                                             HasSQLGenCtx, HasSystemDefined,
                                                             QErr (..), SQLGenCtx (..),
                                                             SchemaCache (..), UserInfoM,
+                                                            EnableRemoteSchemaPermsCtx(..),
                                                             buildSchemaCacheStrict, decodeValue,
                                                             throw400, withPathK)
 import           Hasura.RQL.Types.Run
@@ -199,7 +200,7 @@ initialiseCtx env hgeCmd rci = do
   instanceId <- liftIO generateInstanceId
   connInfo <- liftIO procConnInfo
   latch <- liftIO newShutdownLatch
-  (loggers, pool, sqlGenCtx) <- case hgeCmd of
+  (loggers, pool, sqlGenCtx, enableRSPermsCtx) <- case hgeCmd of
     -- for the @serve@ command generate a regular PG pool
     HCServe so@ServeOptions{..} -> do
       l@(Loggers _ logger pgLogger) <- mkLoggers soEnabledLogTypes soLogLevel
@@ -208,16 +209,17 @@ initialiseCtx env hgeCmd rci = do
       -- log postgres connection info
       unLogger logger $ connInfoToLog connInfo
       pool <- liftIO $ Q.initPGPool connInfo soConnParams pgLogger
-      pure (l, pool, SQLGenCtx soStringifyNum)
+      let remoteSchemaPermsCtx = EnableRemoteSchemaPermsCtx soEnableRemoteSchemaPermissions
+      pure (l, pool, SQLGenCtx soStringifyNum, remoteSchemaPermsCtx)
 
     -- for other commands generate a minimal PG pool
     _ -> do
       l@(Loggers _ _ pgLogger) <- mkLoggers defaultEnabledLogTypes LevelInfo
       pool <- getMinimalPool pgLogger connInfo
-      pure (l, pool, SQLGenCtx False)
+      pure (l, pool, SQLGenCtx False, EnableRemoteSchemaPermsCtx False)
 
   res <- flip onException (flushLogger (_lsLoggerCtx loggers)) $
-    migrateCatalogSchema env (_lsLogger loggers) pool httpManager sqlGenCtx
+    migrateCatalogSchema env (_lsLogger loggers) pool httpManager sqlGenCtx enableRSPermsCtx
   pure (InitCtx httpManager instanceId loggers connInfo pool latch res, initTime)
   where
     procConnInfo =
@@ -237,10 +239,11 @@ initialiseCtx env hgeCmd rci = do
 migrateCatalogSchema
   :: (HasVersion, MonadIO m)
   => Env.Environment -> Logger Hasura -> Q.PGPool -> HTTP.Manager -> SQLGenCtx
+  -> EnableRemoteSchemaPermsCtx
   -> m (RebuildableSchemaCache Run, Maybe UTCTime)
-migrateCatalogSchema env logger pool httpManager sqlGenCtx = do
+migrateCatalogSchema env logger pool httpManager sqlGenCtx enableRSPermsCtx = do
   let pgExecCtx = mkPGExecCtx Q.Serializable pool
-      adminRunCtx = RunCtx adminUserInfo httpManager sqlGenCtx
+      adminRunCtx = RunCtx adminUserInfo httpManager sqlGenCtx enableRSPermsCtx
   currentTime <- liftIO Clock.getCurrentTime
   initialiseResult <- runExceptT $ peelRun adminRunCtx pgExecCtx Q.ReadWrite Nothing $
     (,) <$> migrateCatalog env currentTime <*> liftTx fetchLastUpdate
@@ -330,6 +333,7 @@ runHGEServer env ServeOptions{..} InitCtx{..} pgExecCtx initTime shutdownApp pos
 #endif
 
   let sqlGenCtx = SQLGenCtx soStringifyNum
+      enableRSPermsCtx = EnableRemoteSchemaPermsCtx soEnableRemoteSchemaPermissions
       Loggers loggerCtx logger _ = _icLoggers
 
   authModeRes <- runExceptT $ setupAuthMode soAdminSecret soAuthHook soJwtSecret soUnAuthRole
@@ -363,6 +367,7 @@ runHGEServer env ServeOptions{..} InitCtx{..} pgExecCtx initTime shutdownApp pos
              postPollHook
              _icSchemaCache
              ekgStore
+             enableRSPermsCtx
 
   -- log inconsistent schema objects
   inconsObjs <- scInconsistentObjs <$> liftIO (getSCFromRef cacheRef)
@@ -371,7 +376,7 @@ runHGEServer env ServeOptions{..} InitCtx{..} pgExecCtx initTime shutdownApp pos
   -- start background threads for schema sync
   (schemaSyncListenerThread, schemaSyncProcessorThread) <-
     startSchemaSyncThreads sqlGenCtx _icPgPool logger _icHttpManager
-                           cacheRef _icInstanceId cacheInitTime
+                           cacheRef _icInstanceId cacheInitTime enableRSPermsCtx
 
   let
     maxEvThrds    = fromMaybe defaultMaxEventThreads soEventsHttpPoolSize
@@ -443,7 +448,7 @@ runHGEServer env ServeOptions{..} InitCtx{..} pgExecCtx initTime shutdownApp pos
 
   where
     -- | prepareScheduledEvents is a function to unlock all the scheduled trigger
-    -- events that are locked and unprocessed, which is called while hasura is 
+    -- events that are locked and unprocessed, which is called while hasura is
     -- started.
     --
     -- Locked and unprocessed events can occur in 2 ways
@@ -587,11 +592,12 @@ runAsAdmin
   :: (MonadIO m)
   => Q.PGPool
   -> SQLGenCtx
+  -> EnableRemoteSchemaPermsCtx
   -> HTTP.Manager
   -> Run a
   -> m (Either QErr a)
-runAsAdmin pool sqlGenCtx httpManager m = do
-  let runCtx = RunCtx adminUserInfo httpManager sqlGenCtx
+runAsAdmin pool sqlGenCtx enableRSPermsCtx httpManager m = do
+  let runCtx = RunCtx adminUserInfo httpManager sqlGenCtx enableRSPermsCtx
       pgCtx = mkPGExecCtx Q.Serializable pool
   runExceptT $ peelRun runCtx pgCtx Q.ReadWrite Nothing m
 

server/src-lib/Hasura/GraphQL/Schema.hs

@@ -51,6 +51,7 @@ buildGQLContext
      , MonadIO m
      , MonadUnique m
      , HasSQLGenCtx m
+     , HasEnableRemoteSchemaPermsCtx m
      )
   => ( GraphQLQueryType
      , TableCache
@@ -66,13 +67,14 @@ buildGQLContext
 buildGQLContext =
   proc (queryType, allTables, allFunctions, allRemoteSchemas, allActions, nonObjectCustomTypes) -> do
 
+    isEnabledRemoteSchemaPerms <- bindA -< enableRemoteSchemaPerms <$> askEnableRemoteSchemaPermsCtx
     -- Scroll down a few pages for the actual body...
-
     let remoteSchemasRoles = concatMap (Map.keys . _rscpPermissions . fst . snd) $ Map.toList allRemoteSchemas
         allRoles = Set.insert adminRoleName $
              (allTables ^.. folded.tiRolePermInfoMap.to Map.keys.folded)
           <> (allActionInfos ^.. folded.aiPermissions.to Map.keys.folded)
-          <> (Set.fromList remoteSchemasRoles)
+          -- include the new roles only if remote schema permissions are enabled
+          <> (Set.fromList $ (bool mempty remoteSchemasRoles $ isEnabledRemoteSchemaPerms))
 
         tableFilter    = not . isSystemDefined . _tciSystemDefined
         functionFilter = not . isSystemDefined . fiSystemDefined
@@ -205,12 +207,8 @@ buildGQLContext =
         buildContextForRoleAndScenario roleName scenario = do
           SQLGenCtx{ stringifyNum } <- askSQLGenCtx
           roleBasedRemoteSchemas <-
-            case roleName == adminRoleName of
-              -- The admin role will have full access to the remote schema, so
-              -- we just re-use the `ParsedIntrospection` we already have in the
-              -- `remotes` object
-              True  -> pure $ map snd remotes
-              False -> buildRoleBasedRemoteSchemaParser roleName allRemoteSchemas
+             if | (roleName == adminRoleName) || (not isEnabledRemoteSchemaPerms) -> pure $ map snd remotes
+                | otherwise -> buildRoleBasedRemoteSchemaParser roleName allRemoteSchemas
           let qRemotes = queryRemotes roleBasedRemoteSchemas
               mRemotes = mutationRemotes roleBasedRemoteSchemas
           let gqlContext = GQLContext

server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs

@@ -62,7 +62,14 @@ import           Hasura.SQL.Types
 import           Hasura.Session
 
 buildRebuildableSchemaCache
-  :: (HasVersion, MonadIO m, MonadUnique m, MonadTx m, HasHttpManager m, HasSQLGenCtx m)
+  :: ( HasVersion
+     , MonadIO m
+     , MonadUnique m
+     , MonadTx m
+     , HasHttpManager m
+     , HasSQLGenCtx m
+     , HasEnableRemoteSchemaPermsCtx m
+     )
   => Env.Environment
   -> m (RebuildableSchemaCache m)
 buildRebuildableSchemaCache env = do
@@ -117,7 +124,7 @@ buildSchemaCacheRule
   -- what we want!
   :: ( HasVersion, ArrowChoice arr, Inc.ArrowDistribute arr, Inc.ArrowCache m arr
      , MonadIO m, MonadUnique m, MonadTx m
-     , MonadReader BuildReason m, HasHttpManager m, HasSQLGenCtx m )
+     , MonadReader BuildReason m, HasHttpManager m, HasSQLGenCtx m, HasEnableRemoteSchemaPermsCtx m)
   => Env.Environment
   -> (CatalogMetadata, InvalidationKeys) `arr` SchemaCache
 buildSchemaCacheRule env = proc (catalogMetadata, invalidationKeys) -> do

server/src-lib/Hasura/RQL/Types.hs

@@ -9,6 +9,9 @@ module Hasura.RQL.Types
   , SQLGenCtx(..)
   , HasSQLGenCtx(..)
 
+  , EnableRemoteSchemaPermsCtx(..)
+  , HasEnableRemoteSchemaPermsCtx(..)
+
   , HasSystemDefined(..)
   , HasSystemDefinedT
   , runHasSystemDefinedT
@@ -151,6 +154,30 @@ instance (HasHttpManager m) => HasHttpManager (TraceT m) where
 -- instance (Monoid w, HasGCtxMap m) => HasGCtxMap (WriterT w m) where
 --   askGCtxMap = lift askGCtxMap
 
+newtype EnableRemoteSchemaPermsCtx
+  = EnableRemoteSchemaPermsCtx
+  { enableRemoteSchemaPerms :: Bool
+  } deriving (Show, Eq)
+
+class (Monad m) => HasEnableRemoteSchemaPermsCtx m where
+  askEnableRemoteSchemaPermsCtx :: m EnableRemoteSchemaPermsCtx
+
+instance (HasEnableRemoteSchemaPermsCtx m)
+         => HasEnableRemoteSchemaPermsCtx (ReaderT r m) where
+  askEnableRemoteSchemaPermsCtx = lift askEnableRemoteSchemaPermsCtx
+instance (HasEnableRemoteSchemaPermsCtx m)
+         => HasEnableRemoteSchemaPermsCtx (StateT s m) where
+  askEnableRemoteSchemaPermsCtx = lift askEnableRemoteSchemaPermsCtx
+instance (Monoid w, HasEnableRemoteSchemaPermsCtx m)
+         => HasEnableRemoteSchemaPermsCtx (WriterT w m) where
+  askEnableRemoteSchemaPermsCtx = lift askEnableRemoteSchemaPermsCtx
+instance (HasEnableRemoteSchemaPermsCtx m)
+         => HasEnableRemoteSchemaPermsCtx (TableCoreCacheRT m) where
+  askEnableRemoteSchemaPermsCtx = lift askEnableRemoteSchemaPermsCtx
+instance (HasEnableRemoteSchemaPermsCtx m)
+         => HasEnableRemoteSchemaPermsCtx (TraceT m) where
+  askEnableRemoteSchemaPermsCtx = lift askEnableRemoteSchemaPermsCtx
+
 newtype SQLGenCtx
   = SQLGenCtx
   { stringifyNum :: Bool

server/src-lib/Hasura/RQL/Types/Run.hs

@@ -20,9 +20,10 @@ import qualified Hasura.Tracing              as Tracing
 
 data RunCtx
   = RunCtx
-  { _rcUserInfo  :: !UserInfo
-  , _rcHttpMgr   :: !HTTP.Manager
-  , _rcSqlGenCtx :: !SQLGenCtx
+  { _rcUserInfo                   :: !UserInfo
+  , _rcHttpMgr                    :: !HTTP.Manager
+  , _rcSqlGenCtx                  :: !SQLGenCtx
+  , _rcEnableRemoteSchemaPermsCtx :: !EnableRemoteSchemaPermsCtx
   }
 
 newtype Run a
@@ -46,6 +47,9 @@ instance HasHttpManager Run where
 instance HasSQLGenCtx Run where
   askSQLGenCtx = asks _rcSqlGenCtx
 
+instance HasEnableRemoteSchemaPermsCtx Run where
+  askEnableRemoteSchemaPermsCtx = asks _rcEnableRemoteSchemaPermsCtx
+
 peelRun
   :: (MonadIO m)
   => RunCtx
@@ -54,5 +58,5 @@ peelRun
   -> Maybe Tracing.TraceContext
   -> Run a
   -> ExceptT QErr m a
-peelRun runCtx@(RunCtx userInfo _ _) pgExecCtx txAccess ctx (Run m) =
+peelRun runCtx@(RunCtx userInfo _ _ _) pgExecCtx txAccess ctx (Run m) =
   runLazyTx pgExecCtx txAccess $ maybe id withTraceContext ctx $ withUserInfo userInfo $ runReaderT m runCtx

server/src-lib/Hasura/Server/API/Query.hs

@@ -199,8 +199,9 @@ runQuery
   :: (HasVersion, MonadIO m, MonadError QErr m, Tracing.MonadTrace m)
   => Env.Environment -> PGExecCtx -> InstanceId
   -> UserInfo -> RebuildableSchemaCache Run -> HTTP.Manager
-  -> SQLGenCtx -> SystemDefined -> RQLQuery -> m (EncJSON, RebuildableSchemaCache Run)
-runQuery env pgExecCtx instanceId userInfo sc hMgr sqlGenCtx systemDefined query = do
+  -> SQLGenCtx -> EnableRemoteSchemaPermsCtx -> SystemDefined
+  -> RQLQuery -> m (EncJSON, RebuildableSchemaCache Run)
+runQuery env pgExecCtx instanceId userInfo sc hMgr sqlGenCtx enableRSPermsCtx systemDefined query = do
   accessMode <- getQueryAccessMode query
   traceCtx <- Tracing.currentContext
   resE <- runQueryM env query & Tracing.interpTraceT \x -> do
@@ -214,7 +215,7 @@ runQuery env pgExecCtx instanceId userInfo sc hMgr sqlGenCtx systemDefined query
       (\((js, meta), rsc, ci) -> (Right (js, rsc, ci), meta)) a)
   either throwError withReload resE
   where
-    runCtx = RunCtx userInfo hMgr sqlGenCtx
+    runCtx = RunCtx userInfo hMgr sqlGenCtx enableRSPermsCtx
     withReload (result, updatedCache, invalidations) = do
       when (queryModifiesSchemaCache query) $ do
         e <- liftIO $ runExceptT $ runLazyTx pgExecCtx Q.ReadWrite $ liftTx $

server/src-lib/Hasura/Server/App.hs

@@ -110,6 +110,7 @@ data ServerCtx
   , scEkgStore                     :: !EKG.Store
   , scResponseInternalErrorsConfig :: !ResponseInternalErrorsConfig
   , scEnvironment                  :: !Env.Environment
+  , scEnableRemoteSchemaPermsCtx   :: !EnableRemoteSchemaPermsCtx
   }
 
 data HandlerCtx
@@ -352,20 +353,20 @@ v1QueryHandler query = do
   authorizeMetadataApi query userInfo
   scRef  <- asks (scCacheRef . hcServerCtx)
   logger <- asks (scLogger . hcServerCtx)
-  res    <- bool (fst <$> dbAction) (withSCUpdate scRef logger dbAction) $ queryModifiesSchemaCache query
+  res    <- bool (fst <$> action) (withSCUpdate scRef logger action) $ queryModifiesSchemaCache query
   return $ HttpResponse res []
   where
-    -- Hit postgres
-    dbAction = do
-      userInfo    <- asks hcUser
-      scRef       <- asks (scCacheRef . hcServerCtx)
-      schemaCache <- fmap fst $ liftIO $ readIORef $ _scrCache scRef
-      httpMgr     <- asks (scManager . hcServerCtx)
-      sqlGenCtx   <- asks (scSQLGenCtx . hcServerCtx)
-      pgExecCtx   <- asks (scPGExecCtx . hcServerCtx)
-      instanceId  <- asks (scInstanceId . hcServerCtx)
-      env         <- asks (scEnvironment . hcServerCtx)
-      runQuery env pgExecCtx instanceId userInfo schemaCache httpMgr sqlGenCtx (SystemDefined False) query
+    action = do
+      userInfo         <- asks hcUser
+      scRef            <- asks (scCacheRef . hcServerCtx)
+      schemaCache      <- fmap fst $ liftIO $ readIORef $ _scrCache scRef
+      httpMgr          <- asks (scManager . hcServerCtx)
+      sqlGenCtx        <- asks (scSQLGenCtx . hcServerCtx)
+      pgExecCtx        <- asks (scPGExecCtx . hcServerCtx)
+      instanceId       <- asks (scInstanceId . hcServerCtx)
+      env              <- asks (scEnvironment . hcServerCtx)
+      enableRSPermsCtx <- asks (scEnableRemoteSchemaPermsCtx . hcServerCtx)
+      runQuery env pgExecCtx instanceId userInfo schemaCache httpMgr sqlGenCtx enableRSPermsCtx (SystemDefined False) query
 
 v1Alpha1GQHandler
   :: ( HasVersion
@@ -603,9 +604,10 @@ mkWaiApp
   -> Maybe EL.LiveQueryPostPollHook
   -> (RebuildableSchemaCache Run, Maybe UTCTime)
   -> EKG.Store
+  -> EnableRemoteSchemaPermsCtx
   -> m HasuraApp
 mkWaiApp env isoLevel logger sqlGenCtx enableAL pool pgExecCtxCustom ci httpManager mode corsCfg enableConsole consoleAssetsDir
-         enableTelemetry instanceId apis lqOpts _ {- planCacheOptions -} responseErrorsConfig liveQueryHook (schemaCache, cacheBuiltTime) ekgStore  = do
+         enableTelemetry instanceId apis lqOpts _ {- planCacheOptions -} responseErrorsConfig liveQueryHook (schemaCache, cacheBuiltTime) ekgStore enableRSPermsCtx = do
 
     -- See Note [Temporarily disabling query plan caching]
     -- (planCache, schemaCacheRef) <- initialiseCache
@@ -636,6 +638,7 @@ mkWaiApp env isoLevel logger sqlGenCtx enableAL pool pgExecCtxCustom ci httpMana
                     , scEkgStore        =  ekgStore
                     , scEnvironment     =  env
                     , scResponseInternalErrorsConfig = responseErrorsConfig
+                    , scEnableRemoteSchemaPermsCtx = enableRSPermsCtx
                     }
 
     spockApp <- liftWithStateless $ \lowerIO ->