修复错误，优化性能，实现类型系统，优化安装卸载过程

chusql-server/app/Main.hs

@@ -12,7 +12,6 @@ import ChuSQL.Interface.Config (
     rootUserName,
  )
 import ChuSQL.Interface.RateLimit (newRateLimiter)
-import ChuSQL.Interface.Settings (readSettingsFile)
 import ChuSQL.Interface.TOML (resolveConfigPath)
 import ChuSQL.Server.Accounts (administratorPasswordless)
 import ChuSQL.Server.Backend (Backend (..), ipcBackend)
@@ -69,7 +68,7 @@ parseArgs = go emptyOptions
     go opts ("--help" : rest) = go opts{optHelp = True} rest
     go opts ("-h" : rest) = go opts{optHelp = True} rest
     go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
-    go opts ("--host" : v : rest) = go opts{optHost = Just v} rest
+    go opts ("--listen-host" : v : rest) = go opts{optHost = Just v} rest
     go opts ("--user" : v : rest) = go opts{optUser = Just (T.pack v)} rest
     go opts ("--port" : v : rest) = withInt "--port" v (\n -> go opts{optPort = Just n} rest)
     go opts ("--max-message" : v : rest) = withInt "--max-message" v (\n -> go opts{optMaxMessage = Just n} rest)
@@ -85,16 +84,16 @@ usage :: IO ()
 usage = do
     putStrLn "usage: chusql-server [options]"
     putStrLn ""
-    putStrLn "config: chusql.toml sits at a fixed place and holds every knob;"
-    putStrLn "        Windows: %APPDATA%\\ChuSQL\\chusql.toml"
-    putStrLn "        other:   $XDG_CONFIG_HOME/ChuSQL/chusql.toml (or ~/.config/ChuSQL/chusql.toml)"
-    putStrLn "        [storage] data_dir; [server] host/port/max_message/max_rows;"
-    putStrLn "        [web] user (administrator name; the password lives in the system table)"
+    putStrLn "config: settings.toml sits at a fixed place and holds every knob;"
+    putStrLn "        Windows: %APPDATA%\\ChuSQL\\settings.toml"
+    putStrLn "        other:   $XDG_CONFIG_HOME/ChuSQL/settings.toml (or ~/.config/ChuSQL/settings.toml)"
+    putStrLn "        [storage] data_dir/log_files; [server] listen_host/port/max_message/max_rows;"
+    putStrLn "        [web] listen_host/port and the limits; the administrator name only comes from --user"
     putStrLn ""
     putStrLn "  --config FILE          read that config file instead"
-    putStrLn "  --host H               listen address              ([server] host, default 127.0.0.1)"
+    putStrLn "  --listen-host H        listen address              ([server] listen_host, default 127.0.0.1)"
     putStrLn "  --port N               listen port                 ([server] port, default 7777)"
-    putStrLn "  --user NAME            administrator name          ([web] user, default root)"
+    putStrLn ("  --user NAME            administrator name          (default " ++ T.unpack defaultUser ++ ")")
     putStrLn "  --max-message N        max bytes per request line  ([server] max_message, default 1048576)"
     putStrLn "  --max-rows N           rows returned per query     ([server] max_rows, default 1000)"
     putStrLn ""
@@ -104,8 +103,8 @@ usage = do
     putStrLn ""
     putStrLn "storage: this process loads the chusql_core_storage library in-process and owns the data directory"
     putStrLn ""
-    putStrLn "administrator password: lives in the __system_users system table, never in chusql.toml"
-    putStrLn ("  the [web] user key only picks the administrator name (default " ++ T.unpack defaultUser ++ ")")
+    putStrLn "administrator password: lives in the __system_users system table, never in settings.toml"
+    putStrLn "  the administrator name comes from --user; settings.toml does not carry it"
     putStrLn ""
     putStrLn "first run: the installer calls csql-bootstrap, which creates the system catalog"
     putStrLn "  {\"method\":\"system_status\"} tells whether that happened; without it the server stops"
@@ -154,14 +153,15 @@ run opts = do
     configPath <- resolveConfigPath (optConfig opts)
     base <- loadWebConfigAt configPath
     let cfg = applyWebOptions base opts
-    saved <- readSettingsFile configPath
     legacy <- legacyPasswordKey configPath
-    let rootName = rootUserName cfg saved
+    let rootName = rootUserName cfg
     config <- applyServerOptions <$> loadServerConfigAt configPath <*> pure opts
     opened <- localStorageLink (Just configPath)
     case opened of
         Left err -> do
             putStrLn ("cannot open the storage library: " ++ err)
+            putStrLn "Stop all database processes, then try: csql-bootstrap repair --config <settings.toml>"
+            putStrLn "If data recovery is required, use csql-bootstrap recover; reset discards system identities and grants."
             exitFailure
         Right link -> do
             setStorageLink link
@@ -199,7 +199,8 @@ checkInitialized backend = do
             | statusInitialized value -> putStrLn "system:       ready (the catalog is initialized)"
         _ -> do
             putStrLn "!! the system catalog is not initialized; run the bootstrap program first:"
-            putStrLn "!!   csql-bootstrap --config <chusql.toml> --password-stdin"
+            putStrLn "!!   csql-bootstrap --config <settings.toml> --password-stdin"
+            putStrLn "!! For a damaged existing system catalog, stop all processes and try csql-bootstrap repair or recover."
             exitFailure
   where
     -- | 应答里的 initialized 是不是 true
@@ -247,3 +248,4 @@ printBanner cfg config configPath = do
         )
     putStrLn ("storage:      chusql_core_storage library " ++ version)
     putStrLn ("data dir:     " ++ orElse (wcDataDir cfg) "(from the config file, else the default)")
+    putStrLn ("log files:    " ++ wcLogFiles cfg)

chusql-server/chusql-server.cabal

@@ -2,11 +2,11 @@ cabal-version: 2.4
 
 name:           chusql-server
 version:        1.0.0
-synopsis:       ChuSQL 数据库服务器：TCP 端点 + 自家协议 + SQL 会话
-description:    ChuSQL 的数据库服务器。负责监听 TCP、一行一条 JSON 的自家协议、
-                登录与限流，并把用户 SQL 转交给 chusql-core-engine（存储则由进程内
-                的 chusql_core_storage 动态库承担）。Web 管理端与命令行客户端都只
-                通过这条 TCP 连接访问数据库。
+synopsis:       ChuSQL database server with TCP endpoints and SQL sessions
+description:    Provides the ChuSQL TCP server and newline-delimited JSON protocol,
+                authentication, rate limiting, and SQL sessions. SQL is executed by
+                chusql-core-engine with the in-process chusql_core_storage library.
+                Web and command-line clients access the database through TCP.
 build-type:     Simple
 
 library

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

@@ -3,7 +3,7 @@
 module ChuSQL.Server.Accounts (
     Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
     newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
-    ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot,
+    ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot, principalIsCatalogManager,
     authenticate, currentPrincipal,
     listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
 ) where
@@ -17,14 +17,15 @@ import ChuSQL.Server.Backend (Backend (..), currentStamp)
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Data.Char (isAlphaNum, isAscii, isAsciiLower, isAsciiUpper, isDigit)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.List (nub)
 import Data.Text (Text)
 import qualified Data.Text as T
 
--- 账号服务：管理员是系统表里名字固定的那一行，口令哈希存在表里，普通账号由管理员用 CREATE/ALTER/DROP USER 管理。
+-- 身份服务：按登录、最高权限和启用属性认证，管理身份与口令。
 
 data AccountError = AccountError Text Text deriving (Show, Eq)
 
--- | 当前身份：名字固定的管理员，或系统表里的一个普通账号
+-- | 当前认证身份与最高权限标志
 data Principal
     = Root Text
     | Ordinary Account
@@ -40,10 +41,16 @@ principalName :: Principal -> Text
 principalName (Root name) = name
 principalName (Ordinary a) = accountUser a
 
--- | 是不是名字固定的管理员
+-- | 判断身份是否具备最高权限
 principalIsRoot :: Principal -> Bool
 principalIsRoot (Root _) = True
-principalIsRoot (Ordinary _) = False
+principalIsRoot (Ordinary a) = accountIsSuperuser a && accountEnabled a && accountCanLogin a
+
+-- | 判断身份是否可管理系统目录
+principalIsCatalogManager :: Principal -> Bool
+principalIsCatalogManager principal = principalIsRoot principal || case principal of
+    Ordinary a -> accountSystemCatalogManager a && accountEnabled a && accountCanLogin a
+    Root _ -> True
 
 data Accounts = Accounts
     { acBackend :: Backend
@@ -110,13 +117,9 @@ validateUserName name
     -- | 该字符是否允许使用
     allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
 
--- | 校验新账号名，并挡掉管理员保留名
+-- | 校验新身份的名称
 validateNewName :: Accounts -> Text -> Either AccountError ()
-validateNewName service name = do
-    validateUserName name
-    if normalize name == rootName service
-        then Left (AccountError "bad_request" "the administrator name is reserved")
-        else Right ()
+validateNewName _ name = validateUserName name
 
 storageFailure :: AccountError
 storageFailure = AccountError "storage_error" "account storage unavailable"
@@ -141,24 +144,25 @@ readAccounts backend = fmap (either (const (Left storageFailure)) Right) (beAcco
 -- | 表里没有管理员那一行就补一行空哈希，表示还没设口令
 ensureRootAccount :: Backend -> Text -> IO (Either AccountError ())
 ensureRootAccount backend name = do
-    stored <- readAccounts backend
+    initialized <- beAccounts backend (ReqIdentityInitialize (normalize name))
+    let stored = either (const (Left storageFailure)) Right initialized
     case stored of
         Left err -> pure (Left err)
         Right accounts
             | any ((== normalize name) . accountUser) accounts -> pure (Right ())
             | otherwise -> do
                 created <- beAccounts backend (ReqAccountCreate (normalize name) "")
-                pure $ case created of
-                    Right _ -> Right ()
-                    Left "account already exists" -> Right ()
-                    Left _ -> Left storageFailure
+                case created of
+                    Right _ -> storageResult <$> beAccounts backend (ReqIdentityAlter (normalize name) Nothing (Just True) Nothing Nothing)
+                    Left "account already exists" -> pure (Right ())
+                    Left _ -> pure (Left storageFailure)
 
 -- | 管理员是不是还没设口令
 administratorPasswordless :: Backend -> Text -> IO Bool
 administratorPasswordless backend name = do
     stored <- readAccounts backend
     pure $ case stored of
-        Right accounts -> any (\a -> accountUser a == normalize name && T.null (accountHash a)) accounts
+        Right accounts -> any (\a -> accountUser a == normalize name && accountIsSuperuser a && accountEnabled a && accountCanLogin a && T.null (accountHash a)) accounts
         Left _ -> False
 
 -- | 按令牌解析当前身份，版本对不上即失效
@@ -174,8 +178,8 @@ currentUnlocked service token = do
                 account <- case filter ((== user) . accountUser) accounts of
                     [a] -> Right a
                     _ -> Left unauthorized
-                if revision == Just (accountRevision account)
-                    then Right (if user == rootName service then Root user else Ordinary account)
+                if revision == Just (accountRevision account) && accountEnabled account && accountCanLogin account
+                    then Right (if accountIsSuperuser account then Root user else Ordinary account)
                     else Left unauthorized
 
 -- | 加锁解析当前身份
@@ -185,28 +189,27 @@ currentPrincipal service token = withMVar (acLock service) $ \_ -> currentUnlock
 -- | 登录：比哈希，管理员未设口令时只收空口令
 authenticate :: Accounts -> Text -> Text -> IO (Either AccountError Text)
 authenticate service user password = withMVar (acLock service) $ \_ -> do
-    stored <- readAccounts (acBackend service)
+    initialized <- beAccounts (acBackend service) (ReqIdentityInitialize (rootName service))
+    let stored = either (const (Left storageFailure)) Right initialized
     case stored of
         Left err -> pure (Left err)
         Right accounts
-            | name == rootName service -> signInRoot accounts
+            | any (\a -> accountUser a == name && accountIsSuperuser a && accountEnabled a && accountCanLogin a) accounts -> signInRoot accounts
             | unset accounts -> pure (Left ordinaryRefused)
             | otherwise -> signInOrdinary accounts
   where
     name = normalize user
     ordinaryRefused = AccountError "forbidden" "this server only accepts the administrator"
-    -- | 管理员那一行还没设口令（或压根不在表里）
-    unset accounts = case filter ((== rootName service) . accountUser) accounts of
-        [a] -> T.null (accountHash a)
-        _ -> True
+    -- | 判断是否有已设置口令的登录管理员
+    unset accounts = not (any (\a -> accountIsSuperuser a && accountEnabled a && accountCanLogin a && not (T.null (accountHash a))) accounts)
     -- | 管理员登录
-    signInRoot accounts = case filter ((== rootName service) . accountUser) accounts of
+    signInRoot accounts = case filter ((== name) . accountUser) accounts of
         [a] | T.null (accountHash a) && T.null password -> issue a
-        [a] | not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
+        [a] | accountCanLogin a && accountEnabled a && not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
         _ -> pure (Left unauthorized)
     -- | 普通账号登录
     signInOrdinary accounts = case filter ((== name) . accountUser) accounts of
-        [a] | not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
+        [a] | accountCanLogin a && accountEnabled a && not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
         _ -> pure (Left unauthorized)
     -- | 记一次登录再发会话
     issue a = do
@@ -218,7 +221,7 @@ authenticate service user password = withMVar (acLock service) $ \_ -> do
 
 -- | 系统表里的账号清单（含管理员）
 listAccounts :: Accounts -> IO (Either AccountError [Account])
-listAccounts service = withMVar (acLock service) $ \_ -> readAccounts (acBackend service)
+listAccounts service = withMVar (acLock service) $ \_ -> fmap (fmap (filter (\a -> accountCanLogin a || not (T.null (accountHash a))))) (readAccounts (acBackend service))
 
 -- | 按用户名找一个账号
 findAccount :: Accounts -> Text -> IO (Either AccountError Account)
@@ -233,7 +236,7 @@ findAccount service name = withMVar (acLock service) $ \_ -> do
 
 -- | 建一个普通账号
 createUser :: Accounts -> Text -> Text -> IO (Either AccountError ())
-createUser service name password = withMVar (acLock service) $ \_ -> do
+createUser service name password = do
     policy <- accountsPolicy service
     case validateNewName service name >> passwordAllowed policy password of
         Left err -> pure (Left err)
@@ -243,22 +246,24 @@ createUser service name password = withMVar (acLock service) $ \_ -> do
 
 -- | 设账号口令；管理员不受口令策略约束，空口令即免密
 resetPassword :: Accounts -> Text -> Text -> IO (Either AccountError ())
-resetPassword service name password = withMVar (acLock service) $ \_ -> do
+resetPassword service name password = do
     policy <- accountsPolicy service
-    let admin = normalize name == rootName service
-        checked = if admin then validateUserName name else validateNewName service name >> passwordAllowed policy password
-    case checked of
+    stored <- readAccounts (acBackend service)
+    case stored of
         Left err -> pure (Left err)
-        Right () -> do
-            encoded <- if admin && T.null password then pure "" else hashPassword password
-            storageResult <$> beAccounts (acBackend service) (ReqAccountReset (normalize name) encoded)
+        Right identities -> do
+            let admin = any (\a -> accountUser a == normalize name && accountIsSuperuser a) identities
+                checked = if admin then validateUserName name else validateUserName name >> passwordAllowed policy password
+            case checked of
+                Left err -> pure (Left err)
+                Right () -> do
+                    encoded <- if admin && T.null password then pure "" else hashPassword password
+                    storageResult <$> beAccounts (acBackend service) (ReqAccountReset (normalize name) encoded)
 
 -- | 删一个普通账号
 dropUser :: Accounts -> Text -> IO (Either AccountError ())
-dropUser service name = withMVar (acLock service) $ \_ ->
-    if normalize name == rootName service
-        then pure (Left (AccountError "bad_request" "the administrator cannot be dropped"))
-        else case validateUserName name of
+dropUser service name =
+    case validateUserName name of
             Left err -> pure (Left err)
             Right () -> storageResult <$> beAccounts (acBackend service) (ReqAccountDrop (normalize name))
 
@@ -267,6 +272,7 @@ data AccountCommand
     = CreateAccount Text Text
     | ResetAccountPassword Text Text
     | DropAccount Text
+    | AlterAccountAttributes Text [(String, Bool)]
     deriving (Show, Eq)
 
 -- | 一条语句是不是账号管理语句
@@ -274,12 +280,42 @@ accountCommand :: Statement -> Maybe AccountCommand
 accountCommand (CreateUser name password) = Just (CreateAccount (T.pack name) (T.pack password))
 accountCommand (AlterUser name password) = Just (ResetAccountPassword (T.pack name) (T.pack password))
 accountCommand (DropUser name) = Just (DropAccount (T.pack name))
+accountCommand (AlterIdentity name attributes) = Just (AlterAccountAttributes (T.pack name) attributes)
 accountCommand _ = Nothing
 
--- | 执行一条账号管理命令；普通账号一律拒绝
+-- | 按目录管理权限执行账号命令
 runAccountCommand :: Accounts -> Principal -> AccountCommand -> IO (Either AccountError ())
-runAccountCommand _ (Ordinary _) _ = pure (Left (AccountError "forbidden" "administrator required"))
-runAccountCommand service (Root _) command = case command of
-    CreateAccount name password -> createUser service name password
-    ResetAccountPassword name password -> resetPassword service name password
-    DropAccount name -> dropUser service name
+runAccountCommand service principal command = withMVar (acLock service) $ \_ -> run
+  where
+    -- | 校验并执行身份管理权限
+    run
+        | not (principalIsCatalogManager principal) = pure (Left (AccountError "forbidden" "catalog manager required"))
+        | not (principalIsRoot principal) = do
+            identities <- readAccounts (acBackend service)
+            case identities of
+                Left err -> pure (Left err)
+                Right accounts
+                    | any (\a -> accountUser a == normalize (target command) && (accountIsSuperuser a || accountSystemCatalogManager a)) accounts
+                        || privilegedChange command -> pure (Left (AccountError "forbidden" "superuser required to manage privileged identities"))
+                    | otherwise -> execute
+        | otherwise = execute
+    -- | 获取身份管理的目标
+    target (CreateAccount name _) = name
+    target (ResetAccountPassword name _) = name
+    target (DropAccount name) = name
+    target (AlterAccountAttributes name _) = name
+    -- | 判断是否修改特权属性
+    privilegedChange (AlterAccountAttributes _ attributes) = any (\(key, _) -> key `elem` ["superuser", "system_catalog_manager"]) attributes
+    privilegedChange _ = False
+    -- | 执行已授权的身份命令
+    execute = executeWith (if principalIsRoot principal then service else service{acBackend = (acBackend service){beAccounts = \request -> beAccounts (acBackend service) (ReqCatalogManage request)}})
+    -- | 通过受限存储请求执行管理操作
+    executeWith managed = case command of
+        CreateAccount name password -> createUser managed name password
+        ResetAccountPassword name password -> resetPassword managed name password
+        DropAccount name -> dropUser managed name
+        AlterAccountAttributes name attributes
+            | length (nub (map fst attributes)) /= length attributes -> pure (Left (AccountError "bad_request" "duplicate identity attribute"))
+            | otherwise ->
+                storageResult <$> beAccounts (acBackend managed) (ReqIdentityAlter (normalize name)
+                    (lookup "login" attributes) (lookup "superuser" attributes) (lookup "enabled" attributes) (lookup "system_catalog_manager" attributes))

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

@@ -13,6 +13,7 @@ module ChuSQL.Server.Backend (
     membersTable,
     optionsTable,
     rolesTable,
+    scopeDdl,
     statementNeedsDatabase,
     statementTables,
     systemDatabaseName,
@@ -45,6 +46,7 @@ import Data.Text (Text)
 import Data.Time (getCurrentTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
 import qualified Data.Aeson as A
+import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text as T
 
@@ -75,6 +77,7 @@ columnsFromStatement :: Database -> Statement -> [String]
 columnsFromStatement db stmt = case prepare db stmt of
     Right (Select cols _ _ _ _ _) -> cols
     Right (SelectExpr items _ _ _ _ _) -> map fst items
+    Right ShowDomains -> ["domain", "base_type"]
     _ -> []
 
 -- | 走本地存储链路的后端
@@ -85,7 +88,7 @@ ipcBackend = do
             , beCatalog = do
                 response <- sendRequest (ReqInDatabase current ReqListCatalog)
                 pure $ case response of
-                    RespCatalog infos -> Right infos
+                    RespCatalog infos -> Right (filter (not . isDomainTable . tiTable) infos)
                     RespError err -> Left err
                     _ -> Left "unexpected catalog response"
             , bePing = do
@@ -134,8 +137,9 @@ ipcBackend = do
     -- 引擎侧的数据字典按当前库过滤之后键是裸表名，补前缀会让查表落空；
     -- 库名由 database 字段随请求带走，存储层自己按它分发。
     runIpc :: String -> String -> IO (Either String StatementResult)
-    runIpc current sql = case parseStatement sql of
+    runIpc current sql = case parseStatement sql >>= scopeDdl current of
         Left e -> pure (Left e)
+        Right stmt | null current && statementNeedsDatabase stmt -> pure (Left "no database selected")
         Right stmt -> do
             let env = sessionEnv current
             result <- runIPCStorageIn (runStatementM stmt) env
@@ -157,7 +161,7 @@ memoryBackend = memoryBackendWith False
 memoryBackendWith :: Bool -> String -> MVar Database -> Backend
 memoryBackendWith trusted name ref =
     Backend
-        { beStatement = \sql -> case parseStatement sql of
+        { beStatement = \sql -> case parseStatement sql >>= scopeDdl (if trusted then systemDatabaseName else name) of
             Left e -> pure (Left e)
             -- 内存夹具也有"库"的概念：USE 只能切到它有的两个名字（自己 + system），
             -- 与 beDatabases 口径一致；引擎的内存存储不实现库管理，所以拦在这里。
@@ -167,31 +171,47 @@ memoryBackendWith trusted name ref =
             Right stmt -> modifyMVar ref $ \db -> case runStatement (scoped db) stmt of
                 Left e -> pure (db, Left e)
                 Right (db', rows)
-                    | any (hidden . fst) db' -> pure (db, Left "reserved system table")
-                    | otherwise -> pure (filter (hidden . fst) db ++ db', Right (StatementResult (colsOf (scoped db) stmt rows) rows))
+                    | any (\(key, _) -> hidden key && not (domainKey key)) db' -> pure (db, Left "reserved system table")
+                    | otherwise -> pure (mergeScoped db db', Right (StatementResult (colsOf (scoped db) stmt rows) rows))
         , beCatalog = do
             db <- readMVar ref
-            pure (Right (map tableInfoOf (filter (not . internalTable . fst) db)))
+            pure (Right (map tableInfoOf (filter (not . internalTable . fst) (scoped db))))
         , bePing = pure True
         , beAccounts = \req -> do
             stamp <- currentStamp
             modifyMVar ref $ \db -> case memoryAccounts db stamp req of
                 Left err -> pure (db, Left err)
-                Right accounts -> pure ((usersTable, Table usersTable [("account", TStr)]
-                    [[("account", VStr (BL.unpack (A.encode a))) ] | a <- accounts] Nothing) : filter ((/= usersTable) . fst) db, Right accounts)
+                Right accounts -> case memoryAccounts db stamp ReqAccountsList of
+                    Left err -> pure (db, Left err)
+                    Right previous -> pure (case req of ReqAccountsList -> db; ReqCatalogManage ReqAccountsList -> db; _ -> storeMemoryIdentities db previous accounts, Right accounts)
         , beWithDatabase = withDatabase
         , beDatabases = pure (Right (nub [name, systemDatabaseName]))
         , beStorage = \_ -> pure (Left "storage is not available in this backend")
         , beSnapshot = Right . scoped <$> readMVar ref
-        , beApplyTransaction = \ops -> modifyMVar ref $ \db -> case applyTransactionMemory ops db of
+        , beApplyTransaction = \ops -> modifyMVar ref $ \db -> case applyTransactionMemory ops (scoped db) of
             Left err -> pure (db, Left err)
-            Right db' -> pure (db', Right ())
+            Right db' -> pure (mergeScoped db db', Right ())
         }
   where
     -- | 按视角过滤库里的表
-    scoped = if trusted then filter (not . blocked . fst) else visible
+    scoped db = [(lastTablePart key, table {tableName = lastTablePart key}) | (key, table) <- db, inScope key, domainKey key || not (hidden key)]
+    -- | 限定键只属于指定工作库
+    inScope key = case break (== '.') key of
+        (_, []) -> True
+        (database, _) -> T.toLower (T.pack database) == T.toLower (T.pack (if trusted then systemDatabaseName else name))
     -- | 该视角下要隐藏的表
-    hidden = if trusted then blocked else internalTable
+    hidden = (if trusted then blocked else internalTable) . lastTablePart
+    -- | 判断裸名或限定名是否为类型目录
+    domainKey = isDomainTable . lastTablePart
+    -- | 回写当前库并保留其他库和内部目录
+    mergeScoped original changed =
+        filter (\(key, _) -> not (inScope key) || (hidden key && not (domainKey key))) original
+            ++ [(storageKey original key, table) | (key, table) <- changed]
+    -- | 保留夹具中的原始数据库限定键
+    storageKey original key = case [saved | (saved, _) <- original, inScope saved, lastTablePart saved == key] of
+        saved : _ -> saved
+        [] | any (\(saved, _) -> inScope saved && '.' `elem` saved) original -> (if trusted then systemDatabaseName else name) ++ "." ++ key
+        [] -> key
     -- | 取结果列名，空结果回落到解析
     colsOf db stmt rows = case rows of
         [] -> columnsFromStatement db stmt
@@ -256,10 +276,10 @@ statementTables :: Statement -> [Text]
 statementTables stmt = nub (case stmt of
     Select{} ->
         tableRefsOf (selectFrom stmt)
-            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt))
+            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt) ++ map Col (selectCols stmt ++ selectGroupBy stmt ++ map fst (selectOrderBy stmt)))
     SelectExpr{} ->
         tableRefsOf (selectFrom stmt)
-            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems stmt))
+            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems stmt) ++ map Col (selectGroupBy stmt ++ map fst (selectOrderBy stmt)))
     Insert table _ rows -> T.pack table : concatMap exprTables (concat rows)
     Update table assigns cond -> T.pack table : concatMap exprTables (map snd assigns ++ maybe [] (: []) cond)
     Delete table cond -> T.pack table : concatMap exprTables (maybe [] (: []) cond)
@@ -277,7 +297,52 @@ statementTables stmt = nub (case stmt of
 
 -- | 语句需不需要一个当前库：出现的表里有没写库名的就必须要
 statementNeedsDatabase :: Statement -> Bool
-statementNeedsDatabase stmt = any (not . T.any (== '.')) (statementTables stmt)
+statementNeedsDatabase stmt = case stmt of
+    CreateTable{} -> True
+    DropTable{} -> True
+    CreateIndex{} -> True
+    DropIndex{} -> True
+    DropColumn{} -> True
+    AddColumn{} -> True
+    RenameColumn{} -> True
+    AlterColumnType{} -> True
+    AlterColumnDefault{} -> True
+    AlterColumnNull{} -> True
+    CreateDomain{} -> True
+    DropDomain{} -> True
+    ShowDomains -> True
+    _ -> not (null (statementTables stmt))
+
+-- | 将当前库限定的结构目标转为裸表名
+scopeDdl :: String -> Statement -> Either String Statement
+scopeDdl current statement = case statement of
+    CreateTable table columns -> (\key -> CreateTable key columns) <$> target table
+    DropTable table -> DropTable <$> target table
+    CreateIndex table column -> (\key -> CreateIndex key column) <$> target table
+    DropIndex table column -> (\key -> DropIndex key column) <$> target table
+    DropColumn table column -> (\key -> DropColumn key column) <$> target table
+    AddColumn table column -> (\key -> AddColumn key column) <$> target table
+    RenameColumn table old new -> (\key -> RenameColumn key old new) <$> target table
+    AlterColumnType table column ty -> (\key -> AlterColumnType key column ty) <$> target table
+    AlterColumnDefault table column value -> (\key -> AlterColumnDefault key column value) <$> target table
+    AlterColumnNull table column nullable -> (\key -> AlterColumnNull key column nullable) <$> target table
+    _ -> statement <$ mapM_ checkReadTarget (statementTables statement)
+  where
+    -- | 数据引用限定在当前工作库
+    checkReadTarget table
+        | null current = Left "no database selected"
+        | otherwise = case T.breakOn "." table of
+            (_, suffix) | T.null suffix -> Right ()
+            (database, _) | T.toLower database == T.toLower (T.pack current) -> Right ()
+            _ -> Left ("table is outside the current database: " ++ T.unpack table)
+    -- | 校验库限定名并取当前库中的表名
+    target table
+        | null current = Left "no database selected"
+        | otherwise = case break (== '.') table of
+            (_, []) -> Right table
+            (database, '.' : key)
+                | T.toLower (T.pack database) == T.toLower (T.pack current) -> Right key
+            _ -> Left ("DDL target is outside the current database: " ++ table)
 
 -- | FROM 子句里的所有表
 tableRefsOf :: FromClause -> [Text]
@@ -289,6 +354,7 @@ tableRefsOf (FromJoin _ left right cond) = tableRefsOf left ++ tableRefsOf right
 -- | 表达式里出现的表（子查询是唯一的来路）
 exprTables :: Expr -> [Text]
 exprTables expr = case expr of
+    Col column | [database, table, _] <- T.splitOn "." (T.pack column) -> [database <> "." <> table]
     ScalarSub sub -> statementTables (subqueryStatement sub)
     ExistsSub sub _ -> statementTables (subqueryStatement sub)
     InSub value sub _ -> exprTables value ++ statementTables (subqueryStatement sub)
@@ -395,10 +461,6 @@ internalTable name = reserved name || privilegeTable name
 blocked :: String -> Bool
 blocked name = reserved name && not (privilegeTable name)
 
--- | 去掉内部表
-visible :: Database -> Database
-visible = filter (not . internalTable . fst)
-
 -- | 当前 UTC 时间，写法与引擎的 timestamp 一致
 currentStamp :: IO T.Text
 currentStamp = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> getCurrentTime
@@ -406,26 +468,98 @@ currentStamp = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> get
 -- | 在内存账号表上执行一条账号请求
 memoryAccounts :: Database -> T.Text -> Request -> Either String [Account]
 memoryAccounts db stamp req = do
-    accounts <- case lookup usersTable db of
-        Nothing -> Right []
-        Just table -> mapM decodeAccount (tableRows table)
+    stored <- case lookup "__system_identities" db of
+        Just table -> mapM decodeCredential (tableRows table)
+        Nothing -> case lookup usersTable db of
+            Nothing -> Right []
+            Just table -> mapM decodeAccount (tableRows table)
+    let accounts = stored
+        highWater = maximum (0 : map accountId accounts ++ [toInteger n | row <- maybe [] tableRows (lookup "__system_identity_sequence" db), Just (VInt n) <- [lookup "id" row]])
+        legacyNames = [T.toLower (T.pack name) | row <- maybe [] tableRows (lookup rolesTable db), Just (VStr name) <- [lookup "name" row]]
     case req of
+        ReqCatalogManage command -> do
+            let target = case command of
+                    ReqAccountCreate name _ -> Just name
+                    ReqAccountReset name _ -> Just name
+                    ReqAccountDrop name -> Just name
+                    ReqIdentityAlter name _ Nothing _ Nothing -> Just name
+                    _ -> Nothing
+                allowed = case command of ReqAccountsList -> True; ReqAccountCreate{} -> True; ReqAccountReset{} -> True; ReqAccountDrop{} -> True; ReqIdentityAlter _ _ Nothing _ Nothing -> True; _ -> False
+            if not allowed || any (\a -> target == Just (accountUser a) && (accountIsSuperuser a || accountSystemCatalogManager a)) accounts
+                then Left "superuser required to manage privileged identities" else memoryAccounts db stamp command
         ReqAccountsList -> Right accounts
+        ReqIdentityInitialize admin
+            | any (`elem` map accountUser accounts) legacyNames || length (nub legacyNames) /= length legacyNames -> Left "identity name collision"
+            | otherwise -> Right ([if legacyIdentity a && accountUser a == T.toLower admin then a{accountIsSuperuser = True} else a | a <- accounts] ++
+                [Account (highWater + offset) role "" 1 stamp Nothing False False True False | (offset, role) <- zip [1..] legacyNames])
+        ReqRoleCreate u
+            | any ((== T.toLower u) . accountUser) accounts -> Left "identity already exists"
+            | otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) "" 1 stamp Nothing False False True False])
+        ReqIdentityAlter u login super enabled manager -> case filter ((== T.toLower u) . accountUser) accounts of
+            [_] -> preserveSuper [if accountUser a == T.toLower u then a{accountCanLogin = maybe (accountCanLogin a) id login,
+                accountIsSuperuser = maybe (accountIsSuperuser a) id super, accountEnabled = maybe (accountEnabled a) id enabled,
+                accountSystemCatalogManager = maybe (accountSystemCatalogManager a) id manager,
+                accountRevision = accountRevision a + 1} else a | a <- accounts] accounts
+            _ -> Left "unknown account"
         ReqAccountCreate u h
             | any ((== T.toLower u) . accountUser) accounts -> Left "account already exists"
-            | otherwise -> Right (accounts ++ [Account (1 + maximum (0 : map accountId accounts)) (T.toLower u) h 1 stamp Nothing])
+            | otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) h 1 stamp Nothing True False True False])
         ReqAccountReset u h -> case filter ((== T.toLower u) . accountUser) accounts of
             [_] -> Right [if accountUser x == T.toLower u then x{accountHash = h, accountRevision = accountRevision x + 1} else x | x <- accounts]
             _ -> Left "unknown account"
         ReqAccountLogin u at -> case filter ((== T.toLower u) . accountUser) accounts of
-            [_] -> Right [if accountUser x == T.toLower u then x{accountLastLoginAt = at} else x | x <- accounts]
-            _ -> Left "unknown account"
+            [a] | accountEnabled a && accountCanLogin a -> Right [if accountUser x == T.toLower u then x{accountLastLoginAt = at} else x | x <- accounts]
+            _ -> Left "identity cannot login"
         ReqAccountDrop u -> case filter ((== T.toLower u) . accountUser) accounts of
             [] -> Left "unknown account"
-            _ -> Right [x | x <- accounts, accountUser x /= T.toLower u]
+            _ -> preserveSuper [x | x <- accounts, accountUser x /= T.toLower u] accounts
         _ -> Left "invalid account request"
   where
-    -- | 把一行解回账号
+    -- | 判断旧格式身份是否缺少属性
+    legacyIdentity account = any (legacyRow (accountUser account)) (maybe [] tableRows (lookup usersTable db))
+    -- | 检查旧身份的元数据版本
+    legacyRow user row = case lookup "account" row of
+        Just (VStr encoded) -> case A.decode (BL.pack encoded) of
+            Just (A.Object fields) -> KM.lookup "user" fields == Just (A.String user) && not (KM.member "is_superuser" fields)
+            _ -> False
+        _ -> False
+    -- | 读取旧格式账号
     decodeAccount row = case lookup "account" row of
         Just (VStr encoded) -> A.eitherDecode (BL.pack encoded)
         _ -> Left "invalid account record"
+    -- | 合并身份与口令
+    decodeCredential row = do
+        identity <- decodeAccount row
+        case [hash | credential <- maybe [] tableRows (lookup usersTable db), lookup "id" credential == Just (VInt (fromInteger (accountId identity))), Just (VStr hash) <- [lookup "password_hash" credential]] of
+            [hash] -> Right identity{accountHash = T.pack hash}
+            _ -> Left "invalid identity credential"
+    -- | 保留启用的登录管理员
+    preserveSuper next old
+        | any activeSuper old && not (any activeSuper next) = Left "the last enabled login superuser cannot be removed"
+        | otherwise = Right next
+    -- | 判断可登录管理员
+    activeSuper a = accountEnabled a && accountCanLogin a && accountIsSuperuser a
+
+-- | 分开保存内存身份与口令并清理授权
+storeMemoryIdentities :: Database -> [Account] -> [Account] -> Database
+storeMemoryIdentities db previous accounts =
+    (usersTable, Table usersTable [("id", TInt), ("password_hash", TStr)] credentials Nothing) :
+    ("__system_identities", Table "__system_identities" [("account", TStr)] identities Nothing) :
+    ("__system_identity_sequence", Table "__system_identity_sequence" [("id", TInt)] [[("id", VInt highWater)]] Nothing) :
+    [(name, clean name table) | (name, table) <- db, name `notElem` [usersTable, "__system_identities", "__system_identity_sequence"]]
+  where
+    -- | 保存口令与身份编号
+    credentials = [[("id", VInt (fromInteger (accountId a))), ("password_hash", VStr (T.unpack (accountHash a)))] | a <- accounts]
+    -- | 保存不含口令的身份记录
+    identities = [[("account", VStr (BL.unpack (A.encode a{accountHash = ""})))] | a <- accounts]
+    -- | 保留已用编号上界
+    highWater = maximum (0 : map (fromInteger . accountId) accounts ++ [n | row <- maybe [] tableRows (lookup "__system_identity_sequence" db), Just (VInt n) <- [lookup "id" row]])
+    -- | 清理旧目录与失效的授权边
+    clean name table
+        | name == rolesTable = table{tableRows = []}
+        | name `elem` [grantsTable, optionsTable, membersTable] = table{tableRows = filter active (tableRows table)}
+        | otherwise = table
+    -- | 识别已经删除的身份
+    removed = [accountUser a | a <- previous, accountUser a `notElem` map accountUser accounts]
+    -- | 排除已删除身份的授权和成员边
+    active row = not (any (\field -> case lookup field row of Just (VStr value) -> T.pack value `elem` removed; _ -> False) ["role", "member"])

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

@@ -9,6 +9,7 @@ module ChuSQL.Server.Catalog
     , ensureCatalog
     , eachAction
     , readRoleNames
+    , readIdentities
     , insertRole
     , dropRole
     , readGrants
@@ -23,6 +24,7 @@ module ChuSQL.Server.Catalog
     ) where
 
 import ChuSQL.Core.Model (Row, Value (..))
+import ChuSQL.Core.Protocol (Account (..), Request (..))
 import ChuSQL.Interface.Actions (sqlLiteral)
 import ChuSQL.Interface.Protocol (Grant (..))
 import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, optionsTable, rolesTable)
@@ -102,21 +104,19 @@ readRows catalog table = fmap (fmap srRows) (beStatement (catBackend catalog) ("
 
 -- | 角色名清单
 readRoleNames :: Catalog -> IO (Either String [Text])
-readRoleNames catalog = fmap (fmap (map (normalizeRole . cell "name"))) (readRows catalog rolesTable)
+readRoleNames catalog = fmap (fmap (map accountUser)) (readIdentities catalog)
+
+-- | 读取统一身份目录
+readIdentities :: Catalog -> IO (Either String [Account])
+readIdentities catalog = beAccounts (catBackend catalog) ReqAccountsList
 
 -- | 新建一个角色
 insertRole :: Catalog -> Text -> IO (Either String ())
-insertRole catalog role = exec catalog (insertSql rolesTable ["name"] [normalizeRole role])
+insertRole catalog role = fmap (fmap (const ())) (beAccounts (catBackend catalog) (ReqRoleCreate (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)
-    fourth <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE member = " ++ roleLiteral role)
-    fifth <- exec catalog ("DELETE FROM " ++ optionsTable ++ " WHERE role = " ++ roleLiteral role)
-    pure (sequence_ [first, second, third, fourth, fifth])
+dropRole catalog role = fmap (fmap (const ())) (beAccounts (catBackend catalog) (ReqAccountDrop (normalizeRole role)))
 
 -- | 全部授权，都不带 grant option
 readGrants :: Catalog -> IO (Either String [Grant])

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

@@ -19,7 +19,8 @@ module ChuSQL.Server.Privileges (
 ) where
 
 import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalName)
+import ChuSQL.Core.Protocol (Account (..))
+import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalIsCatalogManager, principalName)
 import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
 import ChuSQL.Server.Backend (
     Backend (..),
@@ -43,6 +44,7 @@ import ChuSQL.Server.Catalog (
     readGrants,
     readMembers,
     readRoleNames,
+    readIdentities,
     removeGrant,
     removeGrantOption,
     removeMember,
@@ -104,6 +106,10 @@ runPrivilegeCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO
 runPrivilegeCommand service principal database command
     | needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected"))
     | principalIsRoot principal = withTables service (applyCommand service database command)
+    | principalIsCatalogManager principal = case command of
+        CreateRoleCommand{} -> withTables service (applyCommand service database command)
+        DropRoleCommand{} -> pure (Left forbidden)
+        _ -> withTables service (delegateCommand service principal database command)
     | otherwise = withTables service (delegateCommand service principal database command)
   where
     -- | 授权到具体对象时需要先选库
@@ -129,7 +135,7 @@ affectedAccounts service command = do
         GrantRoleCommand _ members -> members
         RevokeRoleCommand _ members -> members
     -- | 是角色就接着往下走它的成员，走过的名字不再走第二遍
-    walk roles seen [] = pure (reverse seen)
+    walk _ seen [] = pure (reverse seen)
     walk roles seen (name : rest)
         | name `elem` seen = walk roles seen rest
         | normalizeRole name `elem` roles = do
@@ -166,7 +172,7 @@ filterTables service principal database tables
 -- | 角色总览（REST 与测试用）
 listRoleViews :: Privileges -> IO (Either PrivilegeError [RoleView])
 listRoleViews service = withTables service $ do
-    names <- roleNames service
+    names <- fmap (fmap (map accountUser . filter (not . accountCanLogin))) (catalog (readIdentities (pvCatalog service)))
     case names of
         Left err -> pure (Left err)
         Right known -> sequence <$> mapM view (sort known)
@@ -221,14 +227,18 @@ grantsOfUser service user = do
     members <- catalog (readMembers (pvCatalog service))
     grants <- catalog (readGrants (pvCatalog service))
     options <- catalog (readGrantOptions (pvCatalog service))
-    roles <- roleNames service
+    roles <- catalog (readIdentities (pvCatalog service))
     pure $ do
         memberRows <- members
         grantRows <- grants
         optionRows <- options
-        known <- roles
-        let edges = roleEdges memberRows known
-            mine = closureUp edges [role | (role, member) <- memberRows, member == normalizeUser user]
+        identities <- roles
+        let known = map accountUser (filter accountEnabled identities)
+            disabled = map accountUser (filter (not . accountEnabled) identities)
+            activeMembers = [(role, member) | (role, member) <- memberRows, role `elem` known, member `notElem` disabled]
+            edges = roleEdges activeMembers known
+            mine = if normalizeUser user `elem` disabled then [] else closureUp edges
+                (normalizeUser user : [role | (role, member) <- activeMembers, member == normalizeUser user])
         pure [grant | grant <- grantRows ++ optionRows, grantRole grant `elem` mine]
 
 -- | 一个用户手里的 grant option，只有这些能再转授
@@ -356,7 +366,7 @@ revokeOne service role privilege object = do
 -- | 普通身份转授权：只放行 GRANT
 delegateCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
 delegateCommand service principal database command = case command of
-    GrantPrivilegesCommand privileges object role _ -> do
+    GrantPrivilegesCommand _ _ role _ -> do
         allowed <- requireRole service role
         case allowed of
             Left err -> pure (Left err)
@@ -431,4 +441,5 @@ cycleMember role member =
 
 -- | 存储错误转成权限错误
 storageError :: String -> PrivilegeError
+storageError "the last enabled login superuser cannot be removed" = PrivilegeError "bad_request" "the last enabled login superuser cannot be removed"
 storageError message = PrivilegeError "storage_error" ("privilege storage: " <> T.pack message)

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

@@ -26,7 +26,7 @@ module ChuSQL.Server.Session
     ) where
 
 import ChuSQL.Core.Model (Database, Row, Table (..), Value (..))
-import ChuSQL.Core.Protocol (Account, QueryResult (..), TxnOp (..), queryResultJson)
+import ChuSQL.Core.Protocol (Account (..), Request (..), QueryResult (..), TxnOp (..), queryResultJson)
 import ChuSQL.Core.Engine.Storage.IPC (TableInfo (..))
 import qualified ChuSQL.Core.Engine as Engine
 import qualified ChuSQL.Core.Engine.Error as E
@@ -35,9 +35,9 @@ import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
 import ChuSQL.Interface.AccountTable (systemTableInfo)
 import ChuSQL.Interface.Auth (defaultSessionPolicy, newSessionStore)
 import ChuSQL.Server.Accounts
-import ChuSQL.Server.Backend (Backend (..), StatementResult (..), columnsFromStatement)
+import ChuSQL.Server.Backend (Backend (..), StatementResult (..), columnsFromStatement, scopeDdl)
 import ChuSQL.Server.Policy (configurePasswordPolicy)
-import ChuSQL.Server.Privileges (PrivilegeCommand, PrivilegeError (..), Privileges, RoleView, affectedAccounts, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
+import ChuSQL.Server.Privileges (PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, affectedAccounts, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
 import Control.Exception (IOException, try)
 import Data.Bifunctor (first)
 import Data.Char (isAlpha, isAlphaNum)
@@ -164,7 +164,7 @@ switchDatabaseCoded :: Session -> Text -> IO (Either SessionError ())
 switchDatabaseCoded session rawName
     | not (isPlainIdentifier name) = pure (Left (SessionError "bad_request" ("not a plain database name: " <> name)))
     | name == "system" = do
-        admin <- sessionIsAdmin session
+        admin <- maybe False principalIsCatalogManager <$> readIORef (ssPrincipal session)
         if admin then go else pure (Left (SessionError "forbidden" "the system database is only available to the administrator"))
     | otherwise = go
   where
@@ -201,6 +201,7 @@ runStatementCoded session sql = case parseStatement (T.unpack sql) of
     Right (Savepoint name) -> savepointTransaction session (T.pack name)
     Right (RollbackToSavepoint name) -> rollbackToSavepoint session (T.pack name)
     Right (ReleaseSavepoint name) -> releaseSavepoint session (T.pack name)
+    Right ShowRoles -> showIdentities session
     Right statement
         | Just command <- accountCommand statement -> runAccount session command
         | Just command <- privilegeCommand statement -> runPrivilege session command
@@ -221,6 +222,8 @@ runStatementCoded session sql = case parseStatement (T.unpack sql) of
 transactionDdl :: Statement -> Bool
 transactionDdl statement = case statement of
     CreateTable{} -> True
+    CreateDomain{} -> True
+    DropDomain{} -> True
     DropTable{} -> True
     CreateIndex{} -> True
     DropIndex{} -> True
@@ -347,9 +350,10 @@ savepointIndex name entries =
 runInTransaction :: Session -> Statement -> IO (Either SessionError QueryResult)
 runInTransaction session statement = do
     existing <- readIORef (ssTransaction session)
+    current <- readIORef (ssCurrent session)
     case existing of
         Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
-        Just transaction -> case Engine.runStatement (txStaged transaction) statement of
+        Just transaction -> case scopeDdl (T.unpack current) statement >>= Engine.runStatement (txStaged transaction) of
             Left err -> pure (Left (engineErrorCode err))
             Right (staged, rows) -> do
                 writeIORef (ssTransaction session) (Just transaction {txStaged = staged})
@@ -535,18 +539,35 @@ currentBackend session = do
     name <- readIORef (ssCurrent session)
     pure (beWithDatabase (ssBackend session) (T.unpack name))
 
--- | 账号语句走账号服务，普通账号一律拒绝；改完通知受影响账号
+-- | 展示身份属性并隐藏口令
+showIdentities :: Session -> IO (Either SessionError QueryResult)
+showIdentities session = do
+    admin <- maybe False principalIsCatalogManager <$> readIORef (ssPrincipal session)
+    if not admin then pure (Left (SessionError "forbidden" "catalog manager required")) else do
+        result <- beAccounts (ssBackend session) ReqAccountsList
+        pure $ case result of
+            Left err -> Left (SessionError "storage_error" (T.pack err))
+            Right identities -> Right (QueryResult ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "created_at"]
+                [[VInt (fromInteger (accountId a)), VStr (T.unpack (accountUser a)), VBool (accountCanLogin a),
+                    VBool (accountIsSuperuser a), VBool (accountEnabled a), VBool (accountSystemCatalogManager a), VStr (T.unpack (accountRegisteredAt a))] | a <- identities]
+                (length identities) False Nothing)
+
+-- | 执行身份管理并通知受影响会话
 runAccount :: Session -> AccountCommand -> IO (Either SessionError QueryResult)
 runAccount session command = do
     who <- readIORef (ssPrincipal session)
     case who of
         Nothing -> pure (Left (SessionError "unauthorized" "sign in first"))
         Just principal -> do
+            affected <- case command of
+                AlterAccountAttributes name _ -> affectedAccounts (ssPrivileges session) (DropRoleCommand name)
+                DropAccount name -> affectedAccounts (ssPrivileges session) (DropRoleCommand name)
+                _ -> pure (accountCommandUsers command)
             result <- runAccountCommand (ssAccounts session) principal command
             case result of
                 Left err -> pure (Left (accountErrorOf err))
                 Right () -> do
-                    notifyChanged session (accountCommandUsers command)
+                    notifyChanged session affected
                     pure (Right (emptyResult Nothing))
 
 -- | 一条账号命令影响的账号
@@ -555,6 +576,7 @@ accountCommandUsers command = case command of
     CreateAccount _ _ -> []
     ResetAccountPassword name _ -> [name]
     DropAccount name -> [name]
+    AlterAccountAttributes name _ -> [name]
 
 -- | 角色语句走权限服务，普通账号拒绝；改完通知受影响账号
 runPrivilege :: Session -> PrivilegeCommand -> IO (Either SessionError QueryResult)

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

@@ -18,6 +18,7 @@ import ChuSQL.Interface.Policy (PasswordPolicy (..))
 import ChuSQL.Interface.Protocol (ClientRequest (..), ServerResponse (..), decodeRequest, encodeResponse, protocolVersion)
 import ChuSQL.Interface.RateLimit (RateLimiter, rateLimitBlock, rateLimitClear, rateLimitRecord)
 import qualified ChuSQL.Core.Engine.Error as E
+import ChuSQL.Core.Protocol (Account (..), Request (ReqIdentityInitialize))
 import ChuSQL.Server.Backend (Backend (..))
 import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, catalog, databases, newSessionWith, policyOf, reloadPolicy, roleViews, runStatementCoded, sessionIsAdmin, sessionUser)
 import Control.Concurrent (forkIO)
@@ -116,6 +117,12 @@ data ServerEnv = ServerEnv
 -- | 组装服务器环境：每个连接再各开一个会话
 newServerEnv :: Backend -> Text -> FilePath -> ServerConfig -> RateLimiter -> IO ServerEnv
 newServerEnv backend rootName settingsFile config limiter = do
+    migrated <- beAccounts backend (ReqIdentityInitialize rootName)
+    case migrated of
+        Left err -> ioError (userError ("identity migration failed: " ++ err ++ "; stop all processes and try csql-bootstrap repair --config <settings.toml>; use recover if data restoration is required"))
+        Right identities
+            | any (\a -> accountEnabled a && accountCanLogin a && accountIsSuperuser a) identities -> pure ()
+            | otherwise -> ioError (userError "identity migration failed: no enabled login superuser; stop all processes and try csql-bootstrap recover --config <settings.toml>; reset replaces system identities and grants")
     live <- newLiveConnections
     pure (ServerEnv backend rootName settingsFile config limiter live)
 

chusql-server/test/Spec.hs

@@ -5,7 +5,7 @@ module Main (main) where
 
 import ChuSQL.Core.Engine.Storage.IPC (
     Account (..),
-    Request (ReqAccountReset),
+    Request (ReqAccountReset, ReqAccountsList),
     TableInfo (..),
     closeConnection,
     localStorageLink,
@@ -82,7 +82,7 @@ import System.IO (
     noNewlineTranslation,
  )
 import System.Timeout (timeout)
-import Test.Hspec
+import Test.Hspec hiding (after, before)
 
 -- TCP 服务器测试：协议编解码、配置读取与真连服务器的端到端用例。
 
@@ -98,6 +98,149 @@ spec = do
     privilegeSpec
     transactionSpec
     ipcConcurrencySpec
+    identitySpec
+
+-- | 身份属性与权限边界的端到端测试
+identitySpec :: Spec
+identitySpec = describe "unified identities" $ do
+    it "lets catalog managers manage ordinary identities without gaining superuser" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> withConnection handle $ \manager -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "create user manager identified by 'Worker-Pass123!'"
+            changed <- tcpQuery admin "alter user manager system_catalog_manager"
+            asText (at "status" changed) `shouldBe` "result"
+            signed <- tcpLogin manager "manager" "Worker-Pass123!"
+            asBool (at "admin" signed) `shouldBe` False
+            created <- tcpQuery manager "create user managed identified by 'Worker-Pass123!'"
+            asText (at "status" created) `shouldBe` "result"
+            shown <- tcpQuery manager "show roles"
+            asText (at "status" shown) `shouldBe` "result"
+            switched <- tcpQuery manager "use system"
+            asText (at "status" switched) `shouldBe` "result"
+            mapM_ (\sql -> tcpQuery manager sql >>= \reply -> asText (at "code" reply) `shouldBe` "forbidden")
+                ["alter user manager superuser", "alter user managed system_catalog_manager", "alter user admin identified by 'Another-Pass123!'", "create database forbidden"]
+    it "does not inherit catalog management through role membership" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> withConnection handle $ \worker -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "create user worker identified by 'Worker-Pass123!'"
+            _ <- tcpQuery admin "create role catalog_admin"
+            _ <- tcpQuery admin "alter role catalog_admin system_catalog_manager"
+            _ <- tcpQuery admin "grant catalog_admin to worker"
+            _ <- tcpLogin worker "worker" "Worker-Pass123!"
+            denied <- tcpQuery worker "create user elevated identified by 'Worker-Pass123!'"
+            asText (at "code" denied) `shouldBe` "forbidden"
+    it "shares names and shows safe identity attributes" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \h -> do
+            _ <- tcpLogin h "admin" "s3cret"
+            _ <- tcpQuery h "create role reader"
+            conflict <- tcpQuery h "create user reader identified by 'Worker-Pass123!'"
+            asText (at "code" conflict) `shouldBe` "conflict"
+            _ <- tcpQuery h "create user alice identified by 'Worker-Pass123!'"
+            other <- tcpQuery h "create role alice"
+            asText (at "code" other) `shouldBe` "conflict"
+            shown <- tcpQuery h "show roles"
+            map asText (items (at "columns" shown)) `shouldBe` ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "created_at"]
+            asInt (at "rowCount" shown) `shouldBe` 3
+            reader <- tcpQuery h "alter role reader login nologin"
+            asText (at "code" reader) `shouldBe` "bad_request"
+    it "turns a role into a login identity and promotes by attribute" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> withConnection handle $ \worker -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "create role worker"
+            _ <- tcpQuery admin "alter role worker identified by 'Worker-Pass123!'"
+            denied <- tcpLogin worker "worker" "Worker-Pass123!"
+            asText (at "status" denied) `shouldBe` "error"
+            changed <- tcpQuery admin "alter role worker login superuser"
+            asText (at "status" changed) `shouldBe` "result"
+            allowed <- tcpLogin worker "worker" "Worker-Pass123!"
+            asBool (at "admin" allowed) `shouldBe` True
+            created <- tcpQuery worker "create role managed"
+            asText (at "status" created) `shouldBe` "result"
+    it "does not inherit the superuser attribute through membership" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> withConnection handle $ \alice -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "create user alice identified by 'Worker-Pass123!'"
+            _ <- tcpQuery admin "create role powerful"
+            _ <- tcpQuery admin "alter role powerful superuser"
+            _ <- tcpQuery admin "grant powerful to alice"
+            signed <- tcpLogin alice "alice" "Worker-Pass123!"
+            asBool (at "admin" signed) `shouldBe` False
+            denied <- tcpQuery alice "create role elevated"
+            asText (at "code" denied) `shouldBe` "forbidden"
+    it "treats a demoted configured administrator as ordinary" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "create user owner identified by 'Worker-Pass123!'"
+            _ <- tcpQuery admin "alter user owner superuser"
+            demoted <- tcpQuery admin "alter user admin nosuperuser"
+            asText (at "status" demoted) `shouldBe` "result"
+            withConnection handle $ \fresh -> do
+                signed <- tcpLogin fresh "admin" "s3cret"
+                asBool (at "admin" signed) `shouldBe` False
+                denied <- tcpQuery fresh "show roles"
+                asText (at "code" denied) `shouldBe` "forbidden"
+    it "protects the last enabled login superuser" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \h -> do
+            _ <- tcpLogin h "admin" "s3cret"
+            mapM_ (\sql -> tcpQuery h sql >>= \reply -> asText (at "code" reply) `shouldBe` "bad_request")
+                ["alter user admin disabled", "alter role admin nologin", "alter user admin nosuperuser", "drop user admin", "drop role admin"]
+            shown <- tcpQuery h "show roles"
+            asText (at "status" shown) `shouldBe` "result"
+    it "stops disabled role inheritance and disconnects its members" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> withConnection handle $ \alice -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "use test"
+            _ <- tcpQuery admin "create user alice identified by 'Worker-Pass123!'"
+            _ <- tcpQuery admin "create role reader"
+            _ <- tcpQuery admin "grant select on users to reader"
+            _ <- tcpQuery admin "grant reader to alice"
+            _ <- tcpLogin alice "alice" "Worker-Pass123!"
+            _ <- tcpQuery alice "use test"
+            before <- tcpQuery alice "select * from users"
+            asText (at "status" before) `shouldBe` "result"
+            changed <- tcpQuery admin "alter role reader disabled"
+            asText (at "status" changed) `shouldBe` "result"
+            refused <- tcpQuery alice "use test"
+            asText (at "code" refused) `shouldBe` "unauthorized"
+            tcpClosed alice
+            withConnection handle $ \fresh -> do
+                _ <- tcpLogin fresh "alice" "Worker-Pass123!"
+                _ <- tcpQuery fresh "use test"
+                after <- tcpQuery fresh "select * from users"
+                asText (at "code" after) `shouldBe` "forbidden"
+                escalation <- tcpQuery fresh "alter user alice superuser"
+                asText (at "code" escalation) `shouldBe` "forbidden"
+    it "disables login identities and invalidates their connections" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> withConnection handle $ \alice -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "create user alice identified by 'Worker-Pass123!'"
+            _ <- tcpLogin alice "alice" "Worker-Pass123!"
+            _ <- tcpQuery admin "alter user alice disabled"
+            refused <- tcpQuery alice "use test"
+            asText (at "code" refused) `shouldBe` "unauthorized"
+            tcpClosed alice
+            withConnection handle $ \fresh -> do
+                denied <- tcpLogin fresh "alice" "Worker-Pass123!"
+                asText (at "status" denied) `shouldBe` "error"
+                _ <- tcpQuery admin "alter user alice enabled"
+                allowed <- tcpLogin fresh "alice" "Worker-Pass123!"
+                asText (at "status" allowed) `shouldBe` "ok"
+    it "does not reuse dropped identity ids or permissions" $ withTcpServer defaultServerConfig $ \_ handle ->
+        withConnection handle $ \admin -> do
+            _ <- tcpLogin admin "admin" "s3cret"
+            _ <- tcpQuery admin "use test"
+            _ <- tcpQuery admin "create user alice identified by 'Worker-Pass123!'"
+            _ <- tcpQuery admin "grant select on users to alice"
+            before <- tcpQuery admin "show roles"
+            _ <- tcpQuery admin "drop user alice"
+            _ <- tcpQuery admin "create user alice identified by 'Worker-Pass123!'"
+            after <- tcpQuery admin "show roles"
+            at "rows" after `shouldNotBe` at "rows" before
+            withConnection handle $ \alice -> do
+                _ <- tcpLogin alice "alice" "Worker-Pass123!"
+                _ <- tcpQuery alice "use test"
+                denied <- tcpQuery alice "select * from users"
+                asText (at "code" denied) `shouldBe` "forbidden"
 
 -- 夹具：内存后端装在 MVar 里，跟 Web 测试同一套表
 
@@ -324,14 +467,14 @@ tcpSpec = do
                         fmap (sum . histBuckets) (lookup "id" (tiHistograms info)) `shouldBe` Just 5
                         lookup "name" (tiHistograms info) `shouldBe` Nothing
 
-    describe "server config ([server] in chusql.toml)" $ do
+    describe "server config ([server] in settings.toml)" $ do
         it "falls back to the defaults when the file has no server section" $ do
             path <- tcpConfigPath "server-default"
             removeIfExists path
             loadServerConfigAt path `shouldReturn` defaultServerConfig
-        it "reads host, port, max_message and max_rows" $ do
+        it "reads listen_host, port, max_message and max_rows" $ do
             path <- tcpConfigPath "server-keys"
-            BS.writeFile path "[server]\nhost = \"0.0.0.0\"\nport = 7777\nmax_message = 4096\nmax_rows = 7\n"
+            BS.writeFile path "[server]\nlisten_host = \"0.0.0.0\"\nport = 7777\nmax_message = 4096\nmax_rows = 7\n"
             config <- loadServerConfigAt path
             scHost config `shouldBe` "0.0.0.0"
             scPort config `shouldBe` 7777
@@ -554,7 +697,7 @@ tcpServerSpec = do
 
 -- | 一个普通账号
 testAccount :: Account
-testAccount = Account 0 "alice" "" 0 "" Nothing
+testAccount = Account 0 "alice" "" 0 "" Nothing True False True False
 
 -- | 权限用例传的当前库名
 testDatabase :: Text
@@ -724,6 +867,11 @@ privilegeSpec = describe "server privileges" $ do
         refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (CreateRoleCommand "reader")
         refused `shouldBe` Left (PrivilegeError "forbidden" "administrator required")
 
+    it "requires administrator privileges for domain commands" $ withPrivileges $ \service root -> do
+        authorizeSql service root "CREATE DOMAIN code AS INT" `shouldReturn` Right ()
+        authorizeSql service (Ordinary testAccount) "CREATE DOMAIN code AS INT"
+            `shouldReturn` Left (PrivilegeError "forbidden" "administrator required")
+
     it "authorizes the administrator on any statement" $ withPrivileges $ \service root ->
         case parseStatement "SELECT * FROM users" of
             Left err -> expectationFailure err
@@ -785,12 +933,9 @@ privilegeSpec = describe "server privileges" $ do
         created `shouldBe` Right ()
         views <- listRoleViews service
         fmap (map roleName) views `shouldBe` Right ["reader"]
-        -- 改名后真存储上仍要读得到角色表
+        stored <- beAccounts base ReqAccountsList
+        fmap (map (\a -> (accountUser a, accountCanLogin a))) stored `shouldBe` Right [("root", True), ("reader", False)]
         let system = beWithDatabase base "system"
-        stored <- beStatement system "SELECT * FROM __system_roles"
-        case stored of
-            Left err -> expectationFailure ("select __system_roles: " ++ err)
-            Right result -> concatMap (map snd) (srRows result) `shouldContain` [VStr "reader"]
         -- 账号表不给语句通道看到
         denied <- beStatement system "SELECT * FROM __system_users"
         case denied of
@@ -913,6 +1058,57 @@ intValues rows = [n | row <- rows, Just (VInt n) <- [nth 0 row]]
 -- | 显式事务用例
 transactionSpec :: Spec
 transactionSpec = describe "server transactions" $ do
+    it "filters qualified memory tables and preserves other databases on writes" $ do
+        let local = Table "users" [("id", TInt)] [[("id", VInt 1)]] Nothing
+            otherTable = Table "users" [("id", TInt)] [[("id", VInt 2)]] Nothing
+        ref <- newMVar [("test.users", local), ("other.users", otherTable)]
+        let backend = memoryBackend "test" ref
+        selected <- beStatement backend "SELECT id FROM users"
+        fmap srRows selected `shouldBe` Right [[("id", VInt 1)]]
+        tables <- beCatalog backend
+        fmap (map tiTable) tables `shouldBe` Right ["users"]
+        updated <- beStatement backend "UPDATE users SET id = 3"
+        fmap (const ()) updated `shouldBe` Right ()
+        snapshot <- beSnapshot (memoryBackend "other" ref)
+        fmap (map (tableRows . snd)) snapshot `shouldBe` Right [[[ ("id", VInt 2) ]]]
+    it "rejects cross-database reads and writes including nested queries" $ withMemorySession $ \session -> do
+        mapM_ (\query -> do
+            result <- runStatementCoded session query
+            failureMessage result `shouldSatisfy` T.isInfixOf "outside the current database")
+            [ "SELECT * FROM other.users"
+            , "UPDATE other.users SET age = 1"
+            , "DELETE FROM other.users"
+            , "INSERT INTO other.users (id) VALUES (99)"
+            , "SELECT * FROM users WHERE id IN (SELECT id FROM other.users)"
+            , "SELECT other.users.id FROM users"
+            ]
+        void (mustSql session "BEGIN")
+        result <- runStatementCoded session "SELECT * FROM other.users"
+        failureMessage result `shouldSatisfy` T.isInfixOf "outside the current database"
+        void (mustSql session "ROLLBACK")
+    it "redacts malformed password statements through the session" $ withMemorySession $ \session -> do
+        result <- runStatementCoded session "ALTER USER alice IDENTIFIED BY 'private-secret' trailing"
+        failureMessage result `shouldSatisfy` T.isInfixOf "syntax"
+        failureMessage result `shouldSatisfy` (not . T.isInfixOf "private-secret")
+    it "resolves current database qualifiers for memory DDL" $ withMemorySession $ \session -> do
+        _ <- mustSql session "CREATE TABLE test.qualified (id INT)"
+        _ <- mustSql session "ALTER TABLE test.qualified ADD COLUMN value INT DEFAULT 8"
+        _ <- mustSql session "INSERT INTO qualified (id) VALUES (1)"
+        rows <- mustSql session "SELECT value FROM test.qualified"
+        intValues (qrRows rows) `shouldBe` [8]
+        void (mustSql session "DROP TABLE test.qualified")
+
+    it "uses domain columns in snapshot transactions and rejects domain DDL" $ withMemorySession $ \session -> do
+        _ <- mustSql session "create domain code as int"
+        _ <- mustSql session "create table typed (id code)"
+        _ <- mustSql session "begin"
+        denied <- runStatementCoded session "drop domain code"
+        failureMessage denied `shouldBe` "DDL is not allowed in a transaction"
+        _ <- mustSql session "insert into typed (id) values (7)"
+        _ <- mustSql session "commit"
+        rows <- mustSql session "select id from typed"
+        intValues (qrRows rows) `shouldBe` [7]
+
     it "keeps uncommitted rows invisible to other sessions until COMMIT" $ withTwoSessions $ \writer reader -> do
         _ <- mustSql writer "begin"
         _ <- mustSql writer "insert into users (id, name, age) values (6, 'six', 26)"
@@ -1118,6 +1314,13 @@ withIpcStorage body = do
         Left err -> cleanIpc dir >> pendingWith ("cannot open the storage library: " ++ err)
         Right link -> do
             setStorageLink link
+            base <- ipcBackend
+            seeded <- beStorage base (A.object ["method" A..= ("bootstrap_system" :: Text), "user" A..= ("root" :: Text), "password_hash" A..= ("hash" :: Text)])
+            case seeded of
+                Left err -> expectationFailure err
+                Right value -> case value of
+                    A.Object fields -> KM.lookup "initialized" fields `shouldBe` Just (A.Bool True)
+                    _ -> expectationFailure "invalid bootstrap response"
             body `finally` (closeConnection >> cleanIpc dir)
 
 -- | 跑一条语句，出错就算用例失败
@@ -1141,6 +1344,70 @@ writeRows session ids done = do
 -- | 同一进程里开两个库：会话之间不串数据，也不互相挡路
 ipcConcurrencySpec :: Spec
 ipcConcurrencySpec = describe "server backend on the real storage" $ do
+    it "resolves DDL qualifiers without crossing database boundaries" $ withIpcStorage $ do
+        base <- ipcBackend
+        mustRun (beStatement base "CREATE DATABASE alpha")
+        mustRun (beStatement base "CREATE DATABASE beta")
+        let alpha = beWithDatabase base "alpha"
+            beta = beWithDatabase base "beta"
+        unselected <- beStatement base "CREATE TABLE alpha.t (id INT)"
+        fmap (const ()) unselected `shouldBe` Left "no database selected"
+        mustRun (beStatement alpha "CREATE TABLE alpha.t (id INT, value INT)")
+        duplicate <- beStatement alpha "CREATE TABLE t (id INT)"
+        fmap (const ()) duplicate `shouldSatisfy` either (const True) (const False)
+        mustRun (beStatement alpha "INSERT INTO t (id, value) VALUES (1, 7)")
+        mustRun (beStatement alpha "CREATE INDEX ON alpha.t (value)")
+        mustRun (beStatement alpha "DROP INDEX ON alpha.t (value)")
+        mustRun (beStatement alpha "ALTER TABLE alpha.t RENAME COLUMN value TO score")
+        mustRun (beStatement alpha "ALTER TABLE alpha.t ALTER COLUMN score TYPE BIGINT")
+        mustRun (beStatement alpha "ALTER TABLE alpha.t ALTER COLUMN score SET DEFAULT 9")
+        mustRun (beStatement alpha "ALTER TABLE alpha.t ALTER COLUMN score SET NOT NULL")
+        rows <- rowsOf (beStatement alpha "SELECT score FROM t")
+        intColumn "score" rows `shouldBe` [7]
+        crossed <- beStatement beta "DROP TABLE alpha.t"
+        fmap (const ()) crossed `shouldBe` Left "DDL target is outside the current database: alpha.t"
+        mustRun (beStatement alpha "ALTER TABLE alpha.t DROP COLUMN score")
+        mustRun (beStatement alpha "DROP TABLE alpha.t")
+        catalog <- beCatalog alpha >>= either fail pure
+        map tiTable catalog `shouldBe` []
+
+    it "isolates domain catalogs by database and hides them from table lists" $ withIpcStorage $ do
+        base <- ipcBackend
+        unselected <- beStatement base "SHOW DOMAINS"
+        fmap (const ()) unselected `shouldBe` Left "no database selected"
+        mustRun (beStatement base "CREATE DATABASE alpha")
+        mustRun (beStatement base "CREATE DATABASE beta")
+        let alpha = beWithDatabase base "alpha"
+            beta = beWithDatabase base "beta"
+        mustRun (beStatement alpha "CREATE DOMAIN code AS INT")
+        mustRun (beStatement beta "CREATE DOMAIN code AS VARCHAR(3)")
+        mustRun (beStatement alpha "CREATE TABLE typed (id code)")
+        mustRun (beStatement beta "CREATE TABLE typed (id code)")
+        mustRun (beStatement alpha "INSERT INTO typed (id) VALUES (1)")
+        mustRun (beStatement beta "INSERT INTO typed (id) VALUES ('abc')")
+        catalog <- beCatalog alpha >>= either fail pure
+        map tiTable catalog `shouldBe` ["typed"]
+        domains <- rowsOf (beStatement beta "SHOW DOMAINS")
+        domains `shouldBe` [[("domain", VStr "code"), ("base_type", VStr "varchar(3)")]]
+        refused <- beStatement beta "INSERT INTO typed (id) VALUES (1)"
+        fmap (const ()) refused `shouldSatisfy` either (const True) (const False)
+
+    it "resolves nested domains only inside their own database" $ withIpcStorage $ do
+        base <- ipcBackend
+        mustRun (beStatement base "CREATE DATABASE alpha")
+        mustRun (beStatement base "CREATE DATABASE beta")
+        let alpha = beWithDatabase base "alpha"
+            beta = beWithDatabase base "beta"
+        mustRun (beStatement alpha "CREATE DOMAIN label AS VARCHAR(3)")
+        mustRun (beStatement alpha "CREATE DOMAIN product_label AS label")
+        absent <- beStatement beta "CREATE DOMAIN product_label AS label"
+        fmap (const ()) absent `shouldBe` Left "unknown domain: label"
+        mustRun (beStatement alpha "CREATE TABLE products (name product_label)")
+        mustRun (beStatement alpha "INSERT INTO products (name) VALUES ('abc')")
+        rowsOf (beStatement alpha "SELECT name FROM products") `shouldReturn` [[("name", VStr "abc")]]
+        dependency <- beStatement alpha "DROP DOMAIN label"
+        fmap (const ()) dependency `shouldSatisfy` either (const True) (const False)
+
     it "keeps two databases apart" $ withIpcStorage $ do
         base <- ipcBackend
         mustRun (beStatement base "CREATE DATABASE alpha")