角色继承

AGENTS.md

@@ -28,5 +28,5 @@
 - 改动说明只在交流中记录。
 
 ## 当前重点
-- 主线已完成：高级优化器 → 并行查询 → M1 会话隔离 → M2 快照事务 → M3 WAL 与崩溃恢复 → M4 表结构进 WAL → M5 系统表统一命名 → M6 检查点按 LSN 部分截断 → M7 事务写写冲突检测 → M8 事务保存点。
+- 主线已完成：高级优化器 → 并行查询 → M1 会话隔离 → M2 快照事务 → M3 WAL 与崩溃恢复 → M4 表结构进 WAL → M5 系统表统一命名 → M6 检查点按 LSN 部分截断 → M7 事务写写冲突检测 → M8 事务保存点 → M9 角色继承。
 - 进度与计数见 `agent_credientials/project-plan.txt`，限制与风险见 `agent_credientials/known-issues.txt`。

chusql-server/src/ChuSQL/Server/Catalog.hs

@@ -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])

chusql-server/src/ChuSQL/Server/Privileges.hs

@@ -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)

chusql-server/test/Spec.hs

@@ -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 ()
+
 -- 真存储夹具：一个用例一份数据目录，跑完关链路删干净
 
 -- | 本次用例的数据目录（用例串行跑，固定名够用）

docs/architecture.md

@@ -53,6 +53,6 @@ chusql-server
 
 WAL 负责崩溃恢复：每条记录带自增 LSN，一组写操作与一条提交标记一次落盘；每组提交在数据和字典都刷盘之后把 `wal.checkpoint` 推进到这条提交的 LSN，含义是「到此为止的改动都已落盘」，再按这个边界丢掉日志前缀——所以日志里通常只有当组在飞的记录。进程重启时只重放检查点之后的记录，按标记分组取已提交的组、丢弃没有标记的整组，重放前逐条做幂等检查作为第二道保险，结束后再把检查点推到最后一条提交。LSN 从检查点与文件尾里较大的那个续号，跨重启单调，`SystemStatus` 应答里的 `last_lsn` 报告该检查点 LSN。建表、删表、建索引、删索引与数据改动走同一条 WAL，恢复时一并重放。
 
-系统数据库及部分管理操作仅允许管理员访问。系统表统一用 `__system_` 前缀：账号表 `__system_users` 对语句通道隐藏，角色、授权、成员三张表（`__system_roles` / `__system_grants` / `__system_members`）只在 `system` 库里可见，权限服务自身也通过 SQL 读写它们；存储启动时把旧名 `sys_roles` / `sys_grants` / `sys_members` 连同数据与索引文件一起迁移过来。
+系统数据库及部分管理操作仅允许管理员访问。系统表统一用 `__system_` 前缀：账号表 `__system_users` 对语句通道隐藏，角色、授权、成员三张表（`__system_roles` / `__system_grants` / `__system_members`）只在 `system` 库里可见，权限服务自身也通过 SQL 读写它们；存储启动时把旧名 `sys_roles` / `sys_grants` / `sys_members` 连同数据与索引文件一起迁移过来。角色支持互相继承：`GRANT 角色 A TO 角色 B` 记一条 B 属于 A 的成员关系，判定权限时沿成员关系算出向上闭包再取并集；写入时拒绝成环与自继承，删角色会清掉它两个方向的成员关系。
 
 服务监听地址、端口和请求限制可在 `chusql.toml` 的 `[server]` 分区中配置。

docs/commands.md

@@ -89,15 +89,20 @@ DROP USER alice;
 
 ```sql
 CREATE ROLE analyst;
+CREATE ROLE reviewer;
 GRANT SELECT ON orders TO analyst;
-GRANT analyst TO alice;
+GRANT analyst TO reviewer;
+GRANT reviewer TO alice;
 REVOKE SELECT ON orders FROM analyst;
-REVOKE analyst FROM alice;
+REVOKE analyst FROM reviewer;
+REVOKE reviewer FROM alice;
 DROP ROLE analyst;
 ```
 
 当前表级权限包括：`SELECT`、`INSERT`、`UPDATE`、`DELETE` 和 `ALL`。
 
+角色可以互相继承：`GRANT analyst TO reviewer` 让 `reviewer` 拿到 `analyst` 的授权，并把 `analyst` 记为 `reviewer` 的成员；继承会沿成员关系传递，成环的授权被拒绝（报 `conflict`），自继承同样拒绝。删角色时它的两向成员关系一起清掉。被授权者是不是角色，看名字是否在 `__system_roles` 里；用户名与角色名同名时按角色算。
+
 管理员拥有完整权限；数据库、表、索引等结构管理操作仅允许管理员执行。
 
 系统数据库 `system` 仅允许管理员访问。