角色继承
This commit is contained in:
LIm1tZz7 committed
1 parent
e2997627a7
commit
39480e2f2e
6 files changed
+132
-18
No files matched your search
@@ -104,13 +104,14 @@ readRoleNames catalog = fmap (fmap (map (normalizeRole . cell "name"))) (readRow
|
||||
insertRole :: Catalog -> Text -> IO (Either String ())
|
||||
insertRole catalog role = exec catalog (insertSql rolesTable ["name"] [normalizeRole role])
|
||||
|
||||
-- | 删掉一个角色，连同它的授权与成员
|
||||
-- | 删掉一个角色，连同它的授权与成员边
|
||||
dropRole :: Catalog -> Text -> IO (Either String ())
|
||||
dropRole catalog role = do
|
||||
first <- exec catalog ("DELETE FROM " ++ rolesTable ++ " WHERE name = " ++ roleLiteral role)
|
||||
second <- exec catalog ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role)
|
||||
third <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role)
|
||||
pure (sequence_ [first, second, third])
|
||||
fourth <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE member = " ++ roleLiteral role)
|
||||
pure (sequence_ [first, second, third, fourth])
|
||||
|
||||
-- | 全部授权
|
||||
readGrants :: Catalog -> IO (Either String [Grant])
|
||||
|
||||
@@ -176,17 +176,33 @@ checkAll database grants needed = case [pair | pair@(table, privilege) <- needed
|
||||
(\grant -> (grantObject grant == "*" || grantObject grant == target) && grantPrivilege grant == privilege)
|
||||
grants
|
||||
|
||||
-- | 一个用户实际能用的授权：他所属角色身上的那些
|
||||
-- | 一个用户实际能用的授权：所属角色加上继承来的
|
||||
grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
|
||||
grantsOfUser service user = do
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
grants <- catalog (readGrants (pvCatalog service))
|
||||
roles <- roleNames service
|
||||
pure $ do
|
||||
memberRows <- members
|
||||
grantRows <- grants
|
||||
let mine = [role | (role, member) <- memberRows, member == normalizeUser user]
|
||||
known <- roles
|
||||
let edges = roleEdges memberRows known
|
||||
mine = closureUp edges [role | (role, member) <- memberRows, member == normalizeUser user]
|
||||
pure [grant | grant <- grantRows, grantRole grant `elem` mine]
|
||||
|
||||
-- | 角色到角色的成员边：父角色在前
|
||||
roleEdges :: [(Text, Text)] -> [Text] -> [(Text, Text)]
|
||||
roleEdges members roles = [pair | pair@(_, child) <- members, child `elem` roles]
|
||||
|
||||
-- | 向上闭包：这群角色直接或间接所属的全部角色
|
||||
closureUp :: [(Text, Text)] -> [Text] -> [Text]
|
||||
closureUp edges = go
|
||||
where
|
||||
-- | 展开一轮，没有再新增就停
|
||||
go known =
|
||||
let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
|
||||
in if null more then known else go (known ++ more)
|
||||
|
||||
-- | 一个角色挂着的授权
|
||||
roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
|
||||
roleGrantsOf service role = do
|
||||
@@ -197,7 +213,7 @@ roleGrantsOf service role = do
|
||||
roleNames :: Privileges -> IO (Either PrivilegeError [Text])
|
||||
roleNames service = catalog (readRoleNames (pvCatalog service))
|
||||
|
||||
-- | 一个角色的成员清单
|
||||
-- | 一个角色的直接成员：用户与子角色
|
||||
membersOfRole :: Privileges -> Text -> IO (Either PrivilegeError [Text])
|
||||
membersOfRole service role = do
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
@@ -242,24 +258,46 @@ applyCommand service database command = case command of
|
||||
Right () ->
|
||||
eachAction (expandPrivileges privileges) $ \privilege ->
|
||||
catalog (removeGrant (pvCatalog service) role privilege (normalizeObject database object))
|
||||
GrantRoleCommand role users -> do
|
||||
GrantRoleCommand role members -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () ->
|
||||
eachAction users $ \user -> do
|
||||
known <- membersOfRole service role
|
||||
case known of
|
||||
Left err -> pure (Left err)
|
||||
Right members
|
||||
| normalizeUser user `elem` members -> pure (Right ())
|
||||
| otherwise -> catalog (addMember (pvCatalog service) role user)
|
||||
Right () -> do
|
||||
known <- roleNames service
|
||||
case known of
|
||||
Left err -> pure (Left err)
|
||||
Right roles -> eachAction members (grantMember service roles role)
|
||||
RevokeRoleCommand role users -> do
|
||||
allowed <- requireRole service role
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user)
|
||||
|
||||
-- | 加一条成员边：名字是角色就查环，否则当用户加
|
||||
grantMember :: Privileges -> [Text] -> Text -> Text -> IO (Either PrivilegeError ())
|
||||
grantMember service roles role member = do
|
||||
current <- membersOfRole service role
|
||||
case current of
|
||||
Left err -> pure (Left err)
|
||||
Right known
|
||||
| normalizeUser member `elem` known -> pure (Right ())
|
||||
| normalizeRole member `notElem` roles -> catalog (addMember (pvCatalog service) role member)
|
||||
| otherwise -> do
|
||||
edges <- membershipEdges service
|
||||
case edges of
|
||||
Left err -> pure (Left err)
|
||||
Right pairs
|
||||
| normalizeRole member `elem` closureUp pairs [normalizeRole role] ->
|
||||
pure (Left (cycleMember role member))
|
||||
| otherwise -> catalog (addMember (pvCatalog service) role member)
|
||||
|
||||
-- | 只保留两端都是角色的成员边
|
||||
membershipEdges :: Privileges -> IO (Either PrivilegeError [(Text, Text)])
|
||||
membershipEdges service = do
|
||||
members <- catalog (readMembers (pvCatalog service))
|
||||
roles <- roleNames service
|
||||
pure (roleEdges <$> members <*> roles)
|
||||
|
||||
-- | 全程持锁，先保证系统表存在再跑动作
|
||||
withTables :: Privileges -> IO (Either PrivilegeError a) -> IO (Either PrivilegeError a)
|
||||
withTables service action = withCatalogLock (pvCatalog service) $ do
|
||||
@@ -287,6 +325,11 @@ forbidden = PrivilegeError "forbidden" "administrator required"
|
||||
unknownRole :: Text -> PrivilegeError
|
||||
unknownRole role = PrivilegeError "not_found" ("unknown role: " <> role)
|
||||
|
||||
-- | 角色成员成环的错误
|
||||
cycleMember :: Text -> Text -> PrivilegeError
|
||||
cycleMember role member =
|
||||
PrivilegeError "conflict" ("role membership would create a cycle: " <> normalizeRole role <> " and " <> normalizeRole member)
|
||||
|
||||
-- | 存储错误转成权限错误
|
||||
storageError :: String -> PrivilegeError
|
||||
storageError message = PrivilegeError "storage_error" ("privilege storage: " <> T.pack message)
|
||||
@@ -10,6 +10,7 @@ import ChuSQL.Core.Engine.Storage.IPC (
|
||||
localStorageLink,
|
||||
setStorageLink,
|
||||
)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Statement)
|
||||
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
|
||||
import ChuSQL.Core.Model (Database, Row, Table (..), Value (..), pattern TInt, pattern TStr)
|
||||
import ChuSQL.Interface.Auth (hashPasswordWith)
|
||||
@@ -480,6 +481,16 @@ withPrivileges body = do
|
||||
service <- newPrivileges (memoryBackend testDatabaseName db)
|
||||
body service (Root testRootName)
|
||||
|
||||
-- | 解析一条 SQL，失败就丢掉用例
|
||||
parseOrFail :: String -> IO Statement
|
||||
parseOrFail sql = case parseStatement sql of
|
||||
Left err -> expectationFailure err >> fail "statement did not parse"
|
||||
Right stmt -> pure stmt
|
||||
|
||||
-- | 用某个身份鉴权一条 SQL
|
||||
authorizeSql :: Privileges -> Principal -> String -> IO (Either PrivilegeError ())
|
||||
authorizeSql service principal sql = parseOrFail sql >>= authorize service principal testDatabase
|
||||
|
||||
-- | 权限与目录 API 用例
|
||||
privilegeSpec :: Spec
|
||||
privilegeSpec = describe "server privileges" $ do
|
||||
@@ -535,6 +546,49 @@ privilegeSpec = describe "server privileges" $ do
|
||||
views <- listRoleViews service
|
||||
views `shouldBe` Right []
|
||||
|
||||
it "inherits the grants of another role" $ withPrivileges $ \service root -> do
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"])
|
||||
linked <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["alice"])
|
||||
linked `shouldBe` Right ()
|
||||
-- 继承链上的授权跟着成员传上来
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right ()
|
||||
views <- listRoleViews service
|
||||
case views of
|
||||
Left err -> expectationFailure (show err)
|
||||
Right known -> do
|
||||
let membersOf name = concat [ms | view <- known, roleName view == name, ms <- [roleMembers view]]
|
||||
membersOf "reader" `shouldMatchList` ["writer"]
|
||||
membersOf "writer" `shouldMatchList` ["alice"]
|
||||
revoked <- runPrivilegeCommand service root testDatabase (RevokeRoleCommand "reader" ["writer"])
|
||||
revoked `shouldBe` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users"
|
||||
`shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
|
||||
it "refuses a role membership that would create a cycle" $ withPrivileges $ \service root -> do
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"])
|
||||
loop <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["reader"])
|
||||
loop `shouldBe` Left (PrivilegeError "conflict" "role membership would create a cycle: writer and reader")
|
||||
self <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["reader"])
|
||||
self `shouldBe` Left (PrivilegeError "conflict" "role membership would create a cycle: reader and reader")
|
||||
|
||||
it "drops the inherited edge together with the role" $ withPrivileges $ \service root -> do
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
|
||||
_ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"])
|
||||
_ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["alice"])
|
||||
dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader")
|
||||
dropped `shouldBe` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users"
|
||||
`shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON users")
|
||||
views <- listRoleViews service
|
||||
fmap (map roleMembers) views `shouldBe` Right [["alice"]]
|
||||
|
||||
it "refuses a command on a role that does not exist" $ withPrivileges $ \service root -> do
|
||||
missing <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "ghost")
|
||||
missing `shouldBe` Left (PrivilegeError "not_found" "unknown role: ghost")
|
||||
@@ -572,6 +626,17 @@ privilegeSpec = describe "server privileges" $ do
|
||||
Left _ -> pure ()
|
||||
Right result -> expectationFailure ("account table must stay hidden: " ++ show (srRows result))
|
||||
|
||||
it "inherits a role on the real storage" $ withIpcStorage $ do
|
||||
base <- ipcBackend
|
||||
service <- newPrivileges base
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader")
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer")
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
|
||||
_ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "reader" ["writer"])
|
||||
linked <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "writer" ["alice"])
|
||||
linked `shouldBe` Right ()
|
||||
authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right ()
|
||||
|
||||
-- 真存储夹具：一个用例一份数据目录，跑完关链路删干净
|
||||
|
||||
-- | 本次用例的数据目录（用例串行跑，固定名够用）
|
||||
|
||||
Reference in new issue
Block a user