chore(server): permissions for inline logical models

PR-URL: hasura/graphql-engine-mono#9835
GitOrigin-RevId: b36a4d5a8e0d4156a2d26803c7d046570f7afefa

server/graphql-engine.cabal

@@ -726,6 +726,7 @@ library
                      , Hasura.GC
 
                      , Hasura.LogicalModelResolver.Codec
+                     , Hasura.LogicalModelResolver.Lenses
                      , Hasura.LogicalModelResolver.Metadata
                      , Hasura.LogicalModelResolver.Schema
                      , Hasura.LogicalModelResolver.Types

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

@@ -82,7 +82,7 @@ import Hasura.GraphQL.Schema.Parser qualified as P
 import Hasura.GraphQL.Schema.Typename
 import Hasura.LogicalModel.Cache (LogicalModelInfo (_lmiPermissions))
 import Hasura.LogicalModel.Types (LogicalModelName)
-import Hasura.NativeQuery.Cache (NativeQueryCache, NativeQueryInfo)
+import Hasura.NativeQuery.Cache (NativeQueryCache, NativeQueryInfo (..))
 import Hasura.NativeQuery.Types (NativeQueryName)
 import Hasura.Prelude
 import Hasura.RQL.IR qualified as IR
@@ -348,7 +348,10 @@ getTableRoles bsi = AB.dispatchAnyBackend @Backend bsi go
 getLogicalModelRoles :: BackendSourceInfo -> [RoleName]
 getLogicalModelRoles bsi = AB.dispatchAnyBackend @Backend bsi go
   where
-    go si = HashMap.keys . _lmiPermissions =<< HashMap.elems (_siLogicalModels si)
+    go si =
+      let namedLogicalModelRoles = HashMap.keys . _lmiPermissions =<< HashMap.elems (_siLogicalModels si)
+          inlineLogicalModelRoles = HashMap.keys . _lmiPermissions . _nqiReturns =<< HashMap.elems (_siNativeQueries si)
+       in namedLogicalModelRoles <> inlineLogicalModelRoles
 
 askScalarTypeParsingContext ::
   forall b r m.

server/src-lib/Hasura/LogicalModel/API.hs

@@ -27,7 +27,10 @@ import Hasura.Base.Error
 import Hasura.EncJSON
 import Hasura.LogicalModel.Lenses (lmmSelectPermissions)
 import Hasura.LogicalModel.Metadata (LogicalModelMetadata (..))
-import Hasura.LogicalModel.Types (LogicalModelField, LogicalModelName, logicalModelFieldMapCodec)
+import Hasura.LogicalModel.Types (LogicalModelField, LogicalModelLocation (..), LogicalModelName, logicalModelFieldMapCodec)
+import Hasura.LogicalModelResolver.Lenses
+import Hasura.NativeQuery.API (assertNativeQueryExists)
+import Hasura.NativeQuery.Lenses (nqmReturns)
 import Hasura.Prelude
 import Hasura.RQL.Types.Backend (Backend (..))
 import Hasura.RQL.Types.BackendTag (backendPrefix, backendTag, reify)
@@ -230,12 +233,22 @@ execUntrackLogicalModel q metadata = do
     source = utlmSource q
     fieldName = utlmName q
 
+-- type for the `type` field in permissions
+data LogicalModelSource
+  = LMLogicalModel
+  | LMNativeQuery
+
+instance FromJSON LogicalModelSource where
+  parseJSON (String "logical_model") = pure LMLogicalModel
+  parseJSON (String "native_query") = pure LMNativeQuery
+  parseJSON _ = fail "Expected string"
+
 -- | A permission for logical models is tied to a specific name and
 -- source. This wrapper adds both of those things to the JSON object that
 -- describes the permission.
 data CreateLogicalModelPermission a (b :: BackendType) = CreateLogicalModelPermission
   { clmpSource :: SourceName,
-    clmpName :: LogicalModelName,
+    clmpLocation :: LogicalModelLocation,
     clmpInfo :: PermDef b a
   }
   deriving stock (Generic)
@@ -246,7 +259,12 @@ instance
   where
   parseJSON = withObject "CreateLogicalModelPermission" \obj -> do
     clmpSource <- obj .:? "source" .!= defaultSource
-    clmpName <- obj .: "name"
+    lmType <- obj .:? "type" .!= LMLogicalModel
+
+    clmpLocation <- case lmType of
+      LMLogicalModel -> LMLLogicalModel <$> obj .: "name"
+      LMNativeQuery -> LMLNativeQuery <$> obj .: "name"
+
     clmpInfo <- parseJSON (Object obj)
 
     pure CreateLogicalModelPermission {..}
@@ -258,35 +276,60 @@ runCreateSelectLogicalModelPermission ::
   m EncJSON
 runCreateSelectLogicalModelPermission CreateLogicalModelPermission {..} = do
   metadata <- getMetadata
-  assertLogicalModelExists @b clmpSource clmpName metadata
-
-  let metadataObj :: MetadataObjId
-      metadataObj =
-        MOSourceObjId clmpSource
-          $ AB.mkAnyBackend
-          $ SMOLogicalModel @b clmpName
 
-  buildSchemaCacheFor metadataObj
-    $ MetadataModifier
-    $ logicalModelMetadataSetter @b clmpSource clmpName
-    . lmmSelectPermissions
-    %~ InsOrdHashMap.insert (_pdRole clmpInfo) clmpInfo
+  case clmpLocation of
+    LMLNativeQuery nativeQueryName -> do
+      assertNativeQueryExists @b clmpSource nativeQueryName metadata
+
+      let metadataObj :: MetadataObjId
+          metadataObj =
+            MOSourceObjId clmpSource
+              $ AB.mkAnyBackend
+              $ SMONativeQuery @b nativeQueryName
+
+      buildSchemaCacheFor metadataObj
+        $ MetadataModifier
+        $ nativeQueryMetadataSetter @b clmpSource nativeQueryName
+        . nqmReturns
+        . _LMIInlineLogicalModel
+        . ilmmSelectPermissions
+        %~ InsOrdHashMap.insert (_pdRole clmpInfo) clmpInfo
+    LMLLogicalModel logicalModelName -> do
+      assertLogicalModelExists @b clmpSource logicalModelName metadata
+
+      let metadataObj :: MetadataObjId
+          metadataObj =
+            MOSourceObjId clmpSource
+              $ AB.mkAnyBackend
+              $ SMOLogicalModel @b logicalModelName
+
+      buildSchemaCacheFor metadataObj
+        $ MetadataModifier
+        $ logicalModelMetadataSetter @b clmpSource logicalModelName
+        . lmmSelectPermissions
+        %~ InsOrdHashMap.insert (_pdRole clmpInfo) clmpInfo
 
   pure successMsg
 
 -- | To drop a permission, we need to know the source and name of
 -- the logical model, as well as the role whose permission we want to drop.
 data DropLogicalModelPermission (b :: BackendType) = DropLogicalModelPermission
   { dlmpSource :: SourceName,
-    dlmpName :: LogicalModelName,
+    dlmpLocation :: LogicalModelLocation,
     dlmpRole :: RoleName
   }
   deriving stock (Generic)
 
 instance FromJSON (DropLogicalModelPermission b) where
   parseJSON = withObject "DropLogicalModelPermission" \obj -> do
     dlmpSource <- obj .:? "source" .!= defaultSource
-    dlmpName <- obj .: "name"
+
+    lmType <- obj .:? "type" .!= LMLogicalModel
+
+    dlmpLocation <- case lmType of
+      LMLogicalModel -> LMLLogicalModel <$> obj .: "name"
+      LMNativeQuery -> LMLNativeQuery <$> obj .: "name"
+
     dlmpRole <- obj .: "role"
 
     pure DropLogicalModelPermission {..}
@@ -298,19 +341,37 @@ runDropSelectLogicalModelPermission ::
   m EncJSON
 runDropSelectLogicalModelPermission DropLogicalModelPermission {..} = do
   metadata <- getMetadata
-  assertLogicalModelExists @b dlmpSource dlmpName metadata
-
-  let metadataObj :: MetadataObjId
-      metadataObj =
-        MOSourceObjId dlmpSource
-          $ AB.mkAnyBackend
-          $ SMOLogicalModel @b dlmpName
-
-  buildSchemaCacheFor metadataObj
-    $ MetadataModifier
-    $ logicalModelMetadataSetter @b dlmpSource dlmpName
-    . lmmSelectPermissions
-    %~ InsOrdHashMap.delete dlmpRole
+  case dlmpLocation of
+    LMLNativeQuery nativeQueryName -> do
+      assertNativeQueryExists @b dlmpSource nativeQueryName metadata
+
+      let metadataObj :: MetadataObjId
+          metadataObj =
+            MOSourceObjId dlmpSource
+              $ AB.mkAnyBackend
+              $ SMONativeQuery @b nativeQueryName
+
+      buildSchemaCacheFor metadataObj
+        $ MetadataModifier
+        $ nativeQueryMetadataSetter @b dlmpSource nativeQueryName
+        . nqmReturns
+        . _LMIInlineLogicalModel
+        . ilmmSelectPermissions
+        %~ InsOrdHashMap.delete dlmpRole
+    LMLLogicalModel logicalModelName -> do
+      assertLogicalModelExists @b dlmpSource logicalModelName metadata
+
+      let metadataObj :: MetadataObjId
+          metadataObj =
+            MOSourceObjId dlmpSource
+              $ AB.mkAnyBackend
+              $ SMOLogicalModel @b logicalModelName
+
+      buildSchemaCacheFor metadataObj
+        $ MetadataModifier
+        $ logicalModelMetadataSetter @b dlmpSource logicalModelName
+        . lmmSelectPermissions
+        %~ InsOrdHashMap.delete dlmpRole
 
   pure successMsg
 

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

@@ -9,6 +9,7 @@ module Hasura.LogicalModel.Types
     LogicalModelTypeArray (..),
     LogicalModelTypeReference (..),
     logicalModelFieldMapCodec,
+    LogicalModelLocation (..),
   )
 where
 
@@ -19,8 +20,9 @@ import Autodocodec
 import Autodocodec qualified as AC
 import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, Value)
 import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
-import Data.Text.Extended (ToTxt)
+import Data.Text.Extended (ToTxt (..))
 import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
+import Hasura.NativeQuery.Types (NativeQueryName)
 import Hasura.Prelude hiding (first)
 import Hasura.RQL.Types.Backend (Backend (..))
 import Hasura.RQL.Types.BackendTag (backendPrefix)
@@ -317,3 +319,14 @@ logicalModelFieldMapCodec =
     ( fmap snd . InsOrdHashMap.toList
     )
     (AC.codec @[LogicalModelField b])
+
+-- when we are talking about permissions, they might be attached directly to a
+-- Native Query or similar
+data LogicalModelLocation
+  = LMLLogicalModel LogicalModelName
+  | LMLNativeQuery NativeQueryName
+  deriving (Eq, Ord, Show, Generic, Hashable)
+
+instance ToTxt LogicalModelLocation where
+  toTxt (LMLLogicalModel lmn) = toTxt lmn
+  toTxt (LMLNativeQuery nqn) = toTxt nqn

server/src-lib/Hasura/LogicalModelResolver/Lenses.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Hasura.LogicalModelResolver.Lenses
+  ( ilmmFields,
+    ilmmSelectPermissions,
+    _LMIInlineLogicalModel,
+    _LMILogicalModelName,
+  )
+where
+
+import Control.Lens (makeLenses, makePrisms)
+import Hasura.LogicalModelResolver.Metadata (InlineLogicalModelMetadata, LogicalModelIdentifier)
+
+makeLenses ''InlineLogicalModelMetadata
+makePrisms ''LogicalModelIdentifier

server/src-lib/Hasura/NativeQuery/API.hs

@@ -9,6 +9,7 @@ module Hasura.NativeQuery.API
     execTrackNativeQuery,
     execUntrackNativeQuery,
     dropNativeQueryInMetadata,
+    assertNativeQueryExists,
     module Hasura.NativeQuery.Types,
   )
 where

server/src-lib/Hasura/NativeQuery/Metadata.hs

@@ -10,12 +10,14 @@ module Hasura.NativeQuery.Metadata
     InterpolatedQuery (..),
     parseInterpolatedQuery,
     module Hasura.NativeQuery.Types,
+    WithNativeQuery (..),
   )
 where
 
 import Autodocodec
 import Autodocodec qualified as AC
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON (parseJSON), ToJSON, (.!=), (.:), (.:?))
+import Data.Aeson qualified as J
 import Data.HashMap.Strict.InsOrd.Autodocodec (sortedElemsCodec)
 import Data.Text.Extended qualified as T
 import Hasura.LogicalModelResolver.Metadata (LogicalModelIdentifier)
@@ -25,7 +27,7 @@ import Hasura.Prelude hiding (first)
 import Hasura.RQL.Types.Backend
 import Hasura.RQL.Types.BackendTag (backendPrefix)
 import Hasura.RQL.Types.BackendType
-import Hasura.RQL.Types.Common (RelName)
+import Hasura.RQL.Types.Common (RelName, SourceName, ToAesonPairs (toAesonPairs), defaultSource)
 import Hasura.RQL.Types.Relationships.Local (RelDef (..), RelManualNativeQueryConfig (..))
 
 -- | copy pasta'd from Hasura.RQL.Types.Metadata.Common, forgive me Padre i did
@@ -94,3 +96,27 @@ deriving via
   (Autodocodec (NativeQueryMetadata b))
   instance
     (Backend b) => (ToJSON (NativeQueryMetadata b))
+
+-- | A wrapper to tie something to a particular native query. Specifically, it
+-- assumes the underlying '_wlmInfo' is represented as an object, and adds two
+-- keys to that object: @source@ and @root_field_name@.
+data WithNativeQuery a = WithNativeQuery
+  { _wnqSource :: SourceName,
+    _wnqName :: NativeQueryName,
+    _wnqInfo :: a
+  }
+  deriving stock (Eq, Show)
+
+-- | something to note here: if the `a` contains a `name` or `source` key then
+-- this won't work anymore.
+instance (FromJSON a) => FromJSON (WithNativeQuery a) where
+  parseJSON = J.withObject "NativeQuery" \obj -> do
+    _wnqSource <- obj .:? "source" .!= defaultSource
+    _wnqName <- obj .: "name"
+    _wnqInfo <- J.parseJSON (J.Object obj)
+
+    pure WithNativeQuery {..}
+
+instance (ToAesonPairs a) => ToJSON (WithNativeQuery a) where
+  toJSON (WithNativeQuery source name info) =
+    J.object $ ("source", J.toJSON source) : ("name", J.toJSON name) : toAesonPairs info

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

@@ -44,8 +44,10 @@ import Hasura.Eventing.Backend (BackendEventTrigger (..))
 import Hasura.Function.API
 import Hasura.Logging qualified as HL
 import Hasura.LogicalModel.API
+import Hasura.LogicalModelResolver.Lenses (_LMIInlineLogicalModel)
 import Hasura.Metadata.Class
 import Hasura.NativeQuery.API
+import Hasura.NativeQuery.Lenses (nqmReturns)
 import Hasura.Prelude hiding (first)
 import Hasura.RQL.DDL.Action
 import Hasura.RQL.DDL.ApiLimit
@@ -723,16 +725,24 @@ purgeMetadataObj = \case
           $ nativeQueryMetadataSetter @b source nativeQueryName
           %~ case nativeQueryMetadataObjId of
             NQMORel rn _ -> dropNativeQueryRelationshipInMetadata rn
-            NQMOReferencedLogicalModel _ -> id
       SMOStoredProcedure sp -> dropStoredProcedureInMetadata @b source sp
       SMOLogicalModel lm -> dropLogicalModelInMetadata @b source lm
-      SMOLogicalModelObj logicalModelName logicalModelMetadataObjId ->
+      SMOLogicalModelObj (LMLLogicalModel logicalModelName) logicalModelMetadataObjId ->
         MetadataModifier
           $ logicalModelMetadataSetter @b source logicalModelName
           %~ case logicalModelMetadataObjId of
             LMMOPerm roleName permType ->
               dropLogicalModelPermissionInMetadata roleName permType
             LMMOReferencedLogicalModel _ -> id
+      SMOLogicalModelObj (LMLNativeQuery nativeQueryName) logicalModelMetadataObjId ->
+        MetadataModifier
+          $ nativeQueryMetadataSetter @b source nativeQueryName
+          . nqmReturns
+          . _LMIInlineLogicalModel
+          %~ case logicalModelMetadataObjId of
+            LMMOPerm roleName permType ->
+              dropInlineLogicalModelPermissionInMetadata roleName permType
+            LMMOReferencedLogicalModel _ -> id
       SMOTableObj qt tableObj ->
         MetadataModifier
           $ tableMetadataSetter @b source qt