graphql-engine/server/src-lib/Hasura/RQL/DDL/Permission.hs
2022-01-19 08:38:48 +00:00

435 lines
16 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 (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 ::
forall b.
TableMetadata b ->
RoleName ->
PermType ->
Bool
doesPermissionExistInMetadata tableMetadata roleName = \case
PTInsert -> hasPermissionTo tmInsertPermissions
PTSelect -> hasPermissionTo tmSelectPermissions
PTUpdate -> hasPermissionTo tmUpdatePermissions
PTDelete -> hasPermissionTo tmDeletePermissions
where
hasPermissionTo :: forall a. Lens' (TableMetadata b) (Permissions a) -> Bool
hasPermissionTo perms = isJust $ tableMetadata ^? perms . 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" $ do
indexedForM insCols $ \col -> do
-- Check that all columns specified do in fact exist and are columns
_ <- askColumnType fieldInfoMap col relInInsErr
-- Check that the column is insertable
ci <- askColInfo fieldInfoMap col ""
unless (_cmIsInsertable $ ciMutability ci) $
throw500
( "Column " <> col
<<> " is not insertable and so cannot have insert permissions defined"
)
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 ciColumn $ getCols fieldInfoMap
insCols = maybe allCols (convColSpec fieldInfoMap) mCols
relInInsErr = "Only table columns can have insert permissions defined, not relationships or other field types"
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 -> do
-- Check that all columns specified do in fact exist and are columns
_ <- askColumnType fieldInfoMap updCol relInUpdErr
-- Check that the column is updatable
ci <- askColInfo fieldInfoMap updCol ""
unless (_cmIsUpdatable $ ciMutability ci) $
throw500
( "Column " <> updCol
<<> " is not updatable and so cannot have update permissions defined"
)
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 = "Only table columns can have update permissions defined, not relationships or other field types"
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