server: fix mutation functions not being exposed to admin when functi…

…on permissions are inferred GitOrigin-RevId: 7d80313
etrepum · Feb 1, 2021 · 94a886e · 94a886e
1 parent df19b7d
commit 94a886e
Show file tree

Hide file tree

Showing 4 changed files with 55 additions and 35 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,14 @@
 
 ## Next release
 
+### Bug fixes and improvements
+
+(Add entries here in the order of: server, console, cli, docs, others)
+
+- server: fix issue of not exposing mutation functions to the admin role when function permissions are inferred (fix #6503)
+
+## v1.4.0-alpha.1
+
 ### REST Endpoints
 
 The RESTified GraphQL Endpoints API allows for the use of a REST interface to saved GraphQL queries and mutations.

diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs
@@ -453,9 +453,11 @@ buildQueryFields sourceName sourceConfig tables (takeExposedAs FEAQuery id -> fu
         functionName = _fiName function
     selectPerms <- lift $ tableSelectPermissions targetTable
     perms <- hoistMaybe selectPerms
-    when (functionPermsCtx == FunctionPermissionsManual) $
-      -- see Note [Function Permissions]
-      guard $ roleName == adminRoleName || roleName `elem` (_fiPermissions function)
+    -- see Note [Function Permissions]
+    guard
+      $ roleName == adminRoleName
+      || roleName `elem` (_fiPermissions function)
+      || functionPermsCtx == FunctionPermissionsInferred
     displayName <- functionGraphQLName @b functionName `onLeft` throwError
     let functionDesc = G.Description $ "execute function " <> functionName <<> " which returns " <>> targetTable
         aggName = displayName <> $$(G.litName "_aggregate")
@@ -770,33 +772,30 @@ buildMutationParser
 buildMutationParser allRemotes allActions nonObjectCustomTypes
     (takeExposedAs FEAMutation fst -> mutationFunctions) pgMutationFields = do
   roleName <- askRoleName
-  functionPermsCtx <- asks $ qcFunctionPermsContext . getter
    -- NOTE: this is basically copied from functionSelectExpParsers body
   functionMutationExpParsers <-
-    case functionPermsCtx of
+    for mutationFunctions \(function@FunctionInfo{..}, (sourceName, sourceConfig)) -> runMaybeT do
+      selectPerms <- lift $ tableSelectPermissions _fiReturnType
+      -- A function exposed as mutation must have a function permission
+      -- configured for the role. See Note [Function Permissions]
+      guard $
       -- when function permissions are inferred, we don't expose the
-      -- mutation functions. See Note [Function Permissions]
-      FunctionPermissionsInferred -> pure []
-      FunctionPermissionsManual ->
-        for mutationFunctions \(function@FunctionInfo{..}, (sourceName, sourceConfig)) -> runMaybeT do
-          selectPerms <- lift $ tableSelectPermissions _fiReturnType
-          -- A function exposed as mutation must have a function permission
-          -- configured for the role. See Note [Function Permissions]
-          guard $ roleName == adminRoleName || roleName `elem` _fiPermissions
-          perms <- hoistMaybe selectPerms
-          displayName <- PG.qualifiedObjectToName _fiName
-          let functionDesc = G.Description $
-                "execute VOLATILE function " <> _fiName <<> " which returns " <>> _fiReturnType
-              asDbRootField =
-                let pgExecCtx = PG._pscExecCtx sourceConfig
-                in RFDB sourceName pgExecCtx
-
-          catMaybes <$> sequenceA
-            [ requiredFieldParser (asDbRootField . MDBFunction) $
-                lift $ selectFunction function displayName (Just functionDesc) perms
-            -- FWIW: The equivalent of this is possible for mutations; do we want that?:
-            -- , mapMaybeFieldParser (asDbRootField . QDBAggregation) $ selectFunctionAggregate function aggName     (Just aggDesc)      perms
-            ]
+      -- mutation functions for non-admin roles. See Note [Function Permissions]
+        roleName == adminRoleName || roleName `elem` _fiPermissions
+      perms <- hoistMaybe selectPerms
+      displayName <- PG.qualifiedObjectToName _fiName
+      let functionDesc = G.Description $
+            "execute VOLATILE function " <> _fiName <<> " which returns " <>> _fiReturnType
+          asDbRootField =
+            let pgExecCtx = PG._pscExecCtx sourceConfig
+            in RFDB sourceName pgExecCtx
+
+      catMaybes <$> sequenceA
+        [ requiredFieldParser (asDbRootField . MDBFunction) $
+            lift $ selectFunction function displayName (Just functionDesc) perms
+        -- FWIW: The equivalent of this is possible for mutations; do we want that?:
+        -- , mapMaybeFieldParser (asDbRootField . QDBAggregation) $ selectFunctionAggregate function aggName     (Just aggDesc)      perms
+        ]
 
   actionParsers <- for allActions $ \actionInfo ->
     case _adType (_aiDefinition actionInfo) of

diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs
@@ -237,6 +237,8 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
       tableRawInfos <- buildTableCache -< ( source, sourceConfig, pgTables
                                           , tableInputs, metadataInvalidationKey
                                           )
+      -- function permissions context
+      functionPermsCtx <- bindA -< _sccFunctionPermsCtx <$> askServerConfigCtx
 
       -- relationships and computed fields
       let nonColumnsByTable = mapFromL _nctiTable nonColumnInputs
@@ -260,17 +262,21 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
 
       -- sql functions
       functionCache <- (mapFromL _fmFunction (OMap.elems functions) >- returnA)
-        >-> (| Inc.keyed (\_ (FunctionMetadata qf config funcPermissions) -> do
+        >-> (| Inc.keyed (\_ (FunctionMetadata qf config rawFuncPermissions) -> do
                  let systemDefined = SystemDefined False
                      definition = toJSON $ TrackFunction qf
                      metadataObject = MetadataObject (MOSourceObjId source $ SMOFunction qf) definition
                      schemaObject = SOSourceObj source $ SOIFunction qf
                      addFunctionContext e = "in function " <> qf <<> ": " <> e
+                     functionPermissions =
+                       case functionPermsCtx of
+                         FunctionPermissionsInferred -> []
+                         FunctionPermissionsManual   -> rawFuncPermissions
                  (| withRecordInconsistency (
                     (| modifyErrA (do
                          let funcDefs = fromMaybe [] $ M.lookup qf pgFunctions
                          rawfi <- bindErrorA -< handleMultipleFunctions qf funcDefs
-                         (fi, dep) <- bindErrorA -< mkFunctionInfo source qf systemDefined config funcPermissions rawfi
+                         (fi, dep) <- bindErrorA -< mkFunctionInfo source qf systemDefined config functionPermissions rawfi
                          recordDependencies -< (metadataObject, schemaObject, [dep])
                          returnA -< fi)
                     |) addFunctionContext)
@@ -396,10 +402,17 @@ buildSchemaCacheRule env = proc (metadata, invalidationKeys) -> do
       -> EndpointMetadata QueryReference
       -> m (EndpointMetadata GQLQueryWithText)
     resolveEndpoint collections = traverse $ \(QueryReference collName queryName) -> do
-      collection <- maybe (throw400 NotExists $ "collection with name " <> toTxt collName <> " does not exist") pure $
-                      OMap.lookup collName collections
-      listedQuery <- maybe (throw400 NotExists $ "query with name " <> toTxt queryName <> " does not exist in collection " <> toTxt collName) pure $
-                       find ((== queryName) . _lqName) (_cdQueries (_ccDefinition collection))
+      collection <-
+        onNothing
+          (OMap.lookup collName collections)
+          (throw400 NotExists $ "collection with name " <> toTxt collName <> " does not exist")
+      listedQuery <-
+        flip onNothing
+               (throw400 NotExists
+                $ "query with name "
+                <> toTxt queryName
+                <> " does not exist in collection " <> toTxt collName)
+               $ find ((== queryName) . _lqName) (_cdQueries (_ccDefinition collection))
       pure (_lqQuery listedQuery)
 
     mkEventTriggerMetadataObject (_, source, _, table, eventTriggerConf) =

diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs
@@ -242,8 +242,8 @@ instance FromJSON UnTrackFunction where
   parseJSON v = withSource <|> withoutSource
     where
       withoutSource = UnTrackFunction <$> parseJSON v <*> pure defaultSource
-      withSource = flip (withObject "Object") v \o ->
-                   UnTrackFunction <$> o .: "table"
+      withSource = flip (withObject "UnTrackFunction") v \o ->
+                   UnTrackFunction <$> o .: "function"
                                    <*> o .:? "source" .!= defaultSource
 
 askPGFunctionInfo