mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 09:51:59 +03:00
b167120f96
We'll see if this improves compile times at all, but I think it's worth doing as at least the most minimal form of module documentation. This was accomplished by first compiling everything with -ddump-minimal-imports, and then a bunch of scripting (with help from ormolu) **EDIT** it doesn't seem to improve CI compile times but the noise floor is high as it looks like we're not caching library dependencies anymore PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2730 GitOrigin-RevId: 667eb8de1e0f1af70420cbec90402922b8b84cb4
413 lines
15 KiB
Haskell
413 lines
15 KiB
Haskell
module Hasura.RQL.DDL.Permission
|
|
( CreatePerm,
|
|
runCreatePerm,
|
|
PermDef (..),
|
|
InsPerm (..),
|
|
InsPermDef,
|
|
buildInsPermInfo,
|
|
SelPerm (..),
|
|
SelPermDef,
|
|
buildSelPermInfo,
|
|
UpdPerm (..),
|
|
UpdPermDef,
|
|
buildUpdPermInfo,
|
|
DelPerm (..),
|
|
DelPermDef,
|
|
buildDelPermInfo,
|
|
IsPerm (..),
|
|
DropPerm,
|
|
runDropPerm,
|
|
dropPermissionInMetadata,
|
|
SetPermComment (..),
|
|
runSetPermComment,
|
|
)
|
|
where
|
|
|
|
import Control.Lens ((.~), (^?))
|
|
import Data.Aeson
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.HashSet qualified as HS
|
|
import Data.Kind (Type)
|
|
import Data.Text.Extended
|
|
import Hasura.Base.Error
|
|
import Hasura.EncJSON
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.Permission.Internal
|
|
import Hasura.RQL.DML.Internal
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.AnyBackend qualified as AB
|
|
import Hasura.SQL.Types
|
|
import Hasura.Session
|
|
|
|
{- Note [Backend only permissions]
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
As of writing this note, Hasura permission system is meant to be used by the
|
|
frontend. After introducing "Actions", the webhook handlers now can make GraphQL
|
|
mutations to the server with some backend logic. These mutations shouldn't be
|
|
exposed to frontend for any user since they'll bypass the business logic.
|
|
|
|
For example:-
|
|
|
|
We've a table named "user" and it has a "email" column. We need to validate the
|
|
email address. So we define an action "create_user" and it expects the same inputs
|
|
as "insert_user" mutation (generated by Hasura). Now, a role has permission for both
|
|
actions and insert operation on the table. If the insert permission is not marked
|
|
as "backend_only: true" then it visible to the frontend client along with "creat_user".
|
|
|
|
Backend only permissions adds an additional privilege to Hasura generated operations.
|
|
Those are accessable only if the request is made with `x-hasura-admin-secret`
|
|
(if authorization is configured), `x-hasura-use-backend-only-permissions`
|
|
(value must be set to "true"), `x-hasura-role` to identify the role and other
|
|
required session variables.
|
|
|
|
backend_only `x-hasura-admin-secret` `x-hasura-use-backend-only-permissions` Result
|
|
------------ --------------------- ------------------------------------- ------
|
|
FALSE ANY ANY Mutation is always visible
|
|
TRUE FALSE ANY Mutation is always hidden
|
|
TRUE TRUE (OR NOT-SET) FALSE Mutation is hidden
|
|
TRUE TRUE (OR NOT-SET) TRUE Mutation is shown
|
|
-}
|
|
|
|
procSetObj ::
|
|
forall b m.
|
|
(QErrM m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
Maybe (ColumnValues b Value) ->
|
|
m (PreSetColsPartial b, [Text], [SchemaDependency])
|
|
procSetObj source tn fieldInfoMap mObj = do
|
|
(setColTups, deps) <- withPathK "set" $
|
|
fmap unzip $
|
|
forM (HM.toList setObj) $ \(pgCol, val) -> do
|
|
ty <-
|
|
askColumnType fieldInfoMap pgCol $
|
|
"column " <> pgCol <<> " not found in table " <>> tn
|
|
sqlExp <- parseCollectableType (CollectableTypeScalar ty) val
|
|
let dep = mkColDep @b (getDepReason sqlExp) source tn pgCol
|
|
return ((pgCol, sqlExp), dep)
|
|
return (HM.fromList setColTups, depHeaders, deps)
|
|
where
|
|
setObj = fromMaybe mempty mObj
|
|
depHeaders = getDepHeadersFromVal $ Object $ mapKeys toTxt setObj
|
|
|
|
getDepReason = bool DRSessionVariable DROnType . isStaticValue
|
|
|
|
class IsPerm a where
|
|
type PermInfo a = (r :: BackendType -> Type) | r -> a
|
|
|
|
permAccessor ::
|
|
(ToJSON (a b), BackendMetadata b) =>
|
|
PermAccessor b (PermInfo a b)
|
|
|
|
buildPermInfo ::
|
|
(ToJSON (a b), BackendMetadata b, QErrM m, TableCoreInfoRM b m) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
PermDef (a b) ->
|
|
m (WithDeps (PermInfo a b))
|
|
|
|
getPermAcc1 ::
|
|
(ToJSON (a b), BackendMetadata b) =>
|
|
PermDef (a b) ->
|
|
PermAccessor b (PermInfo a b)
|
|
getPermAcc1 _ = permAccessor
|
|
|
|
getPermAcc2 ::
|
|
(ToJSON (a b), BackendMetadata b) =>
|
|
DropPerm a b ->
|
|
PermAccessor b (PermInfo a b)
|
|
getPermAcc2 _ = permAccessor
|
|
|
|
addPermToMetadata ::
|
|
(ToJSON (a b), BackendMetadata b) =>
|
|
PermDef (a b) ->
|
|
TableMetadata b ->
|
|
TableMetadata b
|
|
|
|
doesPermissionExistInMetadata ::
|
|
TableMetadata b ->
|
|
RoleName ->
|
|
PermType ->
|
|
Bool
|
|
doesPermissionExistInMetadata tableMetadata roleName = \case
|
|
-- TODO: lot of repetition below, any way to simplify this?
|
|
PTInsert -> isJust $ tableMetadata ^? tmInsertPermissions . ix roleName
|
|
PTSelect -> isJust $ tableMetadata ^? tmSelectPermissions . ix roleName
|
|
PTUpdate -> isJust $ tableMetadata ^? tmUpdatePermissions . ix roleName
|
|
PTDelete -> isJust $ tableMetadata ^? tmDeletePermissions . ix roleName
|
|
|
|
runCreatePerm ::
|
|
forall m b a.
|
|
(ToJSON (a b), IsPerm a, UserInfoM m, CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
|
|
CreatePerm a b ->
|
|
m EncJSON
|
|
runCreatePerm (CreatePerm (WithTable source tableName permissionDefn)) = do
|
|
tableMetadata <- askTableMetadata @b source tableName
|
|
let permAcc = getPermAcc1 permissionDefn
|
|
permissionType = permAccToType permAcc
|
|
ptText = permTypeToCode permissionType
|
|
role = _pdRole permissionDefn
|
|
metadataObject =
|
|
MOSourceObjId source $
|
|
AB.mkAnyBackend $
|
|
SMOTableObj @b tableName $
|
|
MTOPerm role permissionType
|
|
|
|
-- NOTE: we check if a permission exists for a `(table, role)` entity in the metadata
|
|
-- and not in the `RolePermInfoMap b` because there may exist a permission for the `role`
|
|
-- which is an inherited one, so we check it in the metadata directly
|
|
|
|
-- The metadata will not contain the permissions for the admin role,
|
|
-- because the graphql-engine automatically creates the role and it's
|
|
-- assumed that the admin role is an implicit role of the graphql-engine.
|
|
when (doesPermissionExistInMetadata tableMetadata role permissionType || role == adminRoleName) $
|
|
throw400 AlreadyExists $
|
|
ptText <> " permission already defined on table " <> tableName <<> " with role " <>> role
|
|
buildSchemaCacheFor metadataObject $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source tableName %~ addPermToMetadata permissionDefn
|
|
pure successMsg
|
|
|
|
runDropPerm ::
|
|
forall b a m.
|
|
(ToJSON (a b), IsPerm a, UserInfoM m, CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
|
|
DropPerm a b ->
|
|
m EncJSON
|
|
runDropPerm dp@(DropPerm source table role) = do
|
|
tableMetadata <- askTableMetadata @b source table
|
|
let permType = permAccToType $ getPermAcc2 dp
|
|
unless (doesPermissionExistInMetadata tableMetadata role permType) $ do
|
|
let errMsg =
|
|
mconcat
|
|
[ permTypeToCode permType <> " permission on " <>> table,
|
|
" for role " <>> role,
|
|
" does not exist"
|
|
]
|
|
throw400 PermissionDenied errMsg
|
|
withNewInconsistentObjsCheck $
|
|
buildSchemaCache $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source table %~ dropPermissionInMetadata role permType
|
|
return successMsg
|
|
|
|
buildInsPermInfo ::
|
|
forall b m.
|
|
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
PermDef (InsPerm b) ->
|
|
m (WithDeps (InsPermInfo b))
|
|
buildInsPermInfo source tn fieldInfoMap (PermDef _rn (InsPerm checkCond set mCols mBackendOnly) _) =
|
|
withPathK "permission" $ do
|
|
(be, beDeps) <- withPathK "check" $ procBoolExp source tn fieldInfoMap checkCond
|
|
(setColsSQL, setHdrs, setColDeps) <- procSetObj source tn fieldInfoMap set
|
|
void $
|
|
withPathK "columns" $
|
|
indexedForM insCols $ \col ->
|
|
askColumnType fieldInfoMap col ""
|
|
let fltrHeaders = getDependentHeaders checkCond
|
|
reqHdrs = fltrHeaders `HS.union` (HS.fromList setHdrs)
|
|
insColDeps = map (mkColDep @b DRUntyped source tn) insCols
|
|
deps = mkParentDep @b source tn : beDeps ++ setColDeps ++ insColDeps
|
|
insColsWithoutPresets = insCols \\ HM.keys setColsSQL
|
|
return (InsPermInfo (HS.fromList insColsWithoutPresets) be setColsSQL backendOnly reqHdrs, deps)
|
|
where
|
|
backendOnly = Just True == mBackendOnly
|
|
allCols = map pgiColumn $ getCols fieldInfoMap
|
|
insCols = maybe allCols (convColSpec fieldInfoMap) mCols
|
|
|
|
instance IsPerm InsPerm where
|
|
type PermInfo InsPerm = InsPermInfo
|
|
permAccessor = PAInsert
|
|
buildPermInfo = buildInsPermInfo
|
|
|
|
addPermToMetadata permDef =
|
|
tmInsertPermissions %~ OMap.insert (_pdRole permDef) permDef
|
|
|
|
buildSelPermInfo ::
|
|
forall b m.
|
|
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
SelPerm b ->
|
|
m (WithDeps (SelPermInfo b))
|
|
buildSelPermInfo source tn fieldInfoMap sp = withPathK "permission" $ do
|
|
let pgCols = convColSpec fieldInfoMap $ spColumns sp
|
|
|
|
(boolExp, boolExpDeps) <-
|
|
withPathK "filter" $
|
|
procBoolExp source tn fieldInfoMap $ spFilter sp
|
|
|
|
-- check if the columns exist
|
|
void $
|
|
withPathK "columns" $
|
|
indexedForM pgCols $ \pgCol ->
|
|
askColumnType fieldInfoMap pgCol autoInferredErr
|
|
|
|
-- validate computed fields
|
|
scalarComputedFields <-
|
|
withPathK "computed_fields" $
|
|
indexedForM computedFields $ \fieldName -> do
|
|
computedFieldInfo <- askComputedFieldInfo fieldInfoMap fieldName
|
|
case _cfiReturnType computedFieldInfo of
|
|
CFRScalar _ -> pure fieldName
|
|
CFRSetofTable returnTable ->
|
|
throw400 NotSupported $
|
|
"select permissions on computed field " <> fieldName
|
|
<<> " are auto-derived from the permissions on its returning table "
|
|
<> returnTable
|
|
<<> " and cannot be specified manually"
|
|
|
|
let deps =
|
|
mkParentDep @b source tn :
|
|
boolExpDeps ++ map (mkColDep @b DRUntyped source tn) pgCols
|
|
++ map (mkComputedFieldDep @b DRUntyped source tn) scalarComputedFields
|
|
depHeaders = getDependentHeaders $ spFilter sp
|
|
mLimit = spLimit sp
|
|
|
|
withPathK "limit" $ mapM_ onlyPositiveInt mLimit
|
|
|
|
let pgColsWithFilter = HM.fromList $ map (,Nothing) pgCols
|
|
scalarComputedFieldsWithFilter = HS.toMap (HS.fromList scalarComputedFields) $> Nothing
|
|
|
|
let selPermInfo =
|
|
SelPermInfo pgColsWithFilter scalarComputedFieldsWithFilter boolExp mLimit allowAgg depHeaders
|
|
|
|
return (selPermInfo, deps)
|
|
where
|
|
allowAgg = spAllowAggregations sp
|
|
computedFields = spComputedFields sp
|
|
autoInferredErr = "permissions for relationships are automatically inferred"
|
|
|
|
instance IsPerm SelPerm where
|
|
type PermInfo SelPerm = SelPermInfo
|
|
permAccessor = PASelect
|
|
buildPermInfo source tn fieldInfoMap (PermDef _ a _) =
|
|
buildSelPermInfo source tn fieldInfoMap a
|
|
|
|
addPermToMetadata permDef =
|
|
tmSelectPermissions %~ OMap.insert (_pdRole permDef) permDef
|
|
|
|
buildUpdPermInfo ::
|
|
forall b m.
|
|
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
UpdPerm b ->
|
|
m (WithDeps (UpdPermInfo b))
|
|
buildUpdPermInfo source tn fieldInfoMap (UpdPerm colSpec set fltr check) = do
|
|
(be, beDeps) <-
|
|
withPathK "filter" $
|
|
procBoolExp source tn fieldInfoMap fltr
|
|
|
|
checkExpr <- traverse (withPathK "check" . procBoolExp source tn fieldInfoMap) check
|
|
|
|
(setColsSQL, setHeaders, setColDeps) <- procSetObj source tn fieldInfoMap set
|
|
|
|
-- check if the columns exist
|
|
void $
|
|
withPathK "columns" $
|
|
indexedForM updCols $ \updCol ->
|
|
askColumnType fieldInfoMap updCol relInUpdErr
|
|
|
|
let updColDeps = map (mkColDep @b DRUntyped source tn) updCols
|
|
deps = mkParentDep @b source tn : beDeps ++ maybe [] snd checkExpr ++ updColDeps ++ setColDeps
|
|
depHeaders = getDependentHeaders fltr
|
|
reqHeaders = depHeaders `HS.union` (HS.fromList setHeaders)
|
|
updColsWithoutPreSets = updCols \\ HM.keys setColsSQL
|
|
|
|
return (UpdPermInfo (HS.fromList updColsWithoutPreSets) tn be (fst <$> checkExpr) setColsSQL reqHeaders, deps)
|
|
where
|
|
updCols = convColSpec fieldInfoMap colSpec
|
|
relInUpdErr = "relationships can't be used in update"
|
|
|
|
instance IsPerm UpdPerm where
|
|
type PermInfo UpdPerm = UpdPermInfo
|
|
permAccessor = PAUpdate
|
|
buildPermInfo source tn fieldInfoMap (PermDef _ a _) =
|
|
buildUpdPermInfo source tn fieldInfoMap a
|
|
|
|
addPermToMetadata permDef =
|
|
tmUpdatePermissions %~ OMap.insert (_pdRole permDef) permDef
|
|
|
|
buildDelPermInfo ::
|
|
forall b m.
|
|
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
DelPerm b ->
|
|
m (WithDeps (DelPermInfo b))
|
|
buildDelPermInfo source tn fieldInfoMap (DelPerm fltr) = do
|
|
(be, beDeps) <-
|
|
withPathK "filter" $
|
|
procBoolExp source tn fieldInfoMap fltr
|
|
let deps = mkParentDep @b source tn : beDeps
|
|
depHeaders = getDependentHeaders fltr
|
|
return (DelPermInfo tn be depHeaders, deps)
|
|
|
|
instance IsPerm DelPerm where
|
|
type PermInfo DelPerm = DelPermInfo
|
|
permAccessor = PADelete
|
|
buildPermInfo source tn fieldInfoMap (PermDef _ a _) =
|
|
buildDelPermInfo source tn fieldInfoMap a
|
|
|
|
addPermToMetadata permDef =
|
|
tmDeletePermissions %~ OMap.insert (_pdRole permDef) permDef
|
|
|
|
data SetPermComment b = SetPermComment
|
|
{ apSource :: !SourceName,
|
|
apTable :: !(TableName b),
|
|
apRole :: !RoleName,
|
|
apPermission :: !PermType,
|
|
apComment :: !(Maybe Text)
|
|
}
|
|
|
|
instance (Backend b) => FromJSON (SetPermComment b) where
|
|
parseJSON = withObject "SetPermComment" $ \o ->
|
|
SetPermComment
|
|
<$> o .:? "source" .!= defaultSource
|
|
<*> o .: "table"
|
|
<*> o .: "role"
|
|
<*> o .: "permission"
|
|
<*> o .:? "comment"
|
|
|
|
runSetPermComment ::
|
|
forall b m.
|
|
(QErrM m, CacheRWM m, MetadataM m, BackendMetadata b) =>
|
|
SetPermComment b ->
|
|
m EncJSON
|
|
runSetPermComment (SetPermComment source table roleName permType comment) = do
|
|
tableInfo <- askTabInfo @b source table
|
|
|
|
-- assert permission exists and return appropriate permission modifier
|
|
permModifier <- case permType of
|
|
PTInsert -> do
|
|
assertPermDefined roleName PAInsert tableInfo
|
|
pure $ tmInsertPermissions . ix roleName . pdComment .~ comment
|
|
PTSelect -> do
|
|
assertPermDefined roleName PASelect tableInfo
|
|
pure $ tmSelectPermissions . ix roleName . pdComment .~ comment
|
|
PTUpdate -> do
|
|
assertPermDefined roleName PAUpdate tableInfo
|
|
pure $ tmUpdatePermissions . ix roleName . pdComment .~ comment
|
|
PTDelete -> do
|
|
assertPermDefined roleName PADelete tableInfo
|
|
pure $ tmDeletePermissions . ix roleName . pdComment .~ comment
|
|
|
|
let metadataObject =
|
|
MOSourceObjId source $
|
|
AB.mkAnyBackend $
|
|
SMOTableObj @b table $
|
|
MTOPerm roleName permType
|
|
buildSchemaCacheFor metadataObject $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source table %~ permModifier
|
|
pure successMsg
|