graphql-engine/server/src-lib/Hasura/RQL/DDL/Permission.hs

390 lines
13 KiB
Haskell
Raw Normal View History

2018-06-27 16:11:32 +03:00
module Hasura.RQL.DDL.Permission
( CreatePerm
, runCreatePerm
2018-06-27 16:11:32 +03:00
, PermDef(..)
, InsPerm(..)
, InsPermDef
, CreateInsPerm
, buildInsPermInfo
, SelPerm(..)
, SelPermDef
, CreateSelPerm
, buildSelPermInfo
, UpdPerm(..)
, UpdPermDef
, CreateUpdPerm
, buildUpdPermInfo
, DelPerm(..)
, DelPermDef
, CreateDelPerm
, buildDelPermInfo
, IsPerm(..)
, DropPerm
, runDropPerm
, dropPermissionInMetadata
, SetPermComment(..)
, runSetPermComment
, fetchPermDef
2018-06-27 16:11:32 +03:00
) where
2020-08-27 19:36:39 +03:00
import Hasura.Prelude
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Data.HashSet as HS
import qualified Database.PG.Query as Q
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types
import Hasura.EncJSON
2018-06-27 16:11:32 +03:00
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DML.Internal hiding (askPermInfo)
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.Session
2018-06-27 16:11:32 +03:00
backend only insert permissions (rfc #4120) (#4224) * move user info related code to Hasura.User module * the RFC #4120 implementation; insert permissions with admin secret * revert back to old RoleName based schema maps An attempt made to avoid duplication of schema contexts in types if any role doesn't possess any admin secret specific schema * fix compile errors in haskell test * keep 'user_vars' for session variables in http-logs * no-op refacto * tests for admin only inserts * update docs for admin only inserts * updated CHANGELOG.md * default behaviour when admin secret is not set * fix x-hasura-role to X-Hasura-Role in pytests * introduce effective timeout in actions async tests * update docs for admin-secret not configured case * Update docs/graphql/manual/api-reference/schema-metadata-api/permission.rst Co-Authored-By: Marion Schleifer <marion@hasura.io> * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * a complete iteration backend insert permissions accessable via 'x-hasura-backend-privilege' session variable * console changes for backend-only permissions * provide tooltip id; update labels and tooltips; * requested changes * requested changes - remove className from Toggle component - use appropriate function name (capitalizeFirstChar -> capitalize) * use toggle props from definitelyTyped * fix accidental commit * Revert "introduce effective timeout in actions async tests" This reverts commit b7a59c19d643520cfde6af579889e1038038438a. * generate complete schema for both 'default' and 'backend' sessions * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * remove unnecessary import, export Toggle as is * update session variable in tooltip * 'x-hasura-use-backend-only-permissions' variable to switch * update help texts * update docs * update docs * update console help text * regenerate package-lock * serve no backend schema when backend_only: false and header set to true - Few type name refactor as suggested by @0x777 * update CHANGELOG.md * Update CHANGELOG.md * Update CHANGELOG.md * fix a merge bug where a certain entity didn't get removed Co-authored-by: Marion Schleifer <marion@hasura.io> Co-authored-by: Rishichandra Wawhal <rishi@hasura.io> Co-authored-by: rikinsk <rikin.kachhia@gmail.com> Co-authored-by: Tirumarai Selvan <tiru@hasura.io>
2020-04-24 12:10:53 +03:00
{- 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
-}
type CreateInsPerm b = CreatePerm (InsPerm b)
2018-06-27 16:11:32 +03:00
procSetObj
:: (QErrM m)
=> QualifiedTable
-> FieldInfoMap (FieldInfo 'Postgres)
-> Maybe (ColumnValues Value)
-> m (PreSetColsPartial 'Postgres, [Text], [SchemaDependency])
procSetObj tn fieldInfoMap mObj = do
(setColTups, deps) <- withPathK "set" $
fmap unzip $ forM (HM.toList setObj) $ \(pgCol, val) -> do
ty <- askPGType fieldInfoMap pgCol $
"column " <> pgCol <<> " not found in table " <>> tn
sqlExp <- valueParser (CollectableTypeScalar ty) val
let dep = mkColDep (getDepReason sqlExp) tn pgCol
return ((pgCol, sqlExp), dep)
return (HM.fromList setColTups, depHeaders, deps)
where
setObj = fromMaybe mempty mObj
depHeaders = getDepHeadersFromVal $ Object $
HM.fromList $ map (first getPGColTxt) $ HM.toList setObj
getDepReason = bool DRSessionVariable DROnType . isStaticValue
class (ToJSON a) => IsPerm a where
permAccessor
:: PermAccessor 'Postgres (PermInfo a)
buildPermInfo
:: (QErrM m, TableCoreInfoRM m)
=> QualifiedTable
-> FieldInfoMap (FieldInfo 'Postgres)
-> PermDef a
-> m (WithDeps (PermInfo a))
getPermAcc1
:: PermDef a -> PermAccessor 'Postgres (PermInfo a)
getPermAcc1 _ = permAccessor
getPermAcc2
:: DropPerm a -> PermAccessor 'Postgres (PermInfo a)
getPermAcc2 _ = permAccessor
addPermToMetadata
:: PermDef a -> TableMetadata -> TableMetadata
runCreatePerm
:: (UserInfoM m, CacheRWM m, IsPerm a, MonadError QErr m, MetadataM m)
=> CreatePerm a -> m EncJSON
runCreatePerm (WithTable tn pd) = do
let pt = permAccToType $ getPermAcc1 pd
role = _pdRole pd
metadataObject = MOTableObj tn $ MTOPerm role pt
buildSchemaCacheFor metadataObject
$ MetadataModifier
$ metaTables.ix tn %~ addPermToMetadata pd
pure successMsg
runDropPerm
:: (IsPerm a, UserInfoM m, CacheRWM m, MonadTx m, MetadataM m)
=> DropPerm a -> m EncJSON
runDropPerm dp@(DropPerm table role) = do
tabInfo <- askTabInfo table
let permType = permAccToType $ getPermAcc2 dp
askPermInfo tabInfo role $ getPermAcc2 dp
withNewInconsistentObjsCheck
$ buildSchemaCache
$ MetadataModifier
$ metaTables.ix table %~ dropPermissionInMetadata role permType
return successMsg
dropPermissionInMetadata
:: RoleName -> PermType -> TableMetadata -> TableMetadata
dropPermissionInMetadata rn = \case
PTInsert -> tmInsertPermissions %~ OMap.delete rn
PTSelect -> tmSelectPermissions %~ OMap.delete rn
PTDelete -> tmDeletePermissions %~ OMap.delete rn
PTUpdate -> tmUpdatePermissions %~ OMap.delete rn
2018-06-27 16:11:32 +03:00
buildInsPermInfo
:: (QErrM m, TableCoreInfoRM m)
=> QualifiedTable
-> FieldInfoMap (FieldInfo 'Postgres)
-> PermDef (InsPerm 'Postgres)
-> m (WithDeps (InsPermInfo 'Postgres))
backend only insert permissions (rfc #4120) (#4224) * move user info related code to Hasura.User module * the RFC #4120 implementation; insert permissions with admin secret * revert back to old RoleName based schema maps An attempt made to avoid duplication of schema contexts in types if any role doesn't possess any admin secret specific schema * fix compile errors in haskell test * keep 'user_vars' for session variables in http-logs * no-op refacto * tests for admin only inserts * update docs for admin only inserts * updated CHANGELOG.md * default behaviour when admin secret is not set * fix x-hasura-role to X-Hasura-Role in pytests * introduce effective timeout in actions async tests * update docs for admin-secret not configured case * Update docs/graphql/manual/api-reference/schema-metadata-api/permission.rst Co-Authored-By: Marion Schleifer <marion@hasura.io> * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * a complete iteration backend insert permissions accessable via 'x-hasura-backend-privilege' session variable * console changes for backend-only permissions * provide tooltip id; update labels and tooltips; * requested changes * requested changes - remove className from Toggle component - use appropriate function name (capitalizeFirstChar -> capitalize) * use toggle props from definitelyTyped * fix accidental commit * Revert "introduce effective timeout in actions async tests" This reverts commit b7a59c19d643520cfde6af579889e1038038438a. * generate complete schema for both 'default' and 'backend' sessions * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * remove unnecessary import, export Toggle as is * update session variable in tooltip * 'x-hasura-use-backend-only-permissions' variable to switch * update help texts * update docs * update docs * update console help text * regenerate package-lock * serve no backend schema when backend_only: false and header set to true - Few type name refactor as suggested by @0x777 * update CHANGELOG.md * Update CHANGELOG.md * Update CHANGELOG.md * fix a merge bug where a certain entity didn't get removed Co-authored-by: Marion Schleifer <marion@hasura.io> Co-authored-by: Rishichandra Wawhal <rishi@hasura.io> Co-authored-by: rikinsk <rikin.kachhia@gmail.com> Co-authored-by: Tirumarai Selvan <tiru@hasura.io>
2020-04-24 12:10:53 +03:00
buildInsPermInfo tn fieldInfoMap (PermDef _rn (InsPerm checkCond set mCols mBackendOnly) _) =
2019-04-17 12:48:41 +03:00
withPathK "permission" $ do
(be, beDeps) <- withPathK "check" $ procBoolExp tn fieldInfoMap checkCond
(setColsSQL, setHdrs, setColDeps) <- procSetObj tn fieldInfoMap set
void $ withPathK "columns" $ indexedForM insCols $ \col ->
askPGType fieldInfoMap col ""
let fltrHeaders = getDependentHeaders checkCond
reqHdrs = fltrHeaders `union` setHdrs
insColDeps = map (mkColDep DRUntyped tn) insCols
deps = mkParentDep tn : beDeps ++ setColDeps ++ insColDeps
insColsWithoutPresets = insCols \\ HM.keys setColsSQL
backend only insert permissions (rfc #4120) (#4224) * move user info related code to Hasura.User module * the RFC #4120 implementation; insert permissions with admin secret * revert back to old RoleName based schema maps An attempt made to avoid duplication of schema contexts in types if any role doesn't possess any admin secret specific schema * fix compile errors in haskell test * keep 'user_vars' for session variables in http-logs * no-op refacto * tests for admin only inserts * update docs for admin only inserts * updated CHANGELOG.md * default behaviour when admin secret is not set * fix x-hasura-role to X-Hasura-Role in pytests * introduce effective timeout in actions async tests * update docs for admin-secret not configured case * Update docs/graphql/manual/api-reference/schema-metadata-api/permission.rst Co-Authored-By: Marion Schleifer <marion@hasura.io> * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * a complete iteration backend insert permissions accessable via 'x-hasura-backend-privilege' session variable * console changes for backend-only permissions * provide tooltip id; update labels and tooltips; * requested changes * requested changes - remove className from Toggle component - use appropriate function name (capitalizeFirstChar -> capitalize) * use toggle props from definitelyTyped * fix accidental commit * Revert "introduce effective timeout in actions async tests" This reverts commit b7a59c19d643520cfde6af579889e1038038438a. * generate complete schema for both 'default' and 'backend' sessions * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * remove unnecessary import, export Toggle as is * update session variable in tooltip * 'x-hasura-use-backend-only-permissions' variable to switch * update help texts * update docs * update docs * update console help text * regenerate package-lock * serve no backend schema when backend_only: false and header set to true - Few type name refactor as suggested by @0x777 * update CHANGELOG.md * Update CHANGELOG.md * Update CHANGELOG.md * fix a merge bug where a certain entity didn't get removed Co-authored-by: Marion Schleifer <marion@hasura.io> Co-authored-by: Rishichandra Wawhal <rishi@hasura.io> Co-authored-by: rikinsk <rikin.kachhia@gmail.com> Co-authored-by: Tirumarai Selvan <tiru@hasura.io>
2020-04-24 12:10:53 +03:00
return (InsPermInfo (HS.fromList insColsWithoutPresets) be setColsSQL backendOnly reqHdrs, deps)
2018-06-27 16:11:32 +03:00
where
backendOnly = Just True == mBackendOnly
allCols = map pgiColumn $ getCols fieldInfoMap
insCols = maybe allCols (convColSpec fieldInfoMap) mCols
2018-06-27 16:11:32 +03:00
-- TODO this is a dirty hack, hardcoding permissions to postgres. When
-- implementing support for other backends, the type family 'PermInfo' probably
-- needs to be refactored.
type instance PermInfo (InsPerm b) = InsPermInfo b
2018-06-27 16:11:32 +03:00
instance IsPerm (InsPerm 'Postgres) where
2018-06-27 16:11:32 +03:00
permAccessor = PAInsert
buildPermInfo = buildInsPermInfo
addPermToMetadata permDef =
tmInsertPermissions %~ OMap.insert (_pdRole permDef) permDef
2018-06-27 16:11:32 +03:00
buildSelPermInfo
:: (QErrM m, TableCoreInfoRM m)
=> QualifiedTable
-> FieldInfoMap (FieldInfo 'Postgres)
-> SelPerm 'Postgres
-> m (WithDeps (SelPermInfo 'Postgres))
buildSelPermInfo tn fieldInfoMap sp = withPathK "permission" $ do
2018-06-27 16:11:32 +03:00
let pgCols = convColSpec fieldInfoMap $ spColumns sp
(be, beDeps) <- withPathK "filter" $
procBoolExp tn fieldInfoMap $ spFilter sp
2018-06-27 16:11:32 +03:00
-- check if the columns exist
void $ withPathK "columns" $ indexedForM pgCols $ \pgCol ->
askPGType 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 tn : beDeps ++ map (mkColDep DRUntyped tn) pgCols
++ map (mkComputedFieldDep DRUntyped tn) scalarComputedFields
2018-06-27 16:11:32 +03:00
depHeaders = getDependentHeaders $ spFilter sp
mLimit = spLimit sp
withPathK "limit" $ mapM_ onlyPositiveInt mLimit
2018-06-27 16:11:32 +03:00
return ( SelPermInfo (HS.fromList pgCols) (HS.fromList computedFields)
be mLimit allowAgg depHeaders
, deps
)
2018-06-27 16:11:32 +03:00
where
allowAgg = spAllowAggregations sp
computedFields = spComputedFields sp
2018-06-27 16:11:32 +03:00
autoInferredErr = "permissions for relationships are automatically inferred"
type CreateSelPerm b = CreatePerm (SelPerm b)
2018-06-27 16:11:32 +03:00
-- TODO see TODO for PermInfo above.
type instance PermInfo (SelPerm b) = SelPermInfo b
2018-06-27 16:11:32 +03:00
instance IsPerm (SelPerm 'Postgres) where
2018-06-27 16:11:32 +03:00
permAccessor = PASelect
buildPermInfo tn fieldInfoMap (PermDef _ a _) =
buildSelPermInfo tn fieldInfoMap a
2018-06-27 16:11:32 +03:00
addPermToMetadata permDef =
tmSelectPermissions %~ OMap.insert (_pdRole permDef) permDef
type CreateUpdPerm b = CreatePerm (UpdPerm b)
2018-06-27 16:11:32 +03:00
buildUpdPermInfo
:: (QErrM m, TableCoreInfoRM m)
=> QualifiedTable
-> FieldInfoMap (FieldInfo 'Postgres)
-> UpdPerm 'Postgres
-> m (WithDeps (UpdPermInfo 'Postgres))
buildUpdPermInfo tn fieldInfoMap (UpdPerm colSpec set fltr check) = do
2018-06-27 16:11:32 +03:00
(be, beDeps) <- withPathK "filter" $
procBoolExp tn fieldInfoMap fltr
backend only insert permissions (rfc #4120) (#4224) * move user info related code to Hasura.User module * the RFC #4120 implementation; insert permissions with admin secret * revert back to old RoleName based schema maps An attempt made to avoid duplication of schema contexts in types if any role doesn't possess any admin secret specific schema * fix compile errors in haskell test * keep 'user_vars' for session variables in http-logs * no-op refacto * tests for admin only inserts * update docs for admin only inserts * updated CHANGELOG.md * default behaviour when admin secret is not set * fix x-hasura-role to X-Hasura-Role in pytests * introduce effective timeout in actions async tests * update docs for admin-secret not configured case * Update docs/graphql/manual/api-reference/schema-metadata-api/permission.rst Co-Authored-By: Marion Schleifer <marion@hasura.io> * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * a complete iteration backend insert permissions accessable via 'x-hasura-backend-privilege' session variable * console changes for backend-only permissions * provide tooltip id; update labels and tooltips; * requested changes * requested changes - remove className from Toggle component - use appropriate function name (capitalizeFirstChar -> capitalize) * use toggle props from definitelyTyped * fix accidental commit * Revert "introduce effective timeout in actions async tests" This reverts commit b7a59c19d643520cfde6af579889e1038038438a. * generate complete schema for both 'default' and 'backend' sessions * Apply suggestions from code review Co-Authored-By: Marion Schleifer <marion@hasura.io> * remove unnecessary import, export Toggle as is * update session variable in tooltip * 'x-hasura-use-backend-only-permissions' variable to switch * update help texts * update docs * update docs * update console help text * regenerate package-lock * serve no backend schema when backend_only: false and header set to true - Few type name refactor as suggested by @0x777 * update CHANGELOG.md * Update CHANGELOG.md * Update CHANGELOG.md * fix a merge bug where a certain entity didn't get removed Co-authored-by: Marion Schleifer <marion@hasura.io> Co-authored-by: Rishichandra Wawhal <rishi@hasura.io> Co-authored-by: rikinsk <rikin.kachhia@gmail.com> Co-authored-by: Tirumarai Selvan <tiru@hasura.io>
2020-04-24 12:10:53 +03:00
checkExpr <- traverse (withPathK "check" . procBoolExp tn fieldInfoMap) check
2018-06-27 16:11:32 +03:00
(setColsSQL, setHeaders, setColDeps) <- procSetObj tn fieldInfoMap set
2018-06-27 16:11:32 +03:00
-- check if the columns exist
void $ withPathK "columns" $ indexedForM updCols $ \updCol ->
2018-06-27 16:11:32 +03:00
askPGType fieldInfoMap updCol relInUpdErr
let updColDeps = map (mkColDep DRUntyped tn) updCols
deps = mkParentDep tn : beDeps ++ maybe [] snd checkExpr ++ updColDeps ++ setColDeps
2018-06-27 16:11:32 +03:00
depHeaders = getDependentHeaders fltr
reqHeaders = depHeaders `union` setHeaders
updColsWithoutPreSets = updCols \\ HM.keys setColsSQL
2018-06-27 16:11:32 +03:00
return (UpdPermInfo (HS.fromList updColsWithoutPreSets) tn be (fst <$> checkExpr) setColsSQL reqHeaders, deps)
2018-06-27 16:11:32 +03:00
where
updCols = convColSpec fieldInfoMap colSpec
relInUpdErr = "relationships can't be used in update"
-- TODO see TODO for PermInfo above
type instance PermInfo (UpdPerm b) = UpdPermInfo b
2018-06-27 16:11:32 +03:00
instance IsPerm (UpdPerm 'Postgres) where
2018-06-27 16:11:32 +03:00
permAccessor = PAUpdate
buildPermInfo tn fieldInfoMap (PermDef _ a _) =
buildUpdPermInfo tn fieldInfoMap a
2018-06-27 16:11:32 +03:00
addPermToMetadata permDef =
tmUpdatePermissions %~ OMap.insert (_pdRole permDef) permDef
type CreateDelPerm b = CreatePerm (DelPerm b)
2018-06-27 16:11:32 +03:00
buildDelPermInfo
:: (QErrM m, TableCoreInfoRM m)
=> QualifiedTable
-> FieldInfoMap (FieldInfo 'Postgres)
-> DelPerm 'Postgres
-> m (WithDeps (DelPermInfo 'Postgres))
buildDelPermInfo tn fieldInfoMap (DelPerm fltr) = do
2018-06-27 16:11:32 +03:00
(be, beDeps) <- withPathK "filter" $
procBoolExp tn fieldInfoMap fltr
2018-06-27 16:11:32 +03:00
let deps = mkParentDep tn : beDeps
depHeaders = getDependentHeaders fltr
return (DelPermInfo tn be depHeaders, deps)
2018-06-27 16:11:32 +03:00
-- TODO see TODO for PermInfo above
type instance PermInfo (DelPerm b) = DelPermInfo b
2018-06-27 16:11:32 +03:00
instance IsPerm (DelPerm 'Postgres) where
2018-06-27 16:11:32 +03:00
permAccessor = PADelete
buildPermInfo tn fieldInfoMap (PermDef _ a _) =
buildDelPermInfo tn fieldInfoMap a
2018-06-27 16:11:32 +03:00
addPermToMetadata permDef =
tmDeletePermissions %~ OMap.insert (_pdRole permDef) permDef
2018-06-27 16:11:32 +03:00
data SetPermComment
= SetPermComment
{ apTable :: !QualifiedTable
, apRole :: !RoleName
, apPermission :: !PermType
, apComment :: !(Maybe Text)
} deriving (Show, Eq)
2018-06-27 16:11:32 +03:00
$(deriveJSON (aesonDrop 2 snakeCase) ''SetPermComment)
setPermCommentP1 :: (UserInfoM m, QErrM m, CacheRM m) => SetPermComment -> m ()
2018-06-27 16:11:32 +03:00
setPermCommentP1 (SetPermComment qt rn pt _) = do
tabInfo <- askTabInfo qt
action tabInfo
where
action tabInfo = case pt of
PTInsert -> assertPermDefined rn PAInsert tabInfo
PTSelect -> assertPermDefined rn PASelect tabInfo
PTUpdate -> assertPermDefined rn PAUpdate tabInfo
PTDelete -> assertPermDefined rn PADelete tabInfo
setPermCommentP2 :: (QErrM m, MonadTx m) => SetPermComment -> m EncJSON
2018-06-27 16:11:32 +03:00
setPermCommentP2 apc = do
liftTx $ setPermCommentTx apc
return successMsg
runSetPermComment
:: (QErrM m, CacheRM m, MonadTx m, UserInfoM m)
=> SetPermComment -> m EncJSON
runSetPermComment defn = do
setPermCommentP1 defn
setPermCommentP2 defn
2018-06-27 16:11:32 +03:00
setPermCommentTx
:: SetPermComment
-> Q.TxE QErr ()
setPermCommentTx (SetPermComment (QualifiedObject sn tn) rn pt comment) =
2018-06-27 16:11:32 +03:00
Q.unitQE defaultTxErrorHandler [Q.sql|
UPDATE hdb_catalog.hdb_permission
SET comment = $1
WHERE table_schema = $2
AND table_name = $3
AND role_name = $4
AND perm_type = $5
|] (comment, sn, tn, rn, permTypeToCode pt) True
fetchPermDef
:: QualifiedTable
-> RoleName
-> PermType
-> Q.TxE QErr (Value, Maybe Text)
fetchPermDef (QualifiedObject sn tn) rn pt =
first Q.getAltJ . Q.getRow <$> Q.withQE defaultTxErrorHandler
[Q.sql|
SELECT perm_def::json, comment
FROM hdb_catalog.hdb_permission
WHERE table_schema = $1
AND table_name = $2
AND role_name = $3
AND perm_type = $4
|] (sn, tn, rn, permTypeToCode pt) True