generate role based schema for each role

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

@@ -31,6 +31,7 @@ import           Hasura.GraphQL.Schema.Introspect
 import           Hasura.GraphQL.Schema.Mutation
 import           Hasura.GraphQL.Schema.Select
 import           Hasura.GraphQL.Schema.Table
+import           Hasura.GraphQL.Schema.Remote           (buildRemoteParser)
 import           Hasura.RQL.DDL.Schema.Cache.Common
 import           Hasura.RQL.Types
 import           Hasura.Session
@@ -39,6 +40,8 @@ import           Hasura.SQL.Types
 -- | Whether the request is sent with `x-hasura-use-backend-only-permissions` set to `true`.
 data Scenario = Backend | Frontend deriving (Enum, Show, Eq)
 
+type RemoteSchemaCache = HashMap RemoteSchemaName (RemoteSchemaCtxWithPermissions, MetadataObject)
+
 buildGQLContext
   :: forall arr m
    . ( ArrowChoice arr
@@ -52,7 +55,7 @@ buildGQLContext
   => ( GraphQLQueryType
      , TableCache
      , FunctionCache
-     , HashMap RemoteSchemaName (RemoteSchemaCtxWithPermissions, MetadataObject)
+     , RemoteSchemaCache
      , ActionCache
      , NonObjectTypeMap
      )
@@ -65,9 +68,11 @@ buildGQLContext =
 
     -- Scroll down a few pages for the actual body...
 
-    let allRoles = Set.insert adminRoleName $
+    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)
 
         tableFilter    = not . isSystemDefined . _tciSystemDefined
         functionFilter = not . isSystemDefined . fiSystemDefined
@@ -151,29 +156,64 @@ buildGQLContext =
                   Just _  -> returnA -< (newSchemaName, rscParsed $ rscpContext newSchemaContext):okSchemas
               ) |) [] (Map.toList allRemoteSchemas)
 
+    -- TODO: I think this will need to change, we'll have to read the unauthenticated role from the server options
+    -- and then use the remote schema defined for that role!
     let unauthenticatedContext :: m GQLContext
         unauthenticatedContext = P.runSchemaT do
-          ucQueries   <- finalizeParser <$> unauthenticatedQueryWithIntrospection queryRemotes mutationRemotes
-          ucMutations <- fmap finalizeParser <$> unauthenticatedMutation mutationRemotes
+          ucQueries   <- finalizeParser <$> unauthenticatedQueryWithIntrospection adminQueryRemotes adminMutationRemotes
+          ucMutations <- fmap finalizeParser <$> unauthenticatedMutation adminMutationRemotes
           pure $ GQLContext ucQueries ucMutations
 
+        buildRoleBasedRemoteSchemaParser :: RoleName -> RemoteSchemaCache -> m [ParsedIntrospection]
+        buildRoleBasedRemoteSchemaParser role remoteSchemaCache = do
+          let remoteSchemaIntroInfos = map fst $ toList remoteSchemaCache
+          remoteSchemaPerms <-
+            flip traverse remoteSchemaIntroInfos $ \(RemoteSchemaCtxWithPermissions _ ctx perms) ->
+              case Map.lookup role perms of
+                Nothing -> return Nothing
+                Just introspectRes -> do
+                  (queryParsers, mutationParsers, subscriptionParsers) <-
+                     P.runSchemaT @m @(P.ParseT Identity) $ buildRemoteParser introspectRes $ rscInfo ctx
+                  return $ Just $ ParsedIntrospection queryParsers mutationParsers subscriptionParsers
+          return $ catMaybes remoteSchemaPerms
+
         -- | The 'query' type of the remotes. TODO: also expose mutation
         -- remotes. NOT TODO: subscriptions, as we do not yet aim to support
         -- these.
-        queryRemotes = concatMap (piQuery . snd) remotes
-        mutationRemotes = concatMap (concat . piMutation . snd) remotes
-        queryHasuraOrRelay = case queryType of
+        adminQueryRemotes = concatMap (piQuery . snd) remotes
+        adminMutationRemotes = concatMap (concat . piMutation . snd) remotes
+
+        queryRemotes
+          :: [ParsedIntrospection]
+          -> [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
+        queryRemotes = concatMap piQuery
+
+        mutationRemotes
+          :: [ParsedIntrospection]
+          -> [P.FieldParser (P.ParseT Identity) (RemoteSchemaInfo, G.Field G.NoFragments P.Variable)]
+        mutationRemotes = concatMap (concat . piMutation)
+
+        queryHasuraOrRelay (qRemotes, mRemotes) = case queryType of
           QueryHasura -> queryWithIntrospection (Set.fromMap $ validTables $> ())
-                         validFunctions queryRemotes mutationRemotes
+                         validFunctions qRemotes mRemotes
                          allActionInfos nonObjectCustomTypes
           QueryRelay  -> relayWithIntrospection (Set.fromMap $ validTables $> ()) validFunctions
 
         buildContextForRoleAndScenario :: RoleName -> Scenario -> m GQLContext
         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
+          let qRemotes = queryRemotes roleBasedRemoteSchemas
+              mRemotes = mutationRemotes roleBasedRemoteSchemas
           let gqlContext = GQLContext
-                <$> (finalizeParser <$> queryHasuraOrRelay)
-                <*> (fmap finalizeParser <$> mutation (Set.fromList $ Map.keys validTables) mutationRemotes
+                <$> (finalizeParser <$> queryHasuraOrRelay (qRemotes,mRemotes))
+                <*> (fmap finalizeParser <$> mutation (Set.fromList $ Map.keys validTables) adminMutationRemotes
                      allActionInfos nonObjectCustomTypes)
           flip runReaderT (roleName, validTables, scenario, QueryContext stringifyNum queryType queryRemotesMap) $
             P.runSchemaT gqlContext

server/src-lib/Hasura/RQL/DDL/Metadata.hs

@@ -28,7 +28,7 @@ import           Hasura.RQL.DDL.EventTrigger        (delEventTriggerFromCatalog,
 import           Hasura.RQL.DDL.Metadata.Types
 import           Hasura.RQL.DDL.Permission.Internal (dropPermFromCatalog)
 import           Hasura.RQL.DDL.RemoteSchema        (addRemoteSchemaToCatalog, fetchRemoteSchemas,
-                                                     removeRemoteSchemaFromCatalog)
+                                                     removeRemoteSchemaFromCatalog, dropRemoteSchemaPermFromCatalog)
 import           Hasura.RQL.DDL.ScheduledTrigger    (addCronTriggerToCatalog,
                                                      deleteCronTriggerFromCatalog)
 import           Hasura.RQL.DDL.Schema.Catalog      (saveTableToCatalog)
@@ -537,6 +537,7 @@ purgeMetadataObj = liftTx . \case
   MOTable qt                                 -> Schema.deleteTableFromCatalog qt
   MOFunction qf                              -> Schema.delFunctionFromCatalog qf
   MORemoteSchema rsn                         -> removeRemoteSchemaFromCatalog rsn
+  MORemoteSchemaPermissions rsName role      -> dropRemoteSchemaPermFromCatalog rsName role
   MOTableObj qt (MTORel rn _)                -> Relationship.delRelFromCatalog qt rn
   MOTableObj qt (MTOPerm rn pt)              -> dropPermFromCatalog qt rn pt
   MOTableObj _ (MTOTrigger trn)              -> delEventTriggerFromCatalog trn

server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs

@@ -12,6 +12,7 @@ module Hasura.RQL.DDL.RemoteSchema
   , addRemoteSchemaToCatalog
   , addRemoteSchemaPermissionsToCatalog
   , runAddRemoteSchemaPermissions
+  , dropRemoteSchemaPermFromCatalog
   ) where
 
 import           Control.Monad.Unique
@@ -34,6 +35,8 @@ import           Hasura.SQL.Types
 
 import qualified Data.Environment                  as Env
 
+import           Hasura.Session
+
 runAddRemoteSchema
   :: ( HasVersion
      , QErrM m
@@ -55,29 +58,25 @@ runAddRemoteSchema env q = do
     name = _arsqName q
 
 runAddRemoteSchemaPermissions
-  :: ( HasVersion
-     , QErrM m
+  :: ( QErrM m
      , CacheRWM m
      , MonadTx m
-     , MonadIO m
-     , MonadUnique m
-     , HasHttpManager m
      )
   => AddRemoteSchemaPermissions
   -> m EncJSON
 runAddRemoteSchemaPermissions q = do
   remoteSchemaMap <- scRemoteSchemas <$> askSchemaCache
   upstreamRemoteSchema <-
     onNothing (Map.lookup name remoteSchemaMap) $
-      throw400 NotExists "no such remote schema"
+      throw400 NotExists $ "remote schema " <> name <<> " doesn't exist"
   resolveRoleBasedRemoteSchema providedSchemaDoc $ irDoc $ rscIntro $ rscpContext upstreamRemoteSchema
   liftTx $ addRemoteSchemaPermissionsToCatalog q
---  buildSchemaCacheFor $ MORemoteSchema name
+  buildSchemaCacheFor $ MORemoteSchemaPermissions name role
   pure successMsg
   where
-    name = _arspRemoteSchema q
+    AddRemoteSchemaPermissions name role defn _ = q
 
-    providedSchemaDoc = _rspdSchema $ _arspDefinition q
+    providedSchemaDoc = _rspdSchema defn
 
 addRemoteSchemaP1
   :: (QErrM m, CacheRM m)
@@ -164,6 +163,13 @@ removeRemoteSchemaFromCatalog name =
       WHERE name = $1
   |] (Identity name) True
 
+dropRemoteSchemaPermFromCatalog :: RemoteSchemaName -> RoleName -> Q.TxE QErr ()
+dropRemoteSchemaPermFromCatalog name role =
+  Q.unitQE defaultTxErrorHandler [Q.sql|
+    DELETE FROM hdb_catalog.hdb_remote_schema_permission
+      WHERE remote_schema_name = $1 AND role_name = $2
+  |] (name, role) True
+
 fetchRemoteSchemas :: Q.TxE QErr [AddRemoteSchemaQuery]
 fetchRemoteSchemas =
   map fromRow <$> Q.listQE defaultTxErrorHandler

server/src-lib/Hasura/RQL/DDL/RemoteSchema/Validate.hs

@@ -6,7 +6,7 @@ import           Control.Monad.Validate
 
 import           Hasura.Prelude
 import           Hasura.SQL.Types
-import           Hasura.RQL.Types              hiding (GraphQLType)
+import           Hasura.RQL.Types              hiding (GraphQLType, defaultScalars)
 import           Hasura.Server.Utils           (englishList, duplicates)
 
 import qualified Data.HashMap.Strict           as Map
@@ -549,7 +549,7 @@ getSchemaDocIntrospection
   -> (G.Name, Maybe G.Name, Maybe G.Name)
   -> IntrospectionResult
 getSchemaDocIntrospection schemaDocTypeDefs (queryRoot, mutationRoot, subscriptionRoot) =
-  let scalarTypeDefs = map G.TypeDefinitionScalar scalars
+  let scalarTypeDefs = map G.TypeDefinitionScalar $ scalars <> defaultScalars
       objectTypeDefs = map G.TypeDefinitionObject objects
       unionTypeDefs = map G.TypeDefinitionUnion unions
       enumTypeDefs = map G.TypeDefinitionEnum enums
@@ -574,6 +574,9 @@ getSchemaDocIntrospection schemaDocTypeDefs (queryRoot, mutationRoot, subscripti
     SchemaDocumentTypeDefinitions scalars objects interfaces
                             unions enums inpObjs _ = schemaDocTypeDefs
 
+    defaultScalars = map (\n -> G.ScalarTypeDefinition Nothing n [])
+                         $ [intScalar, floatScalar, stringScalar, boolScalar, idScalar]
+
 -- | validateRemoteSchema accepts two arguments, the `SchemaDocument` of
 -- the role-based schema, that is provided by the user and the `SchemaIntrospection`
 -- of the upstream remote schema. This function, in turn calls the other validation

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

@@ -56,7 +56,6 @@ import           Hasura.RQL.DDL.Utils                     (clearHdbViews)
 import           Hasura.RQL.DDL.RemoteSchema.Validate     (resolveRoleBasedRemoteSchema)
 import           Hasura.RQL.Types
 import           Hasura.RQL.Types.Catalog
-import           Hasura.RQL.Types.SchemaCacheTypes        (RemoteSchemaPermObjId(..))
 import           Hasura.Server.Version                    (HasVersion)
 import           Hasura.SQL.Types
 
@@ -369,7 +368,7 @@ buildSchemaCacheRule env = proc (catalogMetadata, invalidationKeys) -> do
         buildRemoteSchemaPermission = proc (remoteSchemaCtx, remoteSchemaPerm) -> do
           let AddRemoteSchemaPermissions rsName roleName defn _ = remoteSchemaPerm
               metadataObject = mkRemoteSchemaPermissionMetadataObject remoteSchemaPerm
-              schemaObject = SORemoteSchemaObj rsName $ RemoteSchemaPermObjId roleName
+              schemaObject = SORemoteSchemaPermission rsName roleName
               upstreamSchemaIntrospection = irDoc $ rscIntro remoteSchemaCtx
               providedSchemaDoc = _rspdSchema defn
               addPermContext err = "in remote schema permission for role " <> roleName <<> ": " <> err

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

@@ -88,6 +88,13 @@ pruneDanglingDependents cache = fmap (M.filter (not . null)) . traverse do
         Left $ "function " <> functionName <<> " is not tracked"
       SORemoteSchema remoteSchemaName -> unless (remoteSchemaName `M.member` _boRemoteSchemas cache) $
         Left $ "remote schema " <> remoteSchemaName <<> " is not found"
+      SORemoteSchemaPermission remoteSchemaName roleName -> do
+        remoteSchema <-
+          onNothing (M.lookup remoteSchemaName $ _boRemoteSchemas cache)
+            $ Left $ "remote schema " <> remoteSchemaName <<> " is not found"
+        unless (roleName `M.member` (rscpPermissions $ fst remoteSchema)) $
+          Left $ "no permission defined on remote schema " <> remoteSchemaName
+                  <<> " for role " <>> roleName
       SOTableObj tableName tableObjectId -> do
         tableInfo <- resolveTable tableName
         case tableObjectId of

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

@@ -207,7 +207,7 @@ data RemoteSchemaCtxWithPermissions
 instance ToJSON RemoteSchemaCtxWithPermissions where
   toJSON (RemoteSchemaCtxWithPermissions name ctx _ ) =
     object $
-      [ "name" .= name
+      [ "name"    .= name
       , "context" .= ctx
       ]
 

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

@@ -28,17 +28,12 @@ data TableObjId
   deriving (Show, Eq, Generic)
 instance Hashable TableObjId
 
-data RemoteSchemaPermObjId =
-  RemoteSchemaPermObjId !RoleName
-  deriving (Show, Eq, Generic)
-instance Hashable RemoteSchemaPermObjId
-
 data SchemaObjId
   = SOTable !QualifiedTable
   | SOTableObj !QualifiedTable !TableObjId
   | SOFunction !QualifiedFunction
   | SORemoteSchema !RemoteSchemaName
-  | SORemoteSchemaObj !RemoteSchemaName !RemoteSchemaPermObjId
+  | SORemoteSchemaPermission !RemoteSchemaName !RoleName
   deriving (Eq, Generic)
 
 instance Hashable SchemaObjId
@@ -63,10 +58,10 @@ reportSchemaObj (SOTableObj tn (TORemoteRel rn)) =
   "remote relationship " <> qualObjectToText tn <> "." <> remoteRelationshipNameToText rn
 reportSchemaObj (SORemoteSchema remoteSchemaName) =
   "remote schema " <> unNonEmptyText (unRemoteSchemaName remoteSchemaName)
-reportSchemaObj (SORemoteSchemaObj remoteSchemaName (RemoteSchemaPermObjId roleName)) =
+reportSchemaObj (SORemoteSchemaPermission remoteSchemaName roleName) =
   "remote schema permission "
   <> unNonEmptyText (unRemoteSchemaName remoteSchemaName)
-  <> "." <> roleNameToTxt roleName
+  <> "." <>> roleName
 
 instance Show SchemaObjId where
   show soi = T.unpack $ reportSchemaObj soi

server/src-lib/Hasura/Session.hs

@@ -49,7 +49,7 @@ import qualified Network.HTTP.Types         as HTTP
 newtype RoleName
   = RoleName {getRoleTxt :: NonEmptyText}
   deriving ( Show, Eq, Ord, Hashable, FromJSONKey, ToJSONKey, FromJSON
-           , ToJSON, Q.FromCol, Q.ToPrepArg, Lift, Generic, Arbitrary, NFData, Cacheable )
+           , ToJSON, Q.FromCol, Q.ToPrepArg, Lift, Generic, Arbitrary, NFData, Cacheable)
 
 instance DQuote RoleName where
   dquoteTxt = roleNameToTxt