feat: expose row-level can_edit/can_delete on select *
Compute per-row editability and deletability from a table's row-level security policies and return them as synthetic columns so clients can hide edit/delete affordances for rows the user cannot change. - Introspect pg_policies and relrowsecurity at schema-cache load and combine the UPDATE/DELETE USING qualifiers per table (permissive OR, restrictive AND). - Store the combined qualifiers on Table and inject can_edit/can_delete as computed select fields when expanding `select *`, only for RLS-enabled tables with a matching policy (COALESCE'd to a boolean). - Keep the computed columns out of the OpenAPI spec so they are not rendered as regular fields. - Add a cfExpression field to CoercibleField to carry raw SQL expressions through the planner to SqlFragment.
This commit is contained in:
@@ -318,7 +318,7 @@ data ResolverContext = ResolverContext
|
||||
}
|
||||
|
||||
resolveColumnField :: Column -> Maybe ToTsVector -> CoercibleField
|
||||
resolveColumnField col toTsV = CoercibleField (colName col) mempty False toTsV (colNominalType col) (colType col) Nothing (colDefault col) False
|
||||
resolveColumnField col toTsV = CoercibleField (colName col) mempty False toTsV (colNominalType col) (colType col) Nothing (colDefault col) False Nothing
|
||||
|
||||
resolveTableFieldName :: Table -> FieldName -> Maybe ToTsVector -> CoercibleField
|
||||
resolveTableFieldName table fieldName toTsV=
|
||||
@@ -499,15 +499,16 @@ expandStars ctx rPlanTree = Right $ expandStarsForReadPlan False rPlanTree
|
||||
adjustContext context fromQI _ = context{qi=fromQI}
|
||||
|
||||
expandStarsForTable :: ResolverContext -> Bool -> ReadPlan -> ReadPlan
|
||||
expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@ReadPlan{select=selectFields, relSpread=spread}
|
||||
expandStarsForTable ctx@ResolverContext{representations, outputType, tables, qi} hasAgg rp@ReadPlan{select=selectFields, relSpread=spread}
|
||||
-- We expand the '*' select if either of the below are true:
|
||||
-- * The target table has columns the request role cannot read.
|
||||
-- * There is an aggregate function in this ReadPlan's sub-tree.
|
||||
-- * The target table has at least one data representation.
|
||||
-- We ignore '*' selects that have an aggregate function attached, unless it's a `COUNT(*)` for a Spread Embed,
|
||||
-- we tag it as "full row" in that case.
|
||||
| hasStarSelect && hasLimitedPrivileges = rp{select = concatMap (expandStarSelectField (isJust spread) accessibleColumns) selectFields}
|
||||
| hasStarSelect && (hasAgg || hasDataRepresentation) = rp{select = concatMap (expandStarSelectField (isJust spread) knownColumns) selectFields}
|
||||
| hasStarSelect && hasLimitedPrivileges = rp{select = concatMap (expandStarSelectField (isJust spread) accessibleColumns) selectFields <> rlsFields}
|
||||
| hasStarSelect && (hasAgg || hasDataRepresentation) = rp{select = concatMap (expandStarSelectField (isJust spread) knownColumns) selectFields <> rlsFields}
|
||||
| hasStarSelect = rp{select = selectFields <> rlsFields}
|
||||
| otherwise = rp
|
||||
where
|
||||
hasStarSelect = "*" `elem` map (cfName . csField) filteredSelectFields
|
||||
@@ -517,6 +518,9 @@ expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@R
|
||||
knownColumns = knownColumnsInContext ctx
|
||||
hasLimitedPrivileges = accessibleColumns /= knownColumns
|
||||
accessibleColumns = accessibleColumnsInContext ctx
|
||||
rlsFields = case HM.lookup qi tables of
|
||||
Just tbl -> rlsSelectFields tbl
|
||||
Nothing -> []
|
||||
|
||||
hasOutputRep :: Column -> Bool
|
||||
hasOutputRep col = HM.member (colNominalType col, outputType) representations
|
||||
@@ -528,6 +532,23 @@ expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@R
|
||||
[sel { csField = fld { cfFullRow = True } }]
|
||||
expandStarSelectField _ _ selectField = [selectField]
|
||||
|
||||
-- | Synthetic can_edit/can_delete select fields for a table that has row-level
|
||||
-- security policies restricting UPDATE/DELETE. These carry the raw qualifier
|
||||
-- expression and are rendered as computed columns on `select *`.
|
||||
rlsSelectFields :: Table -> [CoercibleSelectField]
|
||||
rlsSelectFields tbl = catMaybes [rlsField "can_edit" (tableRlsEditQual tbl), rlsField "can_delete" (tableRlsDeleteQual tbl)]
|
||||
where
|
||||
rlsField :: FieldName -> Maybe Text -> Maybe CoercibleSelectField
|
||||
rlsField name qual = do
|
||||
expr <- qual
|
||||
pure CoercibleSelectField
|
||||
{ csField = (unknownField name []) { cfIRType = "boolean", cfBaseType = "boolean", cfExpression = Just expr }
|
||||
, csAggFunction = Nothing
|
||||
, csAggCast = Nothing
|
||||
, csCast = Nothing
|
||||
, csAlias = Just name
|
||||
}
|
||||
|
||||
-- | The columns of the current table that the request role can SELECT. Falls
|
||||
-- back to all known columns when no access info is available or the role has
|
||||
-- no SELECT privilege on any column.
|
||||
@@ -947,7 +968,7 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
|
||||
-- where_ = [
|
||||
-- CoercibleStmnt (
|
||||
-- CoercibleFilter {
|
||||
-- field = CoercibleField {cfName = "projects", cfJsonPath = [], cfToJson=False, cfToTsVector = Nothing, cfIRType = "", cfBaseType = "", cfTransform = Nothing, cfDefault = Nothing, cfFullRow = False},
|
||||
-- field = CoercibleField {cfName = "projects", cfJsonPath = [], cfToJson=False, cfToTsVector = Nothing, cfIRType = "", cfBaseType = "", cfTransform = Nothing, cfDefault = Nothing, cfFullRow = False, cfExpression = Nothing},
|
||||
-- opExpr = op
|
||||
-- }
|
||||
-- )
|
||||
@@ -964,7 +985,7 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
|
||||
-- Don't do anything to the filter if there's no embedding (a subtree) on projects. Assume it's a normal filter.
|
||||
--
|
||||
-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp [])
|
||||
-- Right [CoercibleStmnt (CoercibleFilter {field = CoercibleField {cfName = "projects", cfJsonPath = [], cfToJson = False, cfToTsVector = Nothing, cfIRType = "", cfBaseType = "", cfTransform = Nothing, cfDefault = Nothing, cfFullRow = False}, opExpr = OpExpr True (Is IsNull)})]
|
||||
-- Right [CoercibleStmnt (CoercibleFilter {field = CoercibleField {cfName = "projects", cfJsonPath = [], cfToJson = False, cfToTsVector = Nothing, cfIRType = "", cfBaseType = "", cfTransform = Nothing, cfDefault = Nothing, cfFullRow = False, cfExpression = Nothing}, opExpr = OpExpr True (Is IsNull)})]
|
||||
--
|
||||
-- If there's an embedding on projects, then change the filter to use the internal aggregate name (`clients_projects_1`) so the filter can succeed later.
|
||||
--
|
||||
|
||||
@@ -47,10 +47,11 @@ data CoercibleField = CoercibleField
|
||||
, cfTransform :: Maybe TransformerProc -- ^ The optional mapping from irType -> targetType.
|
||||
, cfDefault :: Maybe Text
|
||||
, cfFullRow :: Bool -- ^ True if the field represents the whole selected row. Used in spread rels: instead of COUNT(*), it does a COUNT(<row>) in order to not mix with other spread resources.
|
||||
, cfExpression :: Maybe Text -- ^ Raw SQL expression for a computed field (e.g. RLS-derived can_edit/can_delete). When present the field is rendered as this expression instead of a table column.
|
||||
} deriving (Eq, Show)
|
||||
|
||||
unknownField :: FieldName -> JsonPath -> CoercibleField
|
||||
unknownField name path = CoercibleField name path False Nothing "" "" Nothing Nothing False
|
||||
unknownField name path = CoercibleField name path False Nothing "" "" Nothing Nothing False Nothing
|
||||
|
||||
-- | Like an API request LogicTree, but with coercible field information.
|
||||
data CoercibleLogicTree
|
||||
|
||||
@@ -180,7 +180,7 @@ callPlanToQuery (FunctionCall qi params arguments returnsScalar returnsSetOfScal
|
||||
KeyParams [] -> "FROM " <> callIt mempty
|
||||
KeyParams prms -> case arguments of
|
||||
DirectArgs args -> "FROM " <> callIt (fmtArgs prms args)
|
||||
JsonArgs json -> fromJsonBodyF json ((\p -> CoercibleField (ppName p) mempty False Nothing (ppTypeMaxLength p) mempty Nothing Nothing False) <$> prms) False True False <> ", " <>
|
||||
JsonArgs json -> fromJsonBodyF json ((\p -> CoercibleField (ppName p) mempty False Nothing (ppTypeMaxLength p) mempty Nothing Nothing False Nothing) <$> prms) False True False <> ", " <>
|
||||
"LATERAL " <> callIt (fmtParams prms)
|
||||
|
||||
callIt :: SQL.Snippet -> SQL.Snippet
|
||||
|
||||
@@ -249,6 +249,7 @@ pgFmtField table cf = case cfToTsVector cf of
|
||||
_ -> fmtFld
|
||||
where
|
||||
fmtFld = case cf of
|
||||
CoercibleField{cfExpression=Just expr} -> SQL.sql (encodeUtf8 expr)
|
||||
CoercibleField{cfFullRow=True} -> pgFmtIdent (qiName table)
|
||||
CoercibleField{cfName=fn, cfJsonPath=[]} -> pgFmtColumn table fn
|
||||
CoercibleField{cfName=fn, cfToJson=doToJson, cfJsonPath=jp} | doToJson -> "to_jsonb(" <> pgFmtColumn table fn <> ")" <> pgFmtJsonPath jp
|
||||
|
||||
@@ -150,6 +150,7 @@ querySchemaCache pgVer conf@AppConfig{..} = do
|
||||
m2oRels <- sqlTimedStmt gucRels mempty allM2OandO2ORels
|
||||
funcs <- sqlTimedStmt gucFuncs conf (allFunctions pgVer configDbPreparedStatements)
|
||||
cRels <- sqlTimedStmt gucCRels mempty allComputedRels
|
||||
rlsPols <- sqlTimedStmt gucRLS conf allRlsPolicies
|
||||
reps <- sqlTimedStmt gucDReps conf dataRepresentations
|
||||
mHdlers <- sqlTimedStmt gucMHdrs conf mediaHandlers
|
||||
|
||||
@@ -161,10 +162,11 @@ querySchemaCache pgVer conf@AppConfig{..} = do
|
||||
else pure Nothing
|
||||
|
||||
let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
|
||||
tabsWithRls = addRlsQuals tabsWViewsPks (combineRlsPolicies rlsPols)
|
||||
rels = addInverseRels $ addM2MRels tabsWViewsPks $ addViewM2OAndO2ORels keyDeps m2oRels
|
||||
|
||||
return (removeInternal schemas $ SchemaCache {
|
||||
dbTables = tabsWViewsPks
|
||||
dbTables = tabsWithRls
|
||||
, dbRelationships = getOverrideRelationshipsMap rels cRels
|
||||
, dbRoutines = funcs
|
||||
, dbRepresentations = reps
|
||||
@@ -243,6 +245,8 @@ decodeTables =
|
||||
<*> nullableCompositeField HD.int4
|
||||
<*> nullableCompositeField HD.text
|
||||
<*> compositeFieldArray HD.text))
|
||||
<*> pure (Nothing :: Maybe Text)
|
||||
<*> pure (Nothing :: Maybe Text)
|
||||
|
||||
|
||||
parseCols :: HD.Row [Column] -> HD.Row ColumnMap
|
||||
@@ -838,6 +842,88 @@ allComputedRels =
|
||||
column HD.bool <*>
|
||||
column HD.bool
|
||||
|
||||
-- | A row-level security policy of an exposed table, gathered from pg_policies.
|
||||
data RlsPolicyRow = RlsPolicyRow
|
||||
{ rlsTable :: QualifiedIdentifier
|
||||
, rlsRowSec :: Bool
|
||||
, rlsCmd :: Text -- ^ "w" (UPDATE), "d" (DELETE), "*" (ALL)
|
||||
, rlsPermiss :: Bool
|
||||
, rlsQual :: Maybe Text -- ^ USING qualifier; Nothing means the policy has no USING restriction
|
||||
}
|
||||
|
||||
-- | Returns the UPDATE/DELETE RLS policies of the exposed tables, so that the
|
||||
-- planner can surface per-row can_edit/can_delete fields on SELECT *.
|
||||
allRlsPolicies :: SQL.Statement AppConfig [RlsPolicyRow]
|
||||
allRlsPolicies =
|
||||
SQL.Statement sql params decodeRlsPolicies True
|
||||
where
|
||||
params = map escapeIdent . toList . configDbSchemas >$< arrayParam HE.text
|
||||
sql = encodeUtf8 [trimming|
|
||||
SELECT
|
||||
n.nspname::text AS table_schema,
|
||||
c.relname::text AS table_name,
|
||||
c.relrowsecurity AS row_security,
|
||||
p.polcmd::text AS cmd,
|
||||
p.polpermissive AS permissive,
|
||||
pg_get_expr(p.polqual, p.polrelid) AS qual
|
||||
FROM pg_class c
|
||||
JOIN pg_namespace n ON n.oid = c.relnamespace
|
||||
JOIN pg_policy p ON p.polrelid = c.oid
|
||||
WHERE c.relkind IN ('r','p')
|
||||
AND c.relnamespace = ANY($$1::regnamespace[])
|
||||
AND p.polcmd IN ('w','d','*')
|
||||
ORDER BY n.nspname, c.relname|]
|
||||
|
||||
decodeRlsPolicies :: HD.Result [RlsPolicyRow]
|
||||
decodeRlsPolicies =
|
||||
HD.rowList rlsRow
|
||||
where
|
||||
rlsRow = RlsPolicyRow
|
||||
<$> (QualifiedIdentifier <$> column HD.text <*> column HD.text)
|
||||
<*> column HD.bool
|
||||
<*> column HD.text
|
||||
<*> column HD.bool
|
||||
<*> nullableColumn HD.text
|
||||
|
||||
-- | Combines the per-command RLS policies of each table into the SQL expression
|
||||
-- used to compute can_edit/can_delete. Following PostgreSQL semantics, multiple
|
||||
-- permissive policies combine with OR and restrictive ones with AND.
|
||||
combineRlsPolicies :: [RlsPolicyRow] -> HM.HashMap QualifiedIdentifier (Maybe Text, Maybe Text)
|
||||
combineRlsPolicies rows = HM.fromList $ mapMaybe toEntry $ HM.toList byTable
|
||||
where
|
||||
byTable = HM.fromListWith (<>) [ (rlsTable r, [r]) | r <- rows ]
|
||||
|
||||
toEntry (qi, rs)
|
||||
| not (any rlsRowSec rs) = Nothing
|
||||
| isNothing editQ && isNothing delQ = Nothing
|
||||
| otherwise = Just (qi, (editQ, delQ))
|
||||
where
|
||||
editQ = combineCmd ["w", "*"] rs
|
||||
delQ = combineCmd ["d", "*"] rs
|
||||
|
||||
combineCmd cmds rs
|
||||
| null policies = Nothing
|
||||
| null permissiveQs = Nothing
|
||||
| otherwise = Just $ wrapQual combined
|
||||
where
|
||||
policies = [ r | r <- rs, rlsCmd r `elem` cmds ]
|
||||
permissiveQs = [ fromMaybe "true" (rlsQual r) | r <- policies, rlsPermiss r ]
|
||||
restrictiveQs = [ fromMaybe "true" (rlsQual r) | r <- policies, not (rlsPermiss r) ]
|
||||
permissiveExpr = T.intercalate " OR " permissiveQs
|
||||
combined = case restrictiveQs of
|
||||
[] -> permissiveExpr
|
||||
_ -> "(" <> permissiveExpr <> ") AND (" <> T.intercalate " AND " restrictiveQs <> ")"
|
||||
|
||||
wrapQual q = "COALESCE(" <> q <> ", false)"
|
||||
|
||||
-- | Attaches the combined RLS qualifiers to the corresponding tables.
|
||||
addRlsQuals :: TablesMap -> HM.HashMap QualifiedIdentifier (Maybe Text, Maybe Text) -> TablesMap
|
||||
addRlsQuals tabs rlsMap = HM.mapWithKey setRls tabs
|
||||
where
|
||||
setRls qi tbl = case HM.lookup qi rlsMap of
|
||||
Nothing -> tbl
|
||||
Just (editQ, delQ) -> tbl { tableRlsEditQual = editQ, tableRlsDeleteQual = delQ }
|
||||
|
||||
-- | Returns all the views' primary keys and foreign keys dependencies
|
||||
allViewsKeyDependencies :: SQL.Statement AppConfig [ViewKeyDependency]
|
||||
allViewsKeyDependencies =
|
||||
@@ -1178,15 +1264,15 @@ extractTimings = SQL.Statement sql HE.noParams decodeThem True
|
||||
qFrag setting = "extract('milliseconds' from current_setting('pgrst." <> setting <> "', false)::interval)::text"
|
||||
sql = "SELECT " <> BS.intercalate ","
|
||||
[ qFrag gucTbls, qFrag gucKDeps, qFrag gucRels
|
||||
, qFrag gucFuncs, qFrag gucCRels, qFrag gucDReps
|
||||
, qFrag gucMHdrs
|
||||
, qFrag gucFuncs, qFrag gucCRels, qFrag gucRLS
|
||||
, qFrag gucDReps, qFrag gucMHdrs
|
||||
]
|
||||
decodeThem :: HD.Result QueryTimings
|
||||
decodeThem = HD.singleRow $
|
||||
QueryTimings
|
||||
<$> column HD.text <*> column HD.text <*> column HD.text
|
||||
<*> column HD.text <*> column HD.text <*> column HD.text
|
||||
<*> column HD.text
|
||||
<*> column HD.text <*> column HD.text
|
||||
|
||||
data QueryTimings = QueryTimings
|
||||
{ qtTables :: Text
|
||||
@@ -1194,6 +1280,7 @@ data QueryTimings = QueryTimings
|
||||
, qtRels :: Text
|
||||
, qtFuncs :: Text
|
||||
, qtCRels :: Text
|
||||
, qtRls :: Text
|
||||
, qtDReps :: Text
|
||||
, qtMHdrs :: Text
|
||||
} deriving (Show)
|
||||
@@ -1205,15 +1292,17 @@ queryTimingsWLabels qt =
|
||||
, (gucRels, qtRels qt)
|
||||
, (gucFuncs, qtFuncs qt)
|
||||
, (gucCRels, qtCRels qt)
|
||||
, (gucRLS, qtRls qt)
|
||||
, (gucDReps, qtDReps qt)
|
||||
, (gucMHdrs, qtMHdrs qt)
|
||||
]
|
||||
|
||||
gucTbls, gucKDeps, gucRels, gucFuncs, gucCRels, gucDReps, gucMHdrs :: ByteString
|
||||
gucTbls, gucKDeps, gucRels, gucFuncs, gucCRels, gucRLS, gucDReps, gucMHdrs :: ByteString
|
||||
gucTbls = "tables"
|
||||
gucKDeps = "keydeps"
|
||||
gucRels = "rels"
|
||||
gucFuncs = "funcs"
|
||||
gucCRels = "comprels"
|
||||
gucRLS = "rls"
|
||||
gucDReps = "dreps"
|
||||
gucMHdrs = "mhandlers"
|
||||
|
||||
@@ -34,6 +34,13 @@ data Table = Table
|
||||
-- single-element list.
|
||||
, tableUniqueCols :: [[FieldName]]
|
||||
, tableColumns :: ColumnMap
|
||||
, tableRlsEditQual :: Maybe Text
|
||||
-- ^ Combined RLS UPDATE USING qualifier, COALESCE-wrapped. Nothing means
|
||||
-- the table has no row-level edit restriction to surface (RLS disabled or
|
||||
-- no applicable UPDATE policy).
|
||||
, tableRlsDeleteQual :: Maybe Text
|
||||
-- ^ Combined RLS DELETE USING qualifier, COALESCE-wrapped. Nothing means
|
||||
-- the table has no row-level delete restriction to surface.
|
||||
}
|
||||
deriving (Show, Generic, JSON.ToJSON)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user