大改，整理项目结构，完成rust ffi调用，写好tcp接口

2026-10-02 15:07:38 +08:00
1 parent df6d348995
commit 9758439b82
@@ -3,32 +3,28 @@
 module Main (main) where

 import ChuSQL.Web.API (AppEnv (..), Live (..), newAppEnvAt, setLive, webApp)
-import ChuSQL.Web.Auth (Credential (..), SessionPolicy (..), newSessionStore)
-import ChuSQL.Web.Backend (Backend, ipcBackend)
-import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
-import ChuSQL.Web.Config (
+import ChuSQL.Interface.Auth (Credential (..), SessionPolicy (..), setPayloadPolicy)
+import ChuSQL.Interface.Config (
+    ServerConfig (..),
    WebConfig (..),
    defaultPassword,
    defaultUser,
+    loadServerConfigAt,
    loadWebConfigAt,
    resolveCredential,
-    resolvePipeName,
+    resolvePlainPassword,
    resolveStaticDir,
+    rootUserName,
    staticDirCandidates,
    usingDefaultCredentials,
 )
-import ChuSQL.Web.RateLimit (newRateLimiter)
-import ChuSQL.Storage.IPC (setPipeName)
-import ChuSQL.Web.Settings (effectiveSettings, readSettingsFile)
-import ChuSQL.Web.TOML (resolveConfigPath)
-import ChuSQL.Web.StorageProcess (
-    StorageProcess (..),
-    findStorageServer,
-    startStorageProcess,
-    stopStorageProcess,
-    waitForStorage,
- )
-import Control.Exception (IOException, bracket, onException, try)
+import ChuSQL.Interface.Link (clientPing, closeClient, connectClient)
+import ChuSQL.Interface.RateLimit (newRateLimiter)
+import ChuSQL.Interface.Session (authenticateSession, newSession)
+import ChuSQL.Interface.Settings (effectiveSettings, readSettingsFile)
+import ChuSQL.Interface.TOML (resolveConfigPath)
+import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
+import Control.Exception (IOException, try)
 import Data.Char (toLower)
 import qualified Data.Map.Strict as Map
 import Data.String (fromString)
@@ -43,14 +39,13 @@ import System.Exit (exitFailure)
 import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
 import Text.Read (readMaybe)

-- Web 管理端入口：读配置、备凭据、拉起存储进程，最后起 Warp。
+-- Web 管理端入口：读配置，把请求转给拥有存储的 server，最后起 Warp。

 data Options = Options
    { optConfig :: Maybe FilePath
    , optHost :: Maybe String
    , optPort :: Maybe Int
    , optStatic :: Maybe FilePath
-    , optStorage :: Maybe FilePath
    , optUser :: Maybe Text
    , optCookieSecure :: Maybe Bool
    , optBodyLimit :: Maybe Int
@@ -74,7 +69,6 @@ emptyOptions =
        , optHost = Nothing
        , optPort = Nothing
        , optStatic = Nothing
-        , optStorage = Nothing
        , optUser = Nothing
        , optCookieSecure = Nothing
        , optBodyLimit = Nothing
@@ -94,13 +88,13 @@ emptyOptions =
 parseArgs :: [String] -> Either String Options
 parseArgs = go emptyOptions
  where
+    -- | 逐个参数累加进 Options
    go opts [] = Right opts
    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 ("--static" : v : rest) = go opts{optStatic = Just v} rest
-    go opts ("--storage" : v : rest) = go opts{optStorage = 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 ("--body-limit" : v : rest) = withInt "--body-limit" v (\n -> go opts{optBodyLimit = Just n} rest)
@@ -116,13 +110,15 @@ parseArgs = go emptyOptions
    go opts ("--cookie-secure" : v : rest) = go opts{optCookieSecure = Just (isTrue v)} rest
    go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)

+    -- | 解析一个整数参数
    withInt :: String -> String -> (Int -> Either String Options) -> Either String Options
    withInt name v k = maybe (Left (name ++ " needs an integer, got: " ++ v)) k (readMaybe v)

+    -- | 把 1/true/yes/on 认成真
    isTrue :: String -> Bool
    isTrue s = map toLower s `elem` ["1", "true", "yes", "on"]

-- | 帮助
+-- | 打印命令行用法
 usage :: IO ()
 usage = do
    putStrLn "usage: chusql-web [options]"
@@ -130,15 +126,14 @@ usage = do
    putStrLn "config: chusql.toml sits at a fixed place and its sections hold every knob below;"
    putStrLn "        Windows: %APPDATA%\\ChuSQL\\chusql.toml"
    putStrLn "        other:   $XDG_CONFIG_HOME/ChuSQL/chusql.toml (or ~/.config/ChuSQL/chusql.toml)"
-    putStrLn "        [web] host/port/static_dir/user/password and the limits; [server] pipe_name;"
+    putStrLn "        [web] host/port/static_dir/user/password and the limits;"
    putStrLn "        [storage] data_dir; [page] size; [btree] order; [buffer] pool_size; [log] level"
    putStrLn ""
    putStrLn "  --config FILE          read that config file instead ([web] host ...)"
    putStrLn "  --host H               listen address              ([web] host, default 127.0.0.1)"
-    putStrLn "  --port N               listen port                 ([web] port, default 7777)"
+    putStrLn "  --port N               listen port                 ([web] port, default 7778)"
    putStrLn "  --static DIR           static asset directory      ([web] static_dir, default static)"
    putStrLn "  --user NAME            administrator name          ([web] user, default root)"
-    putStrLn "  --storage SERVER       Rust storage exe to spawn   ([web] storage_server)"
    putStrLn "  --cookie-secure BOOL   add Secure to the cookie    ([web] cookie_secure, default false)"
    putStrLn "  --body-limit N         max request body bytes      ([web] body_limit, default 65536)"
    putStrLn "  --session-idle N       session idle timeout, sec   ([web] session_idle, default 28800)"
@@ -155,8 +150,10 @@ usage = do
    putStrLn "  an empty password means the administrator signs in with no password; ordinary accounts are then refused"
    putStrLn ("without either the demo administrator is " ++ T.unpack defaultUser ++ " / " ++ T.unpack defaultPassword)
    putStrLn "ordinary accounts: CREATE USER / ALTER USER / DROP USER from the SQL console (administrator only)"
-    putStrLn "storage process: [server] pipe_name says where to talk and where a spawned one listens;"
-    putStrLn "  [storage] data_dir, [page] size, [btree] order, [buffer] pool_size and [log] level are its own"
+    putStrLn "storage: the server owns the data directory and loads the chusql_core_storage library;"
+    putStrLn "  this process is a plain TCP client: every statement, lookup and account request goes to it"
+    putStrLn "  [server] host / port says where it listens; [storage] data_dir, [page] size, [btree] order,"
+    putStrLn "  [buffer] pool_size and [log] level are the server's own"

 -- | 命令行覆盖配置
 applyOptions :: WebConfig -> Options -> WebConfig
@@ -165,9 +162,6 @@ applyOptions cfg opts =
        { wcHost = orElse (optHost opts) (wcHost cfg)
        , wcPort = orElse (optPort opts) (wcPort cfg)
        , wcStaticDir = orElse (optStatic opts) (wcStaticDir cfg)
-        , wcStorageServer = case optStorage opts of
-            Just p -> Just p
-            Nothing -> wcStorageServer cfg
        , wcUser = orElse (optUser opts) (wcUser cfg)
        , wcCookieSecure = orElse (optCookieSecure opts) (wcCookieSecure cfg)
        , wcBodyLimit = orElse (optBodyLimit opts) (wcBodyLimit cfg)
@@ -182,21 +176,12 @@ applyOptions cfg opts =
        , wcSeedDemo = orElse (optSeedDemo opts) (wcSeedDemo cfg)
        }
  where
+    -- | 有就用新的，没有留旧值
    orElse :: Maybe a -> a -> a
    orElse (Just x) _ = x
    orElse Nothing y = y

-- | 配了存储进程路径就拉起来，没配就假设外面已经跑着
-startStorageIfWanted :: WebConfig -> FilePath -> IO (Either String (Maybe StorageProcess))
-startStorageIfWanted cfg configPath = case wcStorageServer cfg of
-    Nothing -> pure (Right Nothing)
-    Just given -> do
-        found <- findStorageServer (Just given)
-        case found of
-            Left e -> pure (Left e)
-            Right bin -> fmap (fmap Just) (startStorageProcess bin configPath)
-
-- | 入口
+-- | 程序入口
 main :: IO ()
 main = do
    hSetBuffering stdout LineBuffering
@@ -210,13 +195,12 @@ main = do
            | optHelp opts -> usage
            | otherwise -> run opts

-- | 起服务
+-- | 读配置装配环境，检查 server，起 Warp
 run :: Options -> IO ()
 run opts = do
    configPath <- resolveConfigPath (optConfig opts)
    base <- loadWebConfigAt configPath
    let cfg = applyOptions base opts
-    setPipeName (resolvePipeName cfg)
    foundStatic <- resolveStaticDir (wcStaticDir cfg)
    case foundStatic of
        Nothing -> do
@@ -224,44 +208,31 @@ run opts = do
            exitFailure
        Just staticDir -> do
            let settingsFile = configPath
+                policy = SessionPolicy (fromIntegral (wcSessionIdle cfg)) (fromIntegral (wcSessionMax cfg))
            saved <- readSettingsFile settingsFile
-            cred <- resolveCredential cfg saved
-            storage <- startStorageIfWanted cfg configPath
-            case storage of
-                Left err -> do
-                    putStrLn err
-                    exitFailure
-                Right maybeStorage -> do
-                    backend <- ipcBackend
-                    let policy =
-                            SessionPolicy
-                                (fromIntegral (wcSessionIdle cfg))
-                                (fromIntegral (wcSessionMax cfg))
-                    sessions <- newSessionStore getCurrentTime policy
-                    limiter <-
-                        newRateLimiter
-                            getCurrentTime
-                            (wcLoginMaxAttempts cfg)
-                            (fromIntegral (wcLoginWindow cfg))
-                    env0 <- newAppEnvAt settingsFile backend sessions cred limiter staticDir
-                        `onException` maybe (pure ()) stopStorageProcess maybeStorage
-                    let env =
-                            env0
-                                { aeCookieSecure = wcCookieSecure cfg
-                                , aeEffective = effectiveSettings cfg
-                                , aeLog = TIO.putStrLn
-                                }
-                    setLive env (liveFromConfig cfg)
-                    app <- webApp env
-                    printBanner cfg configPath staticDir maybeStorage
-                    reportCredential cred saved
-                    waitForStorageReport
-                    seedIfWanted cfg backend
-                    let settings =
-                            Warp.setPort (wcPort cfg) (Warp.setHost (fromString (wcHost cfg)) Warp.defaultSettings)
-                    case maybeStorage of
-                        Nothing -> serve settings app
-                        Just sp -> bracket (pure sp) stopStorageProcess (const (serve settings app))
+            config <- loadServerConfigAt settingsFile
+            limiter <-
+                newRateLimiter
+                    getCurrentTime
+                    (wcLoginMaxAttempts cfg)
+                    (fromIntegral (wcLoginWindow cfg))
+            env0 <- newAppEnvAt settingsFile (T.pack (scHost config)) (scPort config) limiter staticDir
+            let env =
+                    env0
+                        { aeCookieSecure = wcCookieSecure cfg
+                        , aeEffective = effectiveSettings cfg
+                        , aeLog = TIO.putStrLn
+                        }
+            setPayloadPolicy (aeSessions env) policy
+            setLive env (liveFromConfig cfg)
+            app <- webApp env
+            printBanner cfg configPath staticDir
+            reportCredential cfg saved
+            checkServer (aeServerHost env) (aeServerPort env)
+            seedIfWanted cfg saved (aeServerHost env) (aeServerPort env)
+            let settings =
+                    Warp.setPort (wcPort cfg) (Warp.setHost (fromString (wcHost cfg)) Warp.defaultSettings)
+            serve settings app

 -- | 本次启动的配置摊成热改参数
 liveFromConfig :: WebConfig -> Live
@@ -291,47 +262,63 @@ serve settings app = do
            exitFailure

 -- | 口令是从哪来的（用了内置默认口令就明确警告）
-reportCredential :: Credential -> Map.Map Text Text -> IO ()
-reportCredential cred saved
-    | usingDefaultCredentials saved = do
-        putStrLn ""
-        putStrLn "  !! Administrator credentials are not configured; the built-in demo password is in use:"
-        putStrLn ("  !!   user " ++ T.unpack (credUser cred) ++ " / password " ++ T.unpack defaultPassword)
-        putStrLn "  !!   set user / password in the [web] section of chusql.toml and restart"
-        putStrLn ""
-    | T.null (credEncoded cred) =
-        putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (passwordless: only the administrator may sign in)")
-    | otherwise = putStrLn ("administrator: " ++ T.unpack (credUser cred) ++ " (credentials come from the settings file only)")
+reportCredential :: WebConfig -> Map.Map Text Text -> IO ()
+reportCredential cfg saved = do
+    credential <- resolveCredential cfg saved
+    if usingDefaultCredentials saved
+        then do
+            putStrLn ""
+            putStrLn "  !! Administrator credentials are not configured; the built-in demo password is in use:"
+            putStrLn ("  !!   user " ++ T.unpack (credUser credential) ++ " / password " ++ T.unpack defaultPassword)
+            putStrLn "  !!   set user / password in the [web] section of chusql.toml and restart"
+            putStrLn ""
+        else
+            if T.null (credEncoded credential)
+                then putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved) ++ " (passwordless: only the administrator may sign in)")
+                else putStrLn ("administrator: " ++ T.unpack (rootUserName cfg saved) ++ " (credentials come from the settings file only)")

-- | 配了 seed 就补一份演示数据
-seedIfWanted :: WebConfig -> Backend -> IO ()
-seedIfWanted cfg backend
+-- | 配了 seed 就以管理员身份补演示数据
+seedIfWanted :: WebConfig -> Map.Map Text Text -> Text -> Int -> IO ()
+seedIfWanted cfg saved host port
    | not (wcSeedDemo cfg) = pure ()
    | otherwise = do
-        result <- seedDemo backend
-        case result of
-            Left e -> TIO.putStrLn ("demo data skipped: " <> T.pack e)
-            Right report ->
-                TIO.putStrLn
-                    ( "demo data: "
-                        <> (if null (srCreated report) then "already present" else "created " <> T.pack (unwords (srCreated report)))
-                        <> (if null (srSkipped report) then "" else ", kept " <> T.pack (unwords (srSkipped report)))
-                        <> (if null (srIndexes report) then "" else ", index on " <> T.pack (unwords (srIndexes report)))
-                    )
+        opened <- connectClient host port
+        case opened of
+            Left message -> TIO.putStrLn ("demo data skipped: " <> message)
+            Right client -> do
+                session <- newSession client
+                signed <- authenticateSession session (rootUserName cfg saved) (resolvePlainPassword saved)
+                case signed of
+                    Left message -> TIO.putStrLn ("demo data skipped: " <> message)
+                    Right () -> do
+                        result <- seedDemo session
+                        case result of
+                            Left message -> TIO.putStrLn ("demo data skipped: " <> message)
+                            Right report ->
+                                TIO.putStrLn
+                                    ( "demo data: "
+                                        <> (if null (srCreated report) then "already present" else "created " <> T.pack (unwords (srCreated report)))
+                                        <> (if null (srSkipped report) then "" else ", kept " <> T.pack (unwords (srSkipped report)))
+                                        <> (if null (srIndexes report) then "" else ", index on " <> T.pack (unwords (srIndexes report)))
+                                    )
+                closeClient client

-- | 报一下存储进程通不通
-waitForStorageReport :: IO ()
-waitForStorageReport = do
-    up <- waitForStorage 20
-    putStrLn
-        ( if up
-            then "storage:      up (endpoint answered ping)"
-            else "storage:      DOWN (no ping reply; start the Rust storage process or pass --storage)"
-        )
+-- | ping 一次 server，报告它通不通
+checkServer :: Text -> Int -> IO ()
+checkServer host port = do
+    opened <- connectClient host port
+    case opened of
+        Left message -> putStrLn ("storage:      DOWN (" ++ T.unpack message ++ ")")
+        Right client -> do
+            probe <- clientPing client
+            closeClient client
+            case probe of
+                Right () -> putStrLn "storage:      up (the server answered ping)"
+                Left message -> putStrLn ("storage:      DOWN (" ++ T.unpack message ++ ")")

 -- | 启动横幅
-printBanner :: WebConfig -> FilePath -> FilePath -> Maybe StorageProcess -> IO ()
-printBanner cfg configPath staticDir maybeStorage = do
+printBanner :: WebConfig -> FilePath -> FilePath -> IO ()
+printBanner cfg configPath staticDir = do
    putStrLn "==================== ChuSQL Web ===================="
    putStrLn ("url:          http://" ++ wcHost cfg ++ ":" ++ show (wcPort cfg) ++ "/")
    putStrLn ("config file:  " ++ configPath)
@@ -360,6 +347,4 @@ printBanner cfg configPath staticDir maybeStorage = do
            ++ show (wcLoginWindow cfg)
            ++ "s"
        )
-    case maybeStorage of
-        Just sp -> putStrLn ("storage proc: spawned, talking on pipe " ++ spPipe sp)
-        Nothing -> putStrLn "storage proc: assumed to run elsewhere (pipe name from [server] pipe_name)"
+    putStrLn "storage:      through the server that owns the data directory"
@@ -4,37 +4,27 @@ name:           chusql-web
 version:        1.0.0
 synopsis:       ChuSQL Web 管理端：Scotty + REST API + 静态页面
 description:    ChuSQL 的浏览器管理端。负责 HTTP 交付、鉴权、静态文件，
-                以及把用户 SQL 转交给 chusql-engine（再由 IPC 打到 Rust 存储进程）。
+                并把用户的 SQL 经 TCP 转交给 chusql-server（存储由服务器进程里的
+                chusql_core_storage 动态库承担）。本进程不链引擎，也不碰存储。
+                数据库服务器与 TCP 协议在 chusql-server 包里，这里只做 HTTP 这一面。
 build-type:     Simple

 library
    hs-source-dirs:   src
-    exposed-modules:  ChuSQL.Web.Actions
-                      ChuSQL.Web.Accounts
-                      ChuSQL.Web.API
-                      ChuSQL.Web.Auth
-                      ChuSQL.Web.Backend
-                      ChuSQL.Web.Config
+    exposed-modules:  ChuSQL.Web.API
                      ChuSQL.Web.Demo
-                      ChuSQL.Web.Privileges
-                      ChuSQL.Web.RateLimit
                      ChuSQL.Web.Secure
-                      ChuSQL.Web.Settings
                      ChuSQL.Web.Static
-                      ChuSQL.Web.StorageProcess
-                      ChuSQL.Web.TOML
                      ChuSQL.Web.UISettings
    build-depends:    base >= 4.14 && < 5
                    , aeson
                    , bytestring
-                    , chusql-engine
+                    , chusql-core-model
+                    , chusql-interface
                    , containers
-                    , crypton
                    , directory
                    , filepath
                    , http-types
-                    , memory
-                    , process
                    , scientific
                    , scotty
                    , text
@@ -48,30 +38,32 @@ executable chusql-web
    main-is:          Main.hs
    hs-source-dirs:   app
    build-depends:    base
-                    , bytestring
-                    , chusql-engine
+                    , chusql-interface
                    , chusql-web
                    , containers
-                    , crypton
-                    , directory
-                    , filepath
-                    , http-types
-                    , memory
                    , text
                    , time
                    , wai
                    , warp
    default-language: Haskell2010
    ghc-options:      -Wall
+    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path

 test-suite chusql-web-test
    type:             exitcode-stdio-1.0
    main-is:          Spec.hs
    hs-source-dirs:   test
+    other-modules:    Gates
+    build-tool-depends: chusql-server:chusql-server
    build-depends:    base
                    , aeson
                    , bytestring
-                    , chusql-engine
+                    , chusql-core-model
+                    , chusql-interface
                    , chusql-web
                    , containers
                    , directory
@@ -88,4 +80,4 @@ test-suite chusql-web-test
                    , wai-extra
                    , warp
    default-language: Haskell2010
-    ghc-options:      -Wall
+    ghc-options:      -Wall -threaded
@@ -1,257 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.Accounts (
-    Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
-    newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
-    rootUserName, principalName, principalIsRoot,
-    authenticate, currentPrincipal,
-    listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
-) where
-
-import ChuSQL.Storage.IPC (Account (..), Request (..))
-import ChuSQL.Syntax.AST (Statement (..))
-import ChuSQL.Web.Auth
-import ChuSQL.Web.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.Text (Text)
-import qualified Data.Text as T
-
-- 账号服务：root 来自配置，普通账号由 root 用 CREATE/ALTER/DROP USER 管，口令在这里做策略检查与 PBKDF2 派生。
-
-data PasswordPolicy = PasswordPolicy
-    { ppMinLength :: Int
-    , ppClasses :: Int
-    }
-    deriving (Show, Eq)
-
-- | 默认：至少 12 个字符、至少两类字符
-defaultPasswordPolicy :: PasswordPolicy
-defaultPasswordPolicy = PasswordPolicy 12 2
-
-data AccountError = AccountError Text Text deriving (Show, Eq)
-
-- | 当前身份：配置里的管理员，或系统表里的一个普通账号
-data Principal
-    = Root Text
-    | Ordinary Account
-    deriving (Eq)
-
-instance Show Principal where
-    show (Root name) = "root " ++ show name
-    show (Ordinary a) = "account " ++ show (accountUser a)
-
-- | 这个身份叫什么
-principalName :: Principal -> Text
-principalName (Root name) = name
-principalName (Ordinary a) = accountUser a
-
-- | 是不是配置里的管理员
-principalIsRoot :: Principal -> Bool
-principalIsRoot (Root _) = True
-principalIsRoot (Ordinary _) = False
-
-data Accounts = Accounts
-    { acBackend :: Backend
-    , acSessions :: SessionStore
-    , acLock :: MVar ()
-    , acPolicy :: IORef PasswordPolicy
-    , acRoot :: Credential
-    }
-
-- | 只记下配置根账号；root 不写系统表，所以启动时不需要任何持久化动作
-newAccounts :: Backend -> SessionStore -> Credential -> IO Accounts
-newAccounts backend sessions credential = do
-    lock <- newMVar ()
-    policy <- newIORef defaultPasswordPolicy
-    pure (Accounts backend sessions lock policy credential)
-
-- | 账号名统一小写去空白
-normalize :: Text -> Text
-normalize = T.toLower . T.strip
-
-- | 配置里的管理员叫什么
-rootName :: Accounts -> Text
-rootName = normalize . credUser . acRoot
-
-- | 管理员名字（界面显示用）
-rootUserName :: Accounts -> Text
-rootUserName = rootName
-
-accountsPolicy :: Accounts -> IO PasswordPolicy
-accountsPolicy = readIORef . acPolicy
-
-setAccountsPolicy :: Accounts -> PasswordPolicy -> IO ()
-setAccountsPolicy service = writeIORef (acPolicy service)
-
-- | 口令策略：长度 + 字符类别（历史与有效期随自助改密一起取消）
-passwordAllowed :: PasswordPolicy -> Text -> Either AccountError ()
-passwordAllowed policy password
-    | T.length password < ppMinLength policy || T.length password > 256 = bad "password length does not meet policy"
-    | classes < ppClasses policy = bad "password needs more character classes"
-    | otherwise = Right ()
-  where
-    bad = Left . AccountError "bad_request"
-    classes =
-        length
-            ( filter id
-                [ T.any isAsciiLower password
-                , T.any isAsciiUpper password
-                , T.any isDigit password
-                , T.any (not . isAlphaNum) password
-                ]
-            )
-
-- | 账号名规则：ASCII 字母数字与点、短横线、下划线
-validateUserName :: Text -> Either AccountError ()
-validateUserName name
-    | T.null name || T.length name > 64 || not (T.all allowed name) =
-        Left (AccountError "bad_request" "invalid account name")
-    | otherwise = Right ()
-  where
-    allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
-
-- | 新建/改口令时的额外限制：管理员的名字保留给配置里的 root
-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 ()
-
-storageFailure :: AccountError
-storageFailure = AccountError "storage_error" "account storage unavailable"
-
-unauthorized :: AccountError
-unauthorized = AccountError "unauthorized" "invalid account or session"
-
-- | 存储侧报错翻成账号错误
-storageResult :: Either String [Account] -> Either AccountError ()
-storageResult (Right _) = Right ()
-storageResult (Left "account already exists") = Left (AccountError "conflict" "account already exists")
-storageResult (Left "unknown account") = Left (AccountError "not_found" "unknown account")
-storageResult (Left _) = Left storageFailure
-
-- | 读系统表里的普通账号
-readAccounts :: Accounts -> IO (Either AccountError [Account])
-readAccounts service = fmap (either (const (Left storageFailure)) Right) (beAccounts (acBackend service) ReqAccountsList)
-
-- | 当前令牌对应的身份；会话版本与账号 revision 对不上就失效
-currentUnlocked :: Accounts -> Text -> IO (Either AccountError Principal)
-currentUnlocked service token = do
-    session <- lookupVersionedSession (acSessions service) token
-    case session of
-        Nothing -> pure (Left unauthorized)
-        Just (user, revision)
-            | user == rootName service && revision == Nothing -> pure (Right (Root (rootName service)))
-            | otherwise -> do
-                stored <- readAccounts service
-                pure $ do
-                    accounts <- stored
-                    account <- case filter ((== user) . accountUser) accounts of
-                        [a] -> Right a
-                        _ -> Left unauthorized
-                    if revision == Just (accountRevision account)
-                        then Right (Ordinary account)
-                        else Left unauthorized
-
-currentPrincipal :: Accounts -> Text -> IO (Either AccountError Principal)
-currentPrincipal service token = withMVar (acLock service) $ \_ -> currentUnlocked service token
-
-- | 登录：先比配置里的 root，再查系统表里的普通账号（没有切换身份的入口）。
--   配置里的口令留空即"免密"：只有管理员能用空口令进来，普通账号一律拒绝。
-authenticate :: Accounts -> Text -> Text -> IO (Either AccountError Text)
-authenticate service user password = withMVar (acLock service) $ \_ ->
-    if normalize user == rootName service
-        then signInRoot
-        else
-            if passwordless
-                then pure (Left (AccountError "forbidden" "this server only accepts the administrator"))
-                else signInOrdinary
-  where
-    passwordless = T.null (credEncoded (acRoot service))
-    signInRoot
-        | passwordless =
-            if T.null password
-                then Right <$> createVersionedSession (acSessions service) (rootName service) Nothing
-                else pure (Left unauthorized)
-        | verifyPassword (credEncoded (acRoot service)) password =
-            Right <$> createVersionedSession (acSessions service) (rootName service) Nothing
-        | otherwise = pure (Left unauthorized)
-    signInOrdinary = do
-        stored <- readAccounts service
-        case stored of
-            Left err -> pure (Left err)
-            Right accounts -> case filter ((== normalize user) . accountUser) accounts of
-                [a] | verifyPassword (accountHash a) password -> do
-                    stamp <- currentStamp
-                    written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp))
-                    case written of
-                        Left _ -> pure (Left storageFailure)
-                        Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a))
-                _ -> pure (Left unauthorized)
-
-- | 系统表里的普通账号清单（root 专用）
-listAccounts :: Accounts -> IO (Either AccountError [Account])
-listAccounts service = withMVar (acLock service) $ \_ -> readAccounts service
-
-- | 按用户名找一个普通账号
-findAccount :: Accounts -> Text -> IO (Either AccountError Account)
-findAccount service name = withMVar (acLock service) $ \_ -> do
-    stored <- readAccounts service
-    pure $ do
-        accounts <- stored
-        case filter ((== normalize name) . accountUser) accounts of
-            [a] -> Right a
-            [] -> Left (AccountError "not_found" "unknown account")
-            _ -> Left storageFailure
-
-- | 建一个普通账号
-createUser :: Accounts -> Text -> Text -> IO (Either AccountError ())
-createUser service name password = withMVar (acLock service) $ \_ -> do
-    policy <- accountsPolicy service
-    case validateNewName service name >> passwordAllowed policy password of
-        Left err -> pure (Left err)
-        Right () -> do
-            encoded <- hashPassword password
-            storageResult <$> beAccounts (acBackend service) (ReqAccountCreate (normalize name) encoded)
-
-- | 改一个普通账号的口令（管理员重置，不受历史/有效期限制）
-resetPassword :: Accounts -> Text -> Text -> IO (Either AccountError ())
-resetPassword service name password = withMVar (acLock service) $ \_ -> do
-    policy <- accountsPolicy service
-    case validateNewName service name >> passwordAllowed policy password of
-        Left err -> pure (Left err)
-        Right () -> do
-            encoded <- hashPassword password
-            storageResult <$> beAccounts (acBackend service) (ReqAccountReset (normalize name) encoded)
-
-- | 删一个普通账号
-dropUser :: Accounts -> Text -> IO (Either AccountError ())
-dropUser service name = withMVar (acLock service) $ \_ ->
-    case validateUserName name of
-        Left err -> pure (Left err)
-        Right () -> storageResult <$> beAccounts (acBackend service) (ReqAccountDrop (normalize name))
-
-- | 账号管理命令：SQL 语句与一键接口在这上面汇合
-data AccountCommand
-    = CreateAccount Text Text
-    | ResetAccountPassword Text Text
-    | DropAccount Text
-    deriving (Show, Eq)
-
-- | 一条语句是不是账号管理语句
-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 _ = 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
@@ -1,285 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.Actions (
-    ColumnSpec (..),
-    CreateTableSpec (..),
-    isIdentifier,
-    columnTypeOf,
-    columnTypeName,
-    coerceValue,
-    sqlLiteral,
-    escapeStringLiteral,
-    createDatabaseSql,
-    dropDatabaseSql,
-    createTableSql,
-    dropTableSql,
-    createIndexSql,
-    dropIndexSql,
-    dropColumnSql,
-    insertRowSql,
-    insertRowsSql,
-    updateRowSql,
-    deleteRowSql,
-    selectRowsSql,
-    createUserSql,
-    alterUserSql,
-    dropUserSql,
-) where
-
-import ChuSQL.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
-import qualified ChuSQL.Model as M
-import qualified Data.Aeson as A
-import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
-import Data.List (intercalate)
-import Data.Scientific (floatingOrInteger)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Text.Read (readMaybe)
-
-- 把界面上的一键操作翻译成安全 SQL：标识符过白名单，值一律转义。
-
-data ColumnSpec = ColumnSpec
-    { csName :: Text
-    , csType :: Text
-    }
-    deriving (Show, Eq)
-
-data CreateTableSpec = CreateTableSpec
-    { ctsTable :: Text
-    , ctsColumns :: [ColumnSpec]
-    }
-    deriving (Show, Eq)
-
-- | 表名/列名的白名单
-isIdentifier :: Text -> Bool
-isIdentifier t =
-    not (T.null t)
-        && T.length t <= 64
-        && case T.unpack t of
-            (c : cs) -> (isAsciiLower c || isAsciiUpper c || c == '_') && all restChar cs
-            [] -> False
-  where
-    restChar c = isAsciiLower c || isAsciiUpper c || isDigit c || c == '_'
-
-- | 检查一个标识符，不合法就报错（带上"是表名还是列名"）
-checkIdent :: Text -> Text -> Either String Text
-checkIdent what name
-    | isIdentifier name = Right name
-    | otherwise = Left (T.unpack what ++ " name is not a plain identifier: " ++ T.unpack name)
-
-- | 列表不能空
-requireNonEmpty :: String -> [a] -> Either String [a]
-requireNonEmpty what xs
-    | null xs = Left (what ++ " must not be empty")
-    | otherwise = Right xs
-
-- | 线上列类型名（和数据字典里的写法一致）转本地类型
-columnTypeOf :: Text -> Maybe Column
-columnTypeOf = fmap plainColumn . parseColumnType . T.unpack . T.strip
-
-- | 本地类型转线上名字
-columnTypeName :: Column -> Text
-columnTypeName = T.pack . typeName . columnType
-
-- | 字符串字面量转义：单引号翻倍（引擎的词法器就是这么折回去的）
-escapeStringLiteral :: String -> String
-escapeStringLiteral = concatMap (\c -> if c == '\'' then "''" else [c])
-
-- | 值转 SQL 字面量
-sqlLiteral :: Value -> String
-sqlLiteral VNull = "NULL"
-sqlLiteral (VInt n) = show n
-sqlLiteral (VFloat d) = show d
-sqlLiteral (VStr s) = "'" ++ escapeStringLiteral s ++ "'"
-sqlLiteral (VBool True) = "TRUE"
-sqlLiteral (VBool False) = "FALSE"
-
-- | JSON 值按列类型转成引擎的值；类型对不上就报错
-coerceValue :: Column -> A.Value -> Either String Value
-coerceValue col v = case v of
-    A.Null -> Right VNull
-    A.Bool b -> M.coerceValue t (VBool b)
-    A.Number n -> case floatingOrInteger n :: Either Double Integer of
-        Right i -> M.coerceValue t (VInt (fromIntegral i))
-        Left d -> M.coerceValue t (VFloat d)
-    A.String s
-        | integerType t -> case readMaybe (T.unpack (T.strip s)) :: Maybe Int of
-            Just i -> M.coerceValue t (VInt i)
-            Nothing -> Left ("expected an integer, got: " ++ T.unpack s)
-        | numericType t -> case readMaybe (T.unpack (T.strip s)) :: Maybe Double of
-            Just d -> M.coerceValue t (VFloat d)
-            Nothing -> Left ("expected a number, got: " ++ T.unpack s)
-        | t == CBool -> case T.toLower (T.strip s) of
-            "true" -> Right (VBool True)
-            "false" -> Right (VBool False)
-            _ -> Left ("expected true/false, got: " ++ T.unpack s)
-        | otherwise -> M.coerceValue t (VStr (T.unpack s))
-    _ -> Left "unsupported value"
-  where
-    t = columnType col
-
-- | 构造 CREATE DATABASE
-createDatabaseSql :: Text -> Either String String
-createDatabaseSql name = do
-    db <- checkIdent "database" name
-    pure ("CREATE DATABASE " ++ T.unpack db)
-
-- | 构造 DROP DATABASE
-dropDatabaseSql :: Text -> Either String String
-dropDatabaseSql name = do
-    db <- checkIdent "database" name
-    pure ("DROP DATABASE " ++ T.unpack db)
-
-- | 构造 CREATE TABLE 语句
-createTableSql :: CreateTableSpec -> Either String String
-createTableSql spec = do
-    tbl <- checkIdent "table" (ctsTable spec)
-    cols <- requireNonEmpty "columns" (ctsColumns spec)
-    defs <- mapM columnDef cols
-    pure ("CREATE TABLE " ++ T.unpack tbl ++ " (" ++ intercalate ", " defs ++ ")")
-  where
-    columnDef (ColumnSpec name ty) = do
-        col <- checkIdent "column" name
-        ctype <- maybe (Left ("unknown column type: " ++ T.unpack ty)) Right (columnTypeOf ty)
-        pure (T.unpack col ++ " " ++ T.unpack (columnTypeName ctype))
-
-- | 构造 DROP TABLE 语句
-dropTableSql :: Text -> Either String String
-dropTableSql table = do
-    tbl <- checkIdent "table" table
-    pure ("DROP TABLE " ++ T.unpack tbl)
-
-- | 构造 CREATE INDEX 语句
-createIndexSql :: Text -> Text -> Either String String
-createIndexSql table column = do
-    tbl <- checkIdent "table" table
-    col <- checkIdent "column" column
-    pure ("CREATE INDEX ON " ++ T.unpack tbl ++ " (" ++ T.unpack col ++ ")")
-
-- | 构造 DROP INDEX 语句
-dropIndexSql :: Text -> Text -> Either String String
-dropIndexSql table column = do
-    tbl <- checkIdent "table" table
-    col <- checkIdent "column" column
-    pure ("DROP INDEX ON " ++ T.unpack tbl ++ " (" ++ T.unpack col ++ ")")
-
-- | 删列：列定义、索引与数据一起没
-dropColumnSql :: Text -> Text -> Either String String
-dropColumnSql table column = do
-    tbl <- checkIdent "table" table
-    col <- checkIdent "column" column
-    pure ("ALTER TABLE " ++ T.unpack tbl ++ " DROP COLUMN " ++ T.unpack col)
-
-- | 构造单行 INSERT 语句
-insertRowSql :: Text -> [(String, Value)] -> Either String String
-insertRowSql table row = do
-    tbl <- checkIdent "table" table
-    cols <- requireNonEmpty "values" row
-    names <- mapM (checkIdent "column" . T.pack . fst) cols
-    pure
-        ( "INSERT INTO "
-            ++ T.unpack tbl
-            ++ " ("
-            ++ intercalate ", " (map T.unpack names)
-            ++ ") VALUES ("
-            ++ intercalate ", " (map (sqlLiteral . snd) cols)
-            ++ ")"
-        )
-
-- | 一次插多行，N 行只落一次盘
-insertRowsSql :: Text -> [[(String, Value)]] -> Either String String
-insertRowsSql table rows = do
-    tbl <- checkIdent "table" table
-    rs <- requireNonEmpty "rows" rows
-    case rs of
-        [] -> Left "rows must not be empty"
-        (first : _) -> do
-            names <- mapM (checkIdent "column" . T.pack . fst) first
-            let widths = map length rs
-            if any (/= length first) widths
-                then Left "all rows must have the same columns"
-                else
-                    pure
-                        ( "INSERT INTO "
-                            ++ T.unpack tbl
-                            ++ " ("
-                            ++ intercalate ", " (map T.unpack names)
-                            ++ ") VALUES "
-                            ++ intercalate ", " ["(" ++ intercalate ", " (map (sqlLiteral . snd) r) ++ ")" | r <- rs]
-                        )
-
-- | 构造按 id 改行的 UPDATE 语句
-updateRowSql :: Text -> Int -> [(String, Value)] -> Either String String
-updateRowSql table key assigns = do
-    tbl <- checkIdent "table" table
-    cols <- requireNonEmpty "values" assigns
-    sets <- mapM (\(n, v) -> (\c -> T.unpack c ++ " = " ++ sqlLiteral v) <$> checkIdent "column" (T.pack n)) cols
-    pure ("UPDATE " ++ T.unpack tbl ++ " SET " ++ intercalate ", " sets ++ " WHERE id = " ++ show key)
-
-- | 按 id 删一行，存储层原地删
-deleteRowSql :: Text -> Int -> Either String String
-deleteRowSql table key = do
-    tbl <- checkIdent "table" table
-    pure ("DELETE FROM " ++ T.unpack tbl ++ " WHERE id = " ++ show key)
-
-- | 浏览一张表的 SELECT，带排序与等值过滤
-selectRowsSql :: Text -> Maybe (Text, Bool) -> [(Text, Value)] -> Either String String
-selectRowsSql table order filters = do
-    tbl <- checkIdent "table" table
-    whereSql <- whereClause filters
-    orderSql <- orderClause order
-    pure ("SELECT * FROM " ++ T.unpack tbl ++ whereSql ++ orderSql)
-
-- | 拼 WHERE 子句，无条件给空串
-whereClause :: [(Text, Value)] -> Either String String
-whereClause filters = case filters of
-    [] -> pure ""
-    _ -> do
-        terms <- mapM term filters
-        pure (" WHERE " ++ intercalate " AND " terms)
-  where
-    term (column, value) = do
-        col <- checkIdent "column" column
-        pure (T.unpack col ++ " = " ++ sqlLiteral value)
-
-- | 拼 ORDER BY 子句，无排序给空串
-orderClause :: Maybe (Text, Bool) -> Either String String
-orderClause Nothing = pure ""
-orderClause (Just (column, ascending)) = do
-    col <- checkIdent "column" column
-    pure (" ORDER BY " ++ T.unpack col ++ (if ascending then " ASC" else " DESC"))
-
-- | 账号名：与普通标识符同一套规则，另允许点与短横线（写成字符串形式）
-accountName :: Text -> Either String Text
-accountName name
-    | T.null name || T.length name > 64 = Left "account name is empty or too long"
-    | not (T.all allowed name) = Left ("account name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack name)
-    | otherwise = Right name
-  where
-    allowed c = isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("_.-" :: String)
-
-- | 单引号字符串字面量
-quoted :: Text -> String
-quoted value = "'" ++ escapeStringLiteral (T.unpack value) ++ "'"
-
-- | 构造 CREATE USER（口令是明文，账号服务负责加盐派生）
-createUserSql :: Text -> Text -> Either String String
-createUserSql name password = do
-    user <- accountName name
-    if T.null password || T.length password > 256
-        then Left "password must not be empty or longer than 256 characters"
-        else pure ("CREATE USER " ++ T.unpack user ++ " IDENTIFIED BY " ++ quoted password)
-
-- | 构造 ALTER USER（改一个普通账号的口令）
-alterUserSql :: Text -> Text -> Either String String
-alterUserSql name password = do
-    user <- accountName name
-    if T.null password || T.length password > 256
-        then Left "password must not be empty or longer than 256 characters"
-        else pure ("ALTER USER " ++ T.unpack user ++ " IDENTIFIED BY " ++ quoted password)
-
-- | 构造 DROP USER
-dropUserSql :: Text -> Either String String
-dropUserSql name = do
-    user <- accountName name
-    pure ("DROP USER " ++ T.unpack user)
@@ -1,198 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.Auth (
-    Credential (..),
-    defaultIterations,
-    hashPassword,
-    hashPasswordWith,
-    hashLooksValid,
-    verifyPassword,
-    SessionPolicy (..),
-    defaultSessionPolicy,
-    SessionStore,
-    newSessionStore,
-    sessionPolicy,
-    setSessionPolicy,
-    createSession,
-    createVersionedSession,
-    lookupVersionedSession,
-    lookupSession,
-    deleteSession,
-    sessionToken,
-) where
-
-import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar)
-import Crypto.Hash (SHA256 (..))
-import qualified Crypto.KDF.PBKDF2 as PBKDF2
-import Crypto.Random (getRandomBytes)
-import qualified Data.ByteString as BS
-import Data.ByteArray (constEq)
-import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import qualified Data.Map.Strict as Map
-import Data.Maybe (isJust)
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)
-import Text.Read (readMaybe)
-
-- 口令与 Session：口令只存 PBKDF2 编码串，会话是服务端内存状态。
-
-data Credential = Credential
-    { credUser :: Text
-    , credEncoded :: Text
-    }
-    deriving (Show, Eq)
-
-- | 默认迭代次数（10 万次）
-defaultIterations :: Int
-defaultIterations = 100000
-
-- | 派生密钥长度（字节）
-keyLength :: Int
-keyLength = 32
-
-- | 盐长度（字节）
-saltLength :: Int
-saltLength = 16
-
-- | 迭代次数的上界：配置串被人改坏时不至于把自己算死
-maxIterations :: Int
-maxIterations = 10000000
-
-- | PBKDF2-HMAC-SHA256 派生
-deriveKey :: Int -> BS.ByteString -> BS.ByteString -> BS.ByteString
-deriveKey iters salt password =
-    PBKDF2.generate (PBKDF2.prfHMAC SHA256) (PBKDF2.Parameters iters keyLength) password salt
-
-- | 字节转十六进制
-hexEncode :: BS.ByteString -> Text
-hexEncode = TE.decodeUtf8 . convertToBase Base16
-
-- | 十六进制转字节（长度不对/有非法字符就给 Nothing）
-hexDecode :: Text -> Maybe BS.ByteString
-hexDecode t = case convertFromBase Base16 (TE.encodeUtf8 t) of
-    Left _ -> Nothing
-    Right bs -> Just bs
-
-- | 编码成 `pbkdf2-sha256$次数$盐$哈希`
-encodeHash :: Int -> BS.ByteString -> BS.ByteString -> Text
-encodeHash iters salt digest =
-    T.intercalate "$" ["pbkdf2-sha256", T.pack (show iters), hexEncode salt, hexEncode digest]
-
-- | 解回 (次数, 盐, 哈希)，坏格式给 Nothing
-parseHash :: Text -> Maybe (Int, BS.ByteString, BS.ByteString)
-parseHash t = case T.splitOn "$" t of
-    [alg, itersT, saltT, digestT]
-        | alg == "pbkdf2-sha256" -> do
-            iters <- readMaybe (T.unpack itersT) :: Maybe Int
-            salt <- hexDecode saltT
-            digest <- hexDecode digestT
-            if iters < 1000 || iters > maxIterations || BS.null salt || BS.length digest /= keyLength
-                then Nothing
-                else Just (iters, salt, digest)
-    _ -> Nothing
-
-- | 用给定盐生成编码串（给定盐是为了能写确定性测试）
-hashPasswordWith :: Int -> BS.ByteString -> Text -> Text
-hashPasswordWith iters salt password =
-    encodeHash iters salt (deriveKey iters salt (TE.encodeUtf8 password))
-
-- | 给一个口令配随机盐，生成编码串
-hashPassword :: Text -> IO Text
-hashPassword password = do
-    salt <- getRandomBytes saltLength
-    pure (hashPasswordWith defaultIterations salt password)
-
-- | 恒定时间校验口令是否匹配
-verifyPassword :: Text -> Text -> Bool
-verifyPassword encoded candidate = case parseHash encoded of
-    Nothing -> False
-    Just (iters, salt, digest) -> constEq digest (deriveKey iters salt (TE.encodeUtf8 candidate))
-
-- | 编码串本身是否合法（不看口令）
-hashLooksValid :: Text -> Bool
-hashLooksValid = isJust . parseHash
-
-data Session = Session
-    { sessUser :: Text
-    , sessCreated :: UTCTime
-    , sessSeen :: UTCTime
-    , sessRevision :: Maybe Integer
-    }
-
-data SessionPolicy = SessionPolicy
-    { spIdleSeconds :: NominalDiffTime
-    , spAbsoluteSeconds :: NominalDiffTime
-    }
-
-- | 默认：空闲 8 小时、绝对 24 小时
-defaultSessionPolicy :: SessionPolicy
-defaultSessionPolicy = SessionPolicy (8 * 3600) (24 * 3600)
-
-data SessionStore = SessionStore
-    { storeMap :: MVar (Map.Map Text Session)
-    , storeClock :: IO UTCTime
-    , storePolicy :: IORef SessionPolicy
-    }
-
-- | 造一个空仓库
-newSessionStore :: IO UTCTime -> SessionPolicy -> IO SessionStore
-newSessionStore clock policy = do
-    ref <- newMVar Map.empty
-    policyRef <- newIORef policy
-    pure (SessionStore ref clock policyRef)
-
-- | 现在用的是哪套过期策略
-sessionPolicy :: SessionStore -> IO SessionPolicy
-sessionPolicy = readIORef . storePolicy
-
-- | 换一套过期策略（设置页热改）
-setSessionPolicy :: SessionStore -> SessionPolicy -> IO ()
-setSessionPolicy store = writeIORef (storePolicy store)
-
-- | 这条会话过期了吗
-expired :: UTCTime -> SessionPolicy -> Session -> Bool
-expired now pol s =
-    diffUTCTime now (sessSeen s) > spIdleSeconds pol
-        || diffUTCTime now (sessCreated s) > spAbsoluteSeconds pol
-
-- | 清掉过期会话
-prune :: UTCTime -> SessionPolicy -> Map.Map Text Session -> Map.Map Text Session
-prune now pol = Map.filter (not . expired now pol)
-
-- | 随机令牌：32 字节，十六进制 64 个字符
-sessionToken :: IO Text
-sessionToken = hexEncode <$> getRandomBytes 32
-
-- | 开一条会话，返回令牌
-createSession :: SessionStore -> Text -> IO Text
-createSession store user = createVersionedSession store user Nothing
-
-createVersionedSession :: SessionStore -> Text -> Maybe Integer -> IO Text
-createVersionedSession store user revision = do
-    token <- sessionToken
-    now <- storeClock store
-    pol <- sessionPolicy store
-    modifyMVar_ (storeMap store) $ \m ->
-        pure (Map.insert token (Session user now now revision) (prune now pol m))
-    pure token
-
-- | 查令牌并刷新最后活动时间
-lookupSession :: SessionStore -> Text -> IO (Maybe Text)
-lookupSession store token = fmap (fmap fst) (lookupVersionedSession store token)
-
-lookupVersionedSession :: SessionStore -> Text -> IO (Maybe (Text, Maybe Integer))
-lookupVersionedSession store token = do
-    now <- storeClock store
-    pol <- sessionPolicy store
-    modifyMVar (storeMap store) $ \m -> do
-        let kept = prune now pol m
-        pure $ case Map.lookup token kept of
-            Nothing -> (kept, Nothing)
-            Just s -> (Map.insert token s{sessSeen = now} kept, Just (sessUser s, sessRevision s))
-
-- | 删掉一条会话（退出登录）
-deleteSession :: SessionStore -> Text -> IO ()
-deleteSession store token = modifyMVar_ (storeMap store) (pure . Map.delete token)
@@ -1,400 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.Backend (
-    StatementResult (..),
-    Backend (..),
-    columnsFromStatement,
-    currentStamp,
-    exprTables,
-    inDatabase,
-    internalTable,
-    grantsTable,
-    ipcBackend,
-    memoryBackend,
-    membersTable,
-    rolesTable,
-    statementNeedsDatabase,
-    statementTables,
-    systemDatabaseName,
-    tableInfoOf,
-    tableRefsOf,
-) where
-
-import ChuSQL.Engine (runStatement, runStatementM)
-import ChuSQL.Model
-import ChuSQL.Semantic (prepare)
-import ChuSQL.Storage (MonadStorage (schema))
-import ChuSQL.Storage.IPC (
-    Account (..),
-    IPCStorage (..),
-    Request (..),
-    Response (..),
-    SchemaColumn (..),
-    TableInfo (..),
-    sendRequest,
- )
-import ChuSQL.Syntax.AST
-import ChuSQL.Syntax.Parser (parseStatement)
-import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, readMVar, withMVar)
-import Data.List (nub)
-import Data.Text (Text)
-import Data.Time (getCurrentTime)
-import Data.Time.Format (defaultTimeLocale, formatTime)
-import qualified Data.Aeson as A
-import qualified Data.ByteString.Lazy.Char8 as BL
-import qualified Data.Text as T
-
-- 后端：跑一条语句与取数据字典，分 IPC（真存储）和内存（测试）两套。
-
-data StatementResult = StatementResult
-    { srColumns :: [String]
-    , srRows :: [Row]
-    }
-
-data Backend = Backend
-    { beStatement :: String -> IO (Either String StatementResult)
-    , beCatalog :: IO (Either String [TableInfo])
-    , bePing :: IO Bool
-    , beAccounts :: Request -> IO (Either String [Account])
-    , beWithDatabase :: String -> Backend
-    , beDatabases :: IO (Either String [String])
-    }
-
-- | 按给定列名取列，固定列顺序
-columnsFromStatement :: Database -> Statement -> [String]
-columnsFromStatement db stmt = case prepare db stmt of
-    Right (Select cols _ _ _ _ _) -> cols
-    Right (SelectExpr items _ _ _ _ _) -> map fst items
-    _ -> []
-
-- | 走本地端点的后端（真存储：Windows 具名管道 / Unix 套接字）
-ipcBackend :: IO Backend
-ipcBackend = do
-    lock <- newMVar ()
-    let backend current = Backend
-            { beStatement = \sql -> withMVar lock $ \_ -> runIpc current sql
-            , beCatalog = withMVar lock $ \_ -> do
-                response <- sendRequest (ReqInDatabase current ReqListCatalog)
-                pure $ case response of
-                    RespCatalog infos -> Right infos
-                    RespError err -> Left err
-                    _ -> Left "unexpected catalog response"
-            , bePing = withMVar lock $ \_ -> do
-                resp <- sendRequest ReqPing
-                pure (case resp of RespPong -> True; _ -> False)
-            , beAccounts = \req -> withMVar lock $ \_ -> do
-                response <- sendRequest req
-                pure $ case response of
-                    RespAccounts accounts -> Right accounts
-                    RespError err -> Left err
-                    _ -> Left "unexpected account response"
-            , beWithDatabase = backend
-            , beDatabases = withMVar lock $ \_ -> do
-                response <- sendRequest (ReqDatabase "list_databases" "")
-                pure $ case response of
-                    RespTables names -> Right names
-                    RespError err -> Left err
-                    _ -> Left "unexpected database response"
-            }
-    -- 没有默认库：没选库时 current 是空串，任何请求都得先选库
-    pure (backend "")
-  where
-    runIpc :: String -> String -> IO (Either String StatementResult)
-    runIpc current sql = case fmap (inDatabase current) (parseStatement sql) of
-        Left e -> pure (Left e)
-        Right stmt -> do
-            result <- runIPCStorage (runStatementM stmt)
-            case result of
-                Left e -> pure (Left e)
-                Right rows -> do
-                    cols <- case rows of
-                        [] -> do
-                            db <- runIPCStorage (schema :: IPCStorage Database)
-                            pure (columnsFromStatement db stmt)
-                        (r : _) -> pure (map fst r)
-                    pure (Right (StatementResult cols rows))
-
-- | 内存后端（测试）：状态就是一个 `Database`，名字是它代表的库
-memoryBackend :: String -> MVar Database -> Backend
-memoryBackend = memoryBackendWith False
-
-- | 同一份内存状态可以按普通库（trusted=False）或系统库（trusted=True）视角跑：
--   系统库要能读写角色/授权表，普通库连看都不许看。
-memoryBackendWith :: Bool -> String -> MVar Database -> Backend
-memoryBackendWith trusted name ref =
-    Backend
-        { beStatement = \sql -> case parseStatement sql of
-            Left e -> pure (Left e)
-            -- 内存夹具也有"库"的概念：USE 只能切到它有的两个名字（自己 + system），
-            -- 与 beDatabases 口径一致；引擎的内存存储不实现库管理，所以拦在这里。
-            Right (UseDatabase target)
-                | target == name || target == systemDatabaseName -> pure (Right (StatementResult [] []))
-                | otherwise -> pure (Left ("unknown database: " ++ target))
-            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))
-        , beCatalog = do
-            db <- readMVar ref
-            pure (Right (map tableInfoOf (filter (not . internalTable . fst) 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]) : filter ((/= usersTable) . fst) db, Right accounts)
-        , beWithDatabase = withDatabase
-        , beDatabases = pure (Right (nub [name, systemDatabaseName]))
-        }
-  where
-    scoped = if trusted then filter (not . reserved . fst) else visible
-    hidden = if trusted then reserved else internalTable
-    colsOf db stmt rows = case rows of
-        [] -> columnsFromStatement db stmt
-        (r : _) -> map fst r
-
-    -- 系统库视角给权限服务用；夹具自己的库走普通视角；没选库时只放行不碰表的语句
-    withDatabase target
-        | target == systemDatabaseName = memoryBackendWith True name ref
-        | target == name = memoryBackendWith False name ref
-        | null target = noDatabaseBackend (memoryBackendWith False name ref)
-        | otherwise = unavailableDatabase ("unknown database: " ++ target) (memoryBackendWith False name ref)
-
-unavailableDatabase :: String -> Backend -> Backend
-unavailableDatabase message backend = backend
-    { beStatement = \_ -> pure (Left message)
-    , beCatalog = pure (Left message)
-    }
-
-- | 没选库时的视角：不碰表的语句（USE、建库、账号与角色）照跑，
--   一旦语句里出现裸表名就报 no database selected。
--   与存储层口径一致：`db.table` 这种限定名不需要先选库。
-noDatabaseBackend :: Backend -> Backend
-noDatabaseBackend backend = backend
-    { beStatement = \sql -> case parseStatement sql of
-        Left e -> pure (Left e)
-        Right stmt
-            | statementNeedsDatabase stmt -> pure (Left "no database selected")
-            | otherwise -> beStatement backend sql
-    , beCatalog = pure (Left "no database selected")
-    }
-
-- | Database context is an immutable request value, never shared connection state.
--   子查询里出现的表名同样要带上数据库前缀，否则会落到错误的库里。
-inDatabase :: String -> Statement -> Statement
-inDatabase current = walk
-  where
-    walk :: Statement -> Statement
-    walk stmt = case stmt of
-        q@Select{} ->
-            q
-                { selectFrom = source (selectFrom q)
-                , selectWhere = fmap expr (selectWhere q)
-                }
-        q@SelectExpr{} ->
-            q
-                { selectItems = [(label, expr e) | (label, e) <- selectItems q]
-                , selectFrom = source (selectFrom q)
-                , selectWhere = fmap expr (selectWhere q)
-                }
-        Insert t cols rows -> Insert (table t) cols (map (map expr) rows)
-        Delete t cond -> Delete (table t) (fmap expr cond)
-        Update t assigns cond -> Update (table t) [(c, expr e) | (c, e) <- assigns] (fmap expr cond)
-        CreateTable t cols -> CreateTable (table t) cols
-        DropTable t -> DropTable (table t)
-        CreateIndex t c -> CreateIndex (table t) c
-        DropIndex t c -> DropIndex (table t) c
-        DropColumn t c -> DropColumn (table t) c
-        AddColumn t def -> AddColumn (table t) def
-        RenameColumn t old new -> RenameColumn (table t) old new
-        AlterColumnType t c ty -> AlterColumnType (table t) c ty
-        AlterColumnDefault t c v -> AlterColumnDefault (table t) c v
-        AlterColumnNull t c b -> AlterColumnNull (table t) c b
-        other -> other
-
-    table t | '.' `elem` t || null current = t
-            | otherwise = current ++ "." ++ t
-
-    source FromUnit = FromUnit
-    source (FromTable a t) = FromTable a (table t)
-    source (FromJoin k l a t e) = FromJoin k (source l) a (table t) (expr e)
-
-    -- 表达式里的子查询也要一起改写
-    expr (ScalarSub sq) = ScalarSub (sub sq)
-    expr (ExistsSub sq neg) = ExistsSub (sub sq) neg
-    expr (InSub a sq neg) = InSub (expr a) (sub sq) neg
-    expr (InList a items neg) = InList (expr a) (map expr items) neg
-    expr (Add a b) = Add (expr a) (expr b)
-    expr (Sub a b) = Sub (expr a) (expr b)
-    expr (Mul a b) = Mul (expr a) (expr b)
-    expr (Div a b) = Div (expr a) (expr b)
-    expr (Neg a) = Neg (expr a)
-    expr (Gt a b) = Gt (expr a) (expr b)
-    expr (Lt a b) = Lt (expr a) (expr b)
-    expr (Eq a b) = Eq (expr a) (expr b)
-    expr (And a b) = And (expr a) (expr b)
-    expr (Or a b) = Or (expr a) (expr b)
-    expr (IsNull a) = IsNull (expr a)
-    expr (IsNotNull a) = IsNotNull (expr a)
-    expr (CountOf a) = CountOf (expr a)
-    expr (SumOf a) = SumOf (expr a)
-    expr (AvgOf a) = AvgOf (expr a)
-    expr (MinOf a) = MinOf (expr a)
-    expr (MaxOf a) = MaxOf (expr a)
-    expr other = other
-
-    sub sq = sq {subqueryStatement = walk (subqueryStatement sq)}
-
-- | 语句里出现的表（含 JOIN、子查询、INSERT/UPDATE/DELETE 的目标）
-statementTables :: Statement -> [Text]
-statementTables stmt = nub (case stmt of
-    Select{} ->
-        tableRefsOf (selectFrom stmt)
-            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt))
-    SelectExpr{} ->
-        tableRefsOf (selectFrom stmt)
-            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems 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)
-    CreateTable table _ -> [T.pack table]
-    DropTable table -> [T.pack table]
-    CreateIndex table _ -> [T.pack table]
-    DropIndex table _ -> [T.pack table]
-    DropColumn table _ -> [T.pack table]
-    AddColumn table _ -> [T.pack table]
-    RenameColumn table _ _ -> [T.pack table]
-    AlterColumnType table _ _ -> [T.pack table]
-    AlterColumnDefault table _ _ -> [T.pack table]
-    AlterColumnNull table _ _ -> [T.pack table]
-    _ -> [])
-
-- | 语句需不需要一个当前库：出现的表里有没写库名的就必须要
-statementNeedsDatabase :: Statement -> Bool
-statementNeedsDatabase stmt = any (not . T.any (== '.')) (statementTables stmt)
-
-- | FROM 子句里的所有表
-tableRefsOf :: FromClause -> [Text]
-tableRefsOf FromUnit = []
-tableRefsOf (FromTable _ name) = [T.pack name]
-tableRefsOf (FromJoin _ left _ name cond) = tableRefsOf left ++ [T.pack name] ++ exprTables cond
-
-- | 表达式里出现的表（子查询是唯一的来路）
-exprTables :: Expr -> [Text]
-exprTables expr = case expr of
-    ScalarSub sub -> statementTables (subqueryStatement sub)
-    ExistsSub sub _ -> statementTables (subqueryStatement sub)
-    InSub value sub _ -> exprTables value ++ statementTables (subqueryStatement sub)
-    InList value items _ -> concatMap exprTables (value : items)
-    Add a b -> both a b
-    Sub a b -> both a b
-    Mul a b -> both a b
-    Div a b -> both a b
-    Gt a b -> both a b
-    Lt a b -> both a b
-    Eq a b -> both a b
-    And a b -> both a b
-    Or a b -> both a b
-    Neg a -> exprTables a
-    IsNull a -> exprTables a
-    IsNotNull a -> exprTables a
-    CountOf a -> exprTables a
-    SumOf a -> exprTables a
-    AvgOf a -> exprTables a
-    MinOf a -> exprTables a
-    MaxOf a -> exprTables a
-    _ -> []
-  where
-    both a b = exprTables a ++ exprTables b
-
-- | 一张表的线上信息（内存实现：没有索引，统计现算）
-tableInfoOf :: (String, Table) -> TableInfo
-tableInfoOf (name, tbl) =
-    TableInfo
-        { tiTable = name
-        , tiColumns = [wireColumn c ty | (c, ty) <- tableCols tbl]
-        , tiRows = length (tableRows tbl)
-        , tiIndexes = []
-        , tiStats = [(c, distinctOf c, False) | (c, _) <- tableCols tbl]
-        }
-  where
-    distinctOf c = length (nub [v | r <- tableRows tbl, Just v <- [lookup c r]])
-
-- | 本地列类型转线上字符串（和 IPC 那边同一套写法）
-wireType :: Column -> String
-wireType = typeName . columnType
-
-- | 本地列转线上 schema
-wireColumn :: String -> Column -> SchemaColumn
-wireColumn name col =
-    SchemaColumn
-        { scName = name
-        , scType = wireType col
-        , scNullable = columnNullable col
-        , scDefault = columnDefault col
-        , scAutoIncrement = columnAutoIncrement col
-        , scPrimaryKey = columnPrimaryKey col
-        , scUnique = columnUnique col
-        , scCheck = columnCheck col
-        }
-
-- | 系统库：账号、角色与授权表住在这里，其中的表都是系统表，只给管理员
-systemDatabaseName :: String
-systemDatabaseName = "system"
-
-usersTable :: String
-usersTable = "__chusql_users"
-
-- | 角色与授权表：住在 system 库，名字不带 `__chusql_` 前缀（Rust 存储层拒收那个前缀）
-rolesTable :: String
-rolesTable = "sys_roles"
-
-grantsTable :: String
-grantsTable = "sys_grants"
-
-membersTable :: String
-membersTable = "sys_members"
-
-internalNames :: [String]
-internalNames = [rolesTable, grantsTable, membersTable]
-
-reserved :: String -> Bool
-reserved = T.isPrefixOf "__chusql_" . T.toLower . T.pack
-
-- | 服务自己的内部表：目录里不出现，普通作用域读写都拒（系统作用域才放行角色/授权表）
-internalTable :: String -> Bool
-internalTable name = reserved name || T.unpack (T.toLower (T.pack name)) `elem` internalNames
-
-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
-
-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)
-    case req of
-        ReqAccountsList -> Right accounts
-        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])
-        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"
-        ReqAccountDrop u -> case filter ((== T.toLower u) . accountUser) accounts of
-            [] -> Left "unknown account"
-            _ -> Right [x | x <- accounts, accountUser x /= T.toLower u]
-        _ -> Left "invalid account request"
-  where
-    decodeAccount row = case lookup "account" row of
-        Just (VStr encoded) -> A.eitherDecode (BL.pack encoded)
-        _ -> Left "invalid account record"
@@ -1,210 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.Config (
-    WebConfig (..),
-    defaultWebConfig,
-    defaultUser,
-    defaultPassword,
-    usingDefaultCredentials,
-    loadWebConfigAt,
-    resolveCredential,
-    resolveStaticDir,
-    staticDirCandidates,
-    rootUserName,
-    canonicalSettingKeys,
-    resolvePipeName,
-) where
-
-import ChuSQL.Storage.IPC (defaultPipeName)
-import ChuSQL.Web.Auth (Credential (..), hashPassword)
-import ChuSQL.Web.TOML (readSection)
-import Data.Char (toLower)
-import qualified Data.Map.Strict as Map
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import System.Directory (doesDirectoryExist)
-import Text.Read (readMaybe)
-
-- 运行参数：命令行 > 全局 chusql.toml 的分区 > 内置默认，不看环境变量。
-- 配置文件位置是固定的（安装时定下，见 ChuSQL.Web.TOML.defaultConfigFile），
-- 想读别处的文件只能在命令行用 --config 指。
-- 自己那段是 [web]；管名与数据目录取自 [server] pipe_name / [storage] data_dir，
-- 因为它们是存储进程的事实，前端只当端点读。root 凭据只认 [web] 里的明文。
-
-- | 默认账号名
-defaultUser :: Text
-defaultUser = "root"
-
-- | 默认口令（只为方便本地测试；生产/对外必须覆盖）
-defaultPassword :: Text
-defaultPassword = "chusql"
-
-data WebConfig = WebConfig
-    { wcHost :: String
-    , wcPort :: Int
-    , wcStaticDir :: FilePath
-    , wcUser :: Text
-    , wcStorageServer :: Maybe FilePath
-    , wcPipeName :: Maybe String
-    , wcDataDir :: Maybe FilePath
-    , wcCookieSecure :: Bool
-    , wcBodyLimit :: Int
-    , wcSessionIdle :: Int
-    , wcSessionMax :: Int
-    , wcLoginMaxAttempts :: Int
-    , wcLoginWindow :: Int
-    , wcPageSize :: Int
-    , wcMaxPageSize :: Int
-    , wcMaxRows :: Int
-    , wcMaxSqlLength :: Int
-    , wcSeedDemo :: Bool
-    }
-    deriving (Show, Eq)
-
-- | 内置默认
-defaultWebConfig :: WebConfig
-defaultWebConfig =
-    WebConfig
-        { wcHost = "127.0.0.1"
-        , wcPort = 7777
-        , wcStaticDir = "static"
-        , wcUser = ""
-        , wcStorageServer = Nothing
-        , wcPipeName = Nothing
-        , wcDataDir = Nothing
-        , wcCookieSecure = False
-        , wcBodyLimit = 65536
-        , wcSessionIdle = 8 * 3600
-        , wcSessionMax = 24 * 3600
-        , wcLoginMaxAttempts = 5
-        , wcLoginWindow = 5 * 60
-        , wcPageSize = 25
-        , wcMaxPageSize = 500
-        , wcMaxRows = 1000
-        , wcMaxSqlLength = 20000
-        , wcSeedDemo = False
-        }
-
-- | [web] 分区里的键统一成连字符写法（scripts/chusql.toml 用的是下划线）
--   两种写法同时出现时，连字符（设置页写的规范形式）优先。
-canonicalSettingKeys :: Map.Map Text Text -> Map.Map Text Text
-canonicalSettingKeys saved =
-    foldr (\(key, value) acc -> Map.insert (canonicalKey key) value acc) Map.empty (Map.toList saved)
-  where
-    canonicalKey key = fromMaybe key (lookup key keyAliases)
-
-- | 下划线写法到连字符写法的别名
-keyAliases :: [(Text, Text)]
-keyAliases =
-    [ ("static_dir", "static-dir")
-    , ("session_idle", "session-idle")
-    , ("session_max", "session-max")
-    , ("login_max_attempts", "login-max-attempts")
-    , ("login_window", "login-window")
-    , ("body_limit", "body-limit")
-    , ("rows_per_page", "rows-per-page")
-    , ("max_page_size", "max-page-size")
-    , ("max_rows", "max-rows")
-    , ("max_sql_length", "max-sql-length")
-    , ("password_min_length", "password-min-length")
-    , ("password_classes", "password-classes")
-    , ("storage_server", "storage-server")
-    ]
-
-- | 这份配置用的还是内置默认口令吗。
--   显式留空（password = ""）是"只允许管理员免密登录"，算已经配置过。
-usingDefaultCredentials :: Map.Map Text Text -> Bool
-usingDefaultCredentials saved = Map.notMember "password" saved
-
-- | 设置文件里某个键的非空值
-nonEmptyValue :: Text -> Map.Map Text Text -> Maybe Text
-nonEmptyValue key saved = case T.strip <$> Map.lookup key saved of
-    Just value | not (T.null value) -> Just value
-    _ -> Nothing
-
-- | root 凭据只认设置文件里的明文：给了明文就哈希它；显式留空就是免密（空编码串）；
--   没配这一项才回落到内置演示口令。
-resolveCredential :: WebConfig -> Map.Map Text Text -> IO Credential
-resolveCredential cfg saved = do
-    encoded <- case Map.lookup "password" saved of
-        Just plain | not (T.null (T.strip plain)) -> hashPassword (T.strip plain)
-        Just _ -> pure ""
-        Nothing -> hashPassword defaultPassword
-    pure (Credential (rootUserName cfg saved) encoded)
-
-- | 管理员名字：命令行 --user > 设置文件 user > 内置默认
-rootUserName :: WebConfig -> Map.Map Text Text -> Text
-rootUserName cfg saved
-    | not (T.null (T.strip (wcUser cfg))) = T.strip (wcUser cfg)
-    | otherwise = fromMaybe defaultUser (nonEmptyValue "user" saved)
-
-- | 读配置：内置默认 < [web] 分区（端点取自 [server] / [storage]）。
--   user / password 不在这里读：它们由 rootUserName / resolveCredential 直接看设置文件。
-loadWebConfigAt :: FilePath -> IO WebConfig
-loadWebConfigAt path = do
-    raw <- readSection path "web"
-    server <- readSection path "server"
-    storage <- readSection path "storage"
-    pure (withEndpoint server storage (webConfigFromSection (canonicalSettingKeys raw)))
-
-- | 端点：存储进程 bind 的管名与它用的数据目录，前端只读不改
-withEndpoint :: Map.Map Text Text -> Map.Map Text Text -> WebConfig -> WebConfig
-withEndpoint server storage cfg =
-    cfg
-        { wcPipeName = T.unpack <$> nonEmptyValue "pipe_name" server
-        , wcDataDir = T.unpack <$> nonEmptyValue "data_dir" storage
-        }
-
-- | 实际要连的管名：配置里没有就用与存储层一致的默认值
-resolvePipeName :: WebConfig -> String
-resolvePipeName cfg = fromMaybe defaultPipeName (wcPipeName cfg)
-
-- | [web] 分区里的启动参数，缺失或坏值一律回到内置默认
-webConfigFromSection :: Map.Map Text Text -> WebConfig
-webConfigFromSection saved =
-    defaultWebConfig
-        { wcHost = T.unpack (sectionText "host" saved (T.pack (wcHost defaultWebConfig)))
-        , wcPort = sectionInt "port" saved (wcPort defaultWebConfig)
-        , wcStaticDir = T.unpack (sectionText "static-dir" saved (T.pack (wcStaticDir defaultWebConfig)))
-        , wcCookieSecure = sectionBool "cookie-secure" saved (wcCookieSecure defaultWebConfig)
-        , wcBodyLimit = sectionInt "body-limit" saved (wcBodyLimit defaultWebConfig)
-        , wcSessionIdle = sectionInt "session-idle" saved (wcSessionIdle defaultWebConfig)
-        , wcSessionMax = sectionInt "session-max" saved (wcSessionMax defaultWebConfig)
-        , wcLoginMaxAttempts = sectionInt "login-max-attempts" saved (wcLoginMaxAttempts defaultWebConfig)
-        , wcLoginWindow = sectionInt "login-window" saved (wcLoginWindow defaultWebConfig)
-        , wcPageSize = sectionInt "rows-per-page" saved (wcPageSize defaultWebConfig)
-        , wcMaxPageSize = sectionInt "max-page-size" saved (wcMaxPageSize defaultWebConfig)
-        , wcMaxRows = sectionInt "max-rows" saved (wcMaxRows defaultWebConfig)
-        , wcMaxSqlLength = sectionInt "max-sql-length" saved (wcMaxSqlLength defaultWebConfig)
-        , wcSeedDemo = sectionBool "seed" saved (wcSeedDemo defaultWebConfig)
-        , wcStorageServer = T.unpack <$> nonEmptyValue "storage-server" saved
-        }
-
-- | 分区里一个键的非空字符串值
-sectionText :: Text -> Map.Map Text Text -> Text -> Text
-sectionText key saved def = fromMaybe def (nonEmptyValue key saved)
-
-- | 分区里的整数，解析不出来就用内置默认
-sectionInt :: Text -> Map.Map Text Text -> Int -> Int
-sectionInt key saved def = fromMaybe def (nonEmptyValue key saved >>= readMaybe . T.unpack)
-
-- | 分区里的布尔（1/true/yes/on 都算真）
-sectionBool :: Text -> Map.Map Text Text -> Bool -> Bool
-sectionBool key saved def = case nonEmptyValue key saved of
-    Nothing -> def
-    Just value -> map toLower (T.unpack value) `elem` ["1", "true", "yes", "on"]
-
-- | 静态目录候选位置，按顺序取第一个存在的
-staticDirCandidates :: FilePath -> [FilePath]
-staticDirCandidates given =
-    [given, "static", "chusql-web/static", "../chusql-web/static", "../static"]
-
-- | 找出真正能用的静态目录
-resolveStaticDir :: FilePath -> IO (Maybe FilePath)
-resolveStaticDir given = go (staticDirCandidates given)
-  where
-    go [] = pure Nothing
-    go (d : ds) = do
-        ok <- doesDirectoryExist d
-        if ok then pure (Just d) else go ds
@@ -10,16 +10,17 @@ module ChuSQL.Web.Demo (
    seedDemo,
 ) where

-import ChuSQL.Model (Value (..))
-import ChuSQL.Storage.IPC (TableInfo (..))
-import ChuSQL.Web.Actions (
+import ChuSQL.Core.Model (Value (..))
+import ChuSQL.Core.Protocol (TableInfo (..))
+import ChuSQL.Interface.Actions (
    ColumnSpec (..),
    CreateTableSpec (..),
    createIndexSql,
    createTableSql,
    insertRowsSql,
 )
-import ChuSQL.Web.Backend (Backend (..))
+import ChuSQL.Interface.Session (Session, catalog, runStatement)
+import Data.Text (Text)
 import qualified Data.Text as T

 -- 演示数据：三张表加一个二级索引，语句与界面走同一套拼 SQL 的代码。
@@ -75,12 +76,12 @@ data SeedReport = SeedReport
    }
    deriving (Show, Eq)

-- | 缺什么补什么，可反复点不重复灌
-seedDemo :: Backend -> IO (Either String SeedReport)
-seedDemo backend = do
-    catalog <- beCatalog backend
-    case catalog of
-        Left e -> pure (Left e)
+-- | 按需灌演示数据：缺表补表、缺索引补索引
+seedDemo :: Session -> IO (Either Text SeedReport)
+seedDemo session = do
+    catalogResult <- catalog session
+    case catalogResult of
+        Left message -> pure (Left message)
        Right infos -> do
            let existingTables = map tiTable infos
                missing = [spec | spec <- demoTableSpecs, T.unpack (ctsTable spec) `notElem` existingTables]
@@ -93,34 +94,33 @@ seedDemo backend = do
                    ]
            created <- runAll (map createTableSql missing)
            case created of
-                Left e -> pure (Left e)
+                Left message -> pure (Left message)
                Right () -> do
                    rowsDone <- runAll [insertRowsSql t rs | (t, rs) <- demoRows, t `elem` missingNames]
                    case rowsDone of
-                        Left e -> pure (Left e)
+                        Left message -> pure (Left message)
                        Right () -> do
-                            indexes <-
-                                runAll [createIndexSql t c | (t, c) <- wantedIndexes]
-                            pure $
-                                fmap
-                                    (const (SeedReport (map T.unpack missingNames) skipped (map (T.unpack . snd) wantedIndexes)))
-                                    indexes
+                            indexes <- runAll [createIndexSql t c | (t, c) <- wantedIndexes]
+                            pure $ fmap (const (SeedReport (map T.unpack missingNames) skipped (map (T.unpack . snd) wantedIndexes))) indexes
  where
-    runAll :: [Either String String] -> IO (Either String ())
+    -- | 顺序跑完一串语句，首错即停
+    runAll :: [Either String String] -> IO (Either Text ())
    runAll [] = pure (Right ())
    runAll (sql : rest) = case sql of
-        Left e -> pure (Left e)
+        Left e -> pure (Left (T.pack e))
        Right statement -> do
-            result <- beStatement backend statement
+            result <- runStatement session (T.pack statement)
            case result of
-                Left e -> pure (Left e)
+                Left message -> pure (Left message)
                Right _ -> runAll rest

-    indexMissing :: [TableInfo] -> T.Text -> T.Text -> Bool
+    -- | 目录里这张表缺不缺这个索引
+    indexMissing :: [TableInfo] -> Text -> Text -> Bool
    indexMissing infos t c = case lookup (T.unpack t) [(tiTable i, tiIndexes i) | i <- infos] of
        Nothing -> True
        Just cols -> T.unpack c `notElem` cols

+-- | 演示用户数据
 userRecords :: [(String, Int)]
 userRecords =
    [ ("Alice", 24)
@@ -135,6 +135,7 @@ userRecords =
    , ("Judy", 29)
    ]

+-- | 演示订单数据
 orderRecords :: [(Int, String, Int)]
 orderRecords =
    [ (1, "Laptop", 1299)
@@ -151,6 +152,7 @@ orderRecords =
    , (9, "Lamp", 39)
    ]

+-- | 演示产品数据
 productRecords :: [(String, Int, Int)]
 productRecords =
    [ ("Laptop", 1001, 1299)
@@ -1,396 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-- | 角色与权限服务。
--
--   模型：权限挂在角色上，用户通过角色成员资格继承角色权限；管理员（root）隐式全权，
--   新账号默认零权限。语句（CREATE ROLE / DROP ROLE / GRANT / REVOKE）由引擎解析并做
--   基本校验，真正落库在这里。
--
--   存储：system 库里的三张普通表（`sys_roles` / `sys_grants` / `sys_members`）。
--   起普通名字是因为 Rust 存储层拒收 `__chusql_` 前缀的表名，那条路走不通；
--   读写都借 system 作用域后端的普通 SQL，内存后端与 IPC 后端共用一套逻辑。
-module ChuSQL.Web.Privileges (
-    Grant (..),
-    Membership (..),
-    PrivilegeCommand (..),
-    PrivilegeError (..),
-    Privileges,
-    RoleView (..),
-    authorize,
-    authorizeTables,
-    filterTables,
-    listRoleViews,
-    newPrivileges,
-    normalizeObject,
-    privilegeCommand,
-    runPrivilegeCommand,
-) where
-
-import ChuSQL.Model (Row, Value (..))
-import ChuSQL.Syntax.AST
-import ChuSQL.Web.Accounts (Principal, principalIsRoot, principalName)
-import ChuSQL.Web.Actions (sqlLiteral)
-import ChuSQL.Web.Backend (
-    Backend (..),
-    StatementResult (..),
-    exprTables,
-    grantsTable,
-    membersTable,
-    rolesTable,
-    systemDatabaseName,
-    tableRefsOf,
- )
-import Control.Concurrent.MVar (MVar, newMVar, withMVar)
-import Data.List (intercalate, isInfixOf, nub, sort)
-import Data.Text (Text)
-import qualified Data.Text as T
-
-- | 出错口径与账号服务一致，映射由 API 层统一做
-data PrivilegeError = PrivilegeError Text Text
-    deriving (Show, Eq)
-
-- | 一条角色授权：角色 + 具体权限 + 对象（`*` 或 `库.表`）
-data Grant = Grant
-    { grantRole :: Text
-    , grantPrivilege :: Text
-    , grantObject :: Text
-    }
-    deriving (Show, Eq, Ord)
-
-- | 角色成员资格
-data Membership = Membership
-    { memberRole :: Text
-    , memberUser :: Text
-    }
-    deriving (Show, Eq, Ord)
-
-- | 一个角色的全貌
-data RoleView = RoleView
-    { roleName :: Text
-    , roleGrants :: [Grant]
-    , roleMembers :: [Text]
-    }
-    deriving (Show, Eq)
-
-data PrivilegeCommand
-    = CreateRoleCommand Text
-    | DropRoleCommand Text
-    | GrantPrivilegesCommand [Text] Text Text
-    | RevokePrivilegesCommand [Text] Text Text
-    | GrantRoleCommand Text [Text]
-    | RevokeRoleCommand Text [Text]
-    deriving (Show, Eq)
-
-data Privileges = Privileges
-    { pvBackend :: Backend
-    , pvLock :: MVar ()
-    }
-
-- | 服务固定看 system 库；构造时不碰存储，第一次用才建表
-newPrivileges :: Backend -> IO Privileges
-newPrivileges base = do
-    lock <- newMVar ()
-    pure (Privileges (beWithDatabase base systemDatabaseName) lock)
-
-- | 语句 → 管理命令（引擎只解析与基本校验，不认的语句给 Nothing）
-privilegeCommand :: Statement -> Maybe PrivilegeCommand
-privilegeCommand stmt = case stmt of
-    CreateRole name -> Just (CreateRoleCommand (T.pack name))
-    DropRole name -> Just (DropRoleCommand (T.pack name))
-    GrantPrivileges privs obj role ->
-        Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role))
-    RevokePrivileges privs obj role ->
-        Just (RevokePrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role))
-    GrantRole role members -> Just (GrantRoleCommand (T.pack role) (map T.pack members))
-    RevokeRole role members -> Just (RevokeRoleCommand (T.pack role) (map T.pack members))
-    _ -> Nothing
-
-- | 执行管理命令：只有管理员能跑，命令提到的角色必须已经存在
-runPrivilegeCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
-runPrivilegeCommand service principal database command
-    | not (principalIsRoot principal) = pure (Left forbidden)
-    | needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected"))
-    | otherwise = withTables service (applyCommand service database command)
-  where
-    -- 授权到具体对象（不是 `*`）时要把裸表名补成 `库.表`，没选库就无从补全
-    needsDatabase = T.null database && case command of
-        GrantPrivilegesCommand _ object _ -> T.strip object /= "*"
-        RevokePrivilegesCommand _ object _ -> T.strip object /= "*"
-        _ -> False
-
-- | 语句鉴权：管理员全通；普通身份按语句需要的每一项 (表, 权限) 查
-authorize :: Privileges -> Principal -> Text -> Statement -> IO (Either PrivilegeError ())
-authorize service principal database stmt
-    | principalIsRoot principal = pure (Right ())
-    | otherwise = case requiredActions stmt of
-        Nothing -> pure (Left forbidden)
-        Just needed -> authorizeTables service principal database needed
-
-- | 直接查一组 (表, 权限)：一键接口用这个
-authorizeTables :: Privileges -> Principal -> Text -> [(Text, Text)] -> IO (Either PrivilegeError ())
-authorizeTables service principal database needed
-    | principalIsRoot principal = pure (Right ())
-    | otherwise = withTables service $ do
-        grants <- grantsOfUser service (principalName principal)
-        pure (grants >>= \found -> checkAll database found needed)
-
-- | 只留下用户有 SELECT 权限的表（管理员看全部）；表清单接口用
-filterTables :: Privileges -> Principal -> Text -> [Text] -> IO (Either PrivilegeError [Text])
-filterTables service principal database tables
-    | principalIsRoot principal = pure (Right tables)
-    | otherwise = withTables service $ do
-        grants <- grantsOfUser service (principalName principal)
-        pure ((\found -> [table | table <- tables, checkAll database found [(table, "select")] == Right ()]) <$> grants)
-
-- | 角色总览（REST 与测试用）
-listRoleViews :: Privileges -> IO (Either PrivilegeError [RoleView])
-listRoleViews service = withTables service $ do
-    names <- roleNames service
-    case names of
-        Left err -> pure (Left err)
-        Right known -> sequence <$> mapM view (sort known)
-  where
-    view role = do
-        grants <- roleGrantsOf service role
-        members <- membersOfRole service role
-        pure (RoleView role <$> grants <*> members)
-
-- | 授权对象落库口径：`*` 原样，裸表名按当前库补全
-normalizeObject :: Text -> Text -> Text
-normalizeObject database object
-    | T.strip object == "*" = "*"
-    | T.any (== '.') object = T.toLower (T.strip object)
-    | otherwise = normalizeUser database <> "." <> normalizeUser object
-
-- | 一条语句需要哪些 (表, 权限)；Nothing 表示管理员专属
-requiredActions :: Statement -> Maybe [(Text, Text)]
-requiredActions stmt = case stmt of
-    Select{} -> Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt)))
-    SelectExpr{} ->
-        Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems stmt)))
-    Insert table _ rows -> Just ((T.pack table, "insert") : selectsOf (concat rows))
-    Update table assigns cond -> Just ((T.pack table, "update") : selectsOf (map snd assigns ++ maybe [] (: []) cond))
-    Delete table cond -> Just ((T.pack table, "delete") : selectsOf (maybe [] (: []) cond))
-    _ -> Nothing
-  where
-    selectNeeds source exprs = [(ref, "select") | ref <- nub (tableRefsOf source)] ++ selectsOf exprs
-    selectsOf exprs = [(ref, "select") | ref <- nub (concatMap exprTables exprs)]
-
-- | 每项 (表, 权限) 都要被某条授权覆盖
-checkAll :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
-checkAll database grants needed = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of
-    [] -> Right ()
-    ((table, privilege) : _) ->
-        Left (PrivilegeError "forbidden" ("permission denied: " <> T.toUpper privilege <> " ON " <> table))
-  where
-    covered table privilege =
-        let target = normalizeObject database table
-         in any
-                (\grant -> (grantObject grant == "*" || grantObject grant == target) && grantPrivilege grant == privilege)
-                grants
-
-- | 一个用户实际能用的授权：他所属角色身上的那些
-grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
-grantsOfUser service user = do
-    members <- readRows service membersTable
-    rows <- readRows service grantsTable
-    pure $ do
-        memberRows <- members
-        grantRows <- rows
-        let mine = [normalizeRole (cell "role" row) | row <- memberRows, normalizeUser (cell "member" row) == normalizeUser user]
-        pure [grantOf row | row <- grantRows, normalizeRole (cell "role" row) `elem` mine]
-
-- | 一个角色挂着的授权
-roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
-roleGrantsOf service role = do
-    rows <- readRows service grantsTable
-    pure $ fmap (map grantOf . filter (\row -> normalizeRole (cell "role" row) == normalizeRole role)) rows
-
-- | 角色名清单（统一小写）
-roleNames :: Privileges -> IO (Either PrivilegeError [Text])
-roleNames service = do
-    rows <- readRows service rolesTable
-    pure (map (normalizeRole . cell "name") <$> rows)
-
-- | 一个角色的成员清单
-membersOfRole :: Privileges -> Text -> IO (Either PrivilegeError [Text])
-membersOfRole service role = do
-    rows <- readRows service membersTable
-    pure $
-        fmap
-            (map (normalizeUser . cell "member") . filter (\row -> normalizeRole (cell "role" row) == normalizeRole role))
-            rows
-
-- | 角色必须存在，否则命令不落地
-requireRole :: Privileges -> Text -> IO (Either PrivilegeError ())
-requireRole service role = do
-    known <- roleNames service
-    pure $ case known of
-        Left err -> Left err
-        Right names
-            | normalizeRole role `elem` names -> Right ()
-            | otherwise -> Left (unknownRole role)
-
-- | 真正落库（表已经保证存在）
-applyCommand :: Privileges -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
-applyCommand service database command = case command of
-    CreateRoleCommand role -> do
-        known <- roleNames service
-        case known of
-            Left err -> pure (Left err)
-            Right names
-                | normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
-                | otherwise -> exec service (insertSql rolesTable ["name"] [normalizeRole role])
-    DropRoleCommand role -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () -> do
-                first <- exec service ("DELETE FROM " ++ rolesTable ++ " WHERE name = " ++ roleLiteral role)
-                second <- exec service ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role)
-                third <- exec service ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role)
-                pure (sequence_ [first, second, third])
-    GrantPrivilegesCommand privileges object role -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () -> each (expandPrivileges privileges) $ \privilege -> do
-                let target = normalizeObject database object
-                cleared <- exec service (deleteGrantSql role privilege target)
-                case cleared of
-                    Left err -> pure (Left err)
-                    Right () ->
-                        exec service (insertSql grantsTable ["role", "privilege", "object"] [normalizeRole role, privilege, target])
-    RevokePrivilegesCommand privileges object role -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () ->
-                each (expandPrivileges privileges) $ \privilege ->
-                    exec service (deleteGrantSql role privilege (normalizeObject database object))
-    GrantRoleCommand role users -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () ->
-                each users $ \user -> do
-                    known <- membersOfRole service role
-                    case known of
-                        Left err -> pure (Left err)
-                        Right members
-                            | normalizeUser user `elem` members -> pure (Right ())
-                            | otherwise ->
-                                exec service (insertSql membersTable ["role", "member"] [normalizeRole role, normalizeUser user])
-    RevokeRoleCommand role users -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () ->
-                each users $ \user ->
-                    exec
-                        service
-                        ( "DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role
-                            ++ " AND member = " ++ literal (normalizeUser user)
-                        )
-
-- | 建表只在第一次用时做；已经有了就算成功
-withTables :: Privileges -> IO (Either PrivilegeError a) -> IO (Either PrivilegeError a)
-withTables service action = withMVar (pvLock service) $ \_ -> do
-    ready <- ensureTables service
-    case ready of
-        Left err -> pure (Left err)
-        Right () -> action
-
-ensureTables :: Privileges -> IO (Either PrivilegeError ())
-ensureTables service = each tableDefs (createTable service)
-  where
-    tableDefs =
-        [ (rolesTable, "(name VARCHAR(64))")
-        , (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
-        , (membersTable, "(role VARCHAR(64), member VARCHAR(64))")
-        ]
-
-createTable :: Privileges -> (String, String) -> IO (Either PrivilegeError ())
-createTable service (table, columns) = do
-    result <- beStatement (pvBackend service) ("CREATE TABLE " ++ table ++ " " ++ columns)
-    pure $ case result of
-        Right _ -> Right ()
-        Left err
-            | "exists" `isInfixOf` err -> Right ()
-            | otherwise -> Left (storageError err)
-
-- | 跑一条内部写语句
-exec :: Privileges -> String -> IO (Either PrivilegeError ())
-exec service sql = do
-    result <- beStatement (pvBackend service) sql
-    pure $ case result of
-        Left err -> Left (storageError err)
-        Right _ -> Right ()
-
-- | 读一张内部表
-readRows :: Privileges -> String -> IO (Either PrivilegeError [Row])
-readRows service table = do
-    result <- beStatement (pvBackend service) ("SELECT * FROM " ++ table)
-    pure $ case result of
-        Left err -> Left (storageError err)
-        Right res -> Right (srRows res)
-
-- | 行里取一列文本
-cell :: String -> Row -> Text
-cell column row = case lookup column row of
-    Just (VStr value) -> T.pack value
-    _ -> ""
-
-grantOf :: Row -> Grant
-grantOf row =
-    Grant
-        { grantRole = normalizeRole (cell "role" row)
-        , grantPrivilege = T.toLower (T.strip (cell "privilege" row))
-        , grantObject = T.toLower (T.strip (cell "object" row))
-        }
-
-deleteGrantSql :: Text -> Text -> Text -> String
-deleteGrantSql role privilege object =
-    "DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role
-        ++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object
-
-insertSql :: String -> [String] -> [Text] -> String
-insertSql table columns values =
-    "INSERT INTO " ++ table ++ " (" ++ intercalate ", " columns ++ ") VALUES (" ++ intercalate ", " (map literal values) ++ ")"
-
-- | 授权里的 ALL 展开成四种具体权限（存具体权限，鉴权不做兜底）
-expandPrivileges :: [Text] -> [Text]
-expandPrivileges privileges = nub (concatMap expand (map (T.toLower . T.strip) privileges))
-  where
-    expand "all" = ["select", "insert", "update", "delete"]
-    expand other = [other]
-
-- | 一串动作挨着跑，遇到第一个错误就停
-each :: [a] -> (a -> IO (Either PrivilegeError ())) -> IO (Either PrivilegeError ())
-each [] _ = pure (Right ())
-each (item : rest) action = do
-    result <- action item
-    case result of
-        Left err -> pure (Left err)
-        Right () -> each rest action
-
-roleLiteral :: Text -> String
-roleLiteral = literal . normalizeRole
-
-literal :: Text -> String
-literal = sqlLiteral . VStr . T.unpack
-
-normalizeRole :: Text -> Text
-normalizeRole = T.toLower . T.strip
-
-normalizeUser :: Text -> Text
-normalizeUser = T.toLower . T.strip
-
-forbidden :: PrivilegeError
-forbidden = PrivilegeError "forbidden" "administrator required"
-
-unknownRole :: Text -> PrivilegeError
-unknownRole role = PrivilegeError "not_found" ("unknown role: " <> role)
-
-storageError :: String -> PrivilegeError
-storageError message = PrivilegeError "storage_error" ("privilege storage: " <> T.pack message)
@@ -1,72 +0,0 @@
-module ChuSQL.Web.RateLimit (
-    RateLimiter,
-    newRateLimiter,
-    setRateLimit,
-    rateLimitBlock,
-    rateLimitRecord,
-    rateLimitClear,
-) where
-
-import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import qualified Data.Map.Strict as Map
-import Data.Text (Text)
-import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)
-
-- 登录失败限流：按用户名数一个滑动窗口里的失败次数。
-
-data Attempt = Attempt
-    { attCount :: Int
-    , attStart :: UTCTime
-    }
-
-data RateLimitPolicy = RateLimitPolicy
-    { rlpMax :: Int
-    , rlpWindow :: NominalDiffTime
-    }
-
-data RateLimiter = RateLimiter
-    { rlMap :: MVar (Map.Map Text Attempt)
-    , rlPolicy :: IORef RateLimitPolicy
-    , rlClock :: IO UTCTime
-    }
-
-- | 造一个限流器：多少次失败、窗口多长
-newRateLimiter :: IO UTCTime -> Int -> NominalDiffTime -> IO RateLimiter
-newRateLimiter clock maxFailures window = do
-    ref <- newMVar Map.empty
-    policyRef <- newIORef (RateLimitPolicy maxFailures window)
-    pure (RateLimiter ref policyRef clock)
-
-- | 换一套限流阈值（设置页热改）
-setRateLimit :: RateLimiter -> Int -> NominalDiffTime -> IO ()
-setRateLimit rl maxFailures window =
-    writeIORef (rlPolicy rl) (RateLimitPolicy maxFailures window)
-
-- | 这个键被锁住了吗？锁住就返回还要等多少秒
-rateLimitBlock :: RateLimiter -> Text -> IO (Maybe NominalDiffTime)
-rateLimitBlock rl key = do
-    now <- rlClock rl
-    pol <- readIORef (rlPolicy rl)
-    m <- readMVar (rlMap rl)
-    pure $ case Map.lookup key m of
-        Just a
-            | attCount a >= rlpMax pol ->
-                let left = rlpWindow pol - diffUTCTime now (attStart a)
-                 in if left > 0 then Just left else Nothing
-        _ -> Nothing
-
-- | 记一次失败
-rateLimitRecord :: RateLimiter -> Text -> IO ()
-rateLimitRecord rl key = do
-    now <- rlClock rl
-    pol <- readIORef (rlPolicy rl)
-    modifyMVar_ (rlMap rl) $ \m ->
-        let kept = Map.filter (\a -> diffUTCTime now (attStart a) < rlpWindow pol) m
-            old = Map.findWithDefault (Attempt 0 now) key kept
-            fresh = if attCount old == 0 then Attempt 1 now else old{attCount = attCount old + 1}
-         in pure (Map.insert key fresh kept)
-
-- | 登录成功就把失败记录清掉
-rateLimitClear :: RateLimiter -> Text -> IO ()
-rateLimitClear rl key = modifyMVar_ (rlMap rl) (pure . Map.delete key)
@@ -1,237 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.Settings (
-    SettingItem (..),
-    settingCatalogue,
-    findItem,
-    isRootOnly,
-    isLockedSetting,
-    isRestartRequired,
-    readSettingsFile,
-    writeSettingsFile,
-    applySettings,
-    liveKeys,
-    defaultOf,
-    effectiveSettings,
-) where
-
-import ChuSQL.Web.Config (WebConfig (..), canonicalSettingKeys, defaultUser)
-import ChuSQL.Web.TOML (readSection, writeSection)
-import Data.List (nub)
-import qualified Data.Map.Strict as Map
-import Data.Text (Text)
-import qualified Data.Text as T
-
-- Web 配置项目录，与启动脚本共用一份全局 chusql.toml；
-- 每个键只写在它所属的那一段里，web 不再复制存储层的键。
-
-data SettingItem = SettingItem
-    { siKey :: Text
-    , siLabel :: Text
-    , siGroup :: Text
-    , siKind :: Text
-    , siDefault :: Text
-    , siRootOnly :: Bool
-    , siRestart :: Bool
-    , siSection :: Text
-    , siTomlKey :: Text
-    }
-    deriving (Show, Eq)
-
-- | 全部可配置项（顺序即界面里的顺序）
-settingCatalogue :: [SettingItem]
-settingCatalogue =
-    [ item "port" "HTTP port" "server" "int" "7777" True True
-    , item "host" "Listen address" "server" "text" "127.0.0.1" True True
-    , item "static-dir" "Static directory" "server" "text" "static" True True
-    , item "cookie-secure" "Secure cookie (behind TLS)" "server" "bool" "0" True False
-    , item "body-limit" "Max request body (bytes)" "limits" "int" "65536" False False
-    , item "session-idle" "Session idle timeout (s)" "limits" "int" "28800" False False
-    , item "session-max" "Session max age (s)" "limits" "int" "86400" False False
-    , item "login-max-attempts" "Failed logins before lockout" "limits" "int" "5" False False
-    , item "login-window" "Lockout window (s)" "limits" "int" "300" False False
-    , item "rows-per-page" "Rows per page" "limits" "int" "25" False False
-    , item "max-page-size" "Rows per page ceiling" "limits" "int" "500" False False
-    , item "max-rows" "Rows per query" "limits" "int" "1000" False False
-    , item "max-sql-length" "Max SQL characters" "limits" "int" "20000" False False
-    , item "user" "管理员账号（设置文件）" "auth" "text" "root" True True
-    , item "password" "管理员口令（设置文件，明文）" "auth" "secret" "" True True
-    , item "password-min-length" "口令最短长度" "auth" "int" "12" True False
-    , item "password-classes" "口令字符类别数" "auth" "int" "2" True False
-    , owned "data-dir" "Data directory" "storage" "text" "" "storage" "data_dir"
-    , owned "pipe-name" "Endpoint name" "storage" "text" "" "server" "pipe_name"
-    , owned "storage-page-size" "Storage page size" "storage" "int" "4096" "page" "size"
-    , owned "storage-btree-order" "Storage B+tree order" "storage" "int" "4" "btree" "order"
-    , owned "storage-buffer-pool" "Storage buffer pool pages" "storage" "int" "1024" "buffer" "pool_size"
-    , owned "storage-log" "Storage log level" "storage" "text" "info" "log" "level"
-    , item "storage-server" "Storage server executable" "storage" "text" "" True True
-    , item "seed" "Seed demo data on start" "storage" "bool" "1" True True
-    ]
-  where
-    -- web 自己的键：分区写死 [web]，TOML 键名就是界面键名
-    item k l g kind def rootOnly restart =
-        SettingItem
-            { siKey = k
-            , siLabel = l
-            , siGroup = g
-            , siKind = kind
-            , siDefault = def
-            , siRootOnly = rootOnly
-            , siRestart = restart
-            , siSection = webSection
-            , siTomlKey = k
-            }
-    -- 存储层的键：只读自己那段
-    owned k l g kind def section tomlKey =
-        SettingItem
-            { siKey = k
-            , siLabel = l
-            , siGroup = g
-            , siKind = kind
-            , siDefault = def
-            , siRootOnly = True
-            , siRestart = True
-            , siSection = section
-            , siTomlKey = tomlKey
-            }
-
-- | web 自己那段
-webSection :: Text
-webSection = "web"
-
-- | 目录里涉及的分区（按出现顺序，去重）
-catalogueSections :: [Text]
-catalogueSections = nub [siSection i | i <- settingCatalogue]
-
-- | 按 key 找一项
-findItem :: Text -> Maybe SettingItem
-findItem key = case [i | i <- settingCatalogue, siKey i == key] of
-    (i : _) -> Just i
-    [] -> Nothing
-
-- | 这项是不是重要参数（只有配置账号能改）
-isRootOnly :: Text -> Bool
-isRootOnly key = maybe False siRootOnly (findItem key)
-
-- | 只读项：root 凭据只认设置文件里的明文，网页端不能改（改文件后重启生效）
-lockedKeys :: [Text]
-lockedKeys = ["user", "password"]
-
-- | 这项在界面上是不是只读
-isLockedSetting :: Text -> Bool
-isLockedSetting = (`elem` lockedKeys)
-
-- | 这项是不是要重启才生效
-isRestartRequired :: Text -> Bool
-isRestartRequired key = maybe False siRestart (findItem key)
-
-- | 改完立刻生效的配置键
-liveKeys :: [Text]
-liveKeys =
-    [ "password-min-length", "password-classes"
-    , "body-limit"
-    , "session-idle"
-    , "session-max"
-    , "login-max-attempts"
-    , "login-window"
-    , "rows-per-page"
-    , "max-page-size"
-    , "max-rows"
-    , "max-sql-length"
-    ]
-
-- | 读目录里用到的每个分区，摊成界面键；只有 [web] 统一成连字符写法
-readSettingsFile :: FilePath -> IO (Map.Map Text Text)
-readSettingsFile path = fmap Map.unions (mapM readSectionOf catalogueSections)
-  where
-    readSectionOf section = do
-        raw <- readSection path section
-        let values = if section == webSection then canonicalSettingKeys raw else raw
-        pure
-            ( Map.fromList
-                [ (siKey i, value)
-                | i <- settingCatalogue
-                , siSection i == section
-                , Just value <- [Map.lookup (siTomlKey i) values]
-                ]
-            )
-
-- | 按分区写回：每个键落进自己的段，别的分区与注释原样保留
-writeSettingsFile :: FilePath -> Map.Map Text Text -> IO (Either String ())
-writeSettingsFile path values = writeSections catalogueSections
-  where
-    writeSections [] = pure (Right ())
-    writeSections (section : rest) = do
-        let entries =
-                Map.fromList
-                    [ (siTomlKey i, value)
-                    | i <- settingCatalogue
-                    , siSection i == section
-                    , Just value <- [Map.lookup (siKey i) values]
-                    ]
-        if Map.null entries
-            then writeSections rest
-            else do
-                written <- writeSection path section entries
-                case written of
-                    Left err -> pure (Left err)
-                    Right () -> writeSections rest
-
-- | 把界面上传来的值合并进现有文件内容（只接受目录里有的键）
-applySettings :: Map.Map Text Text -> Map.Map Text Text -> Either String (Map.Map Text Text)
-applySettings current = go (Right current) . Map.toList
-  where
-    go (Left e) _ = Left e
-    go (Right acc) [] = Right acc
-    go (Right acc) ((key, value) : rest) = case findItem key of
-        Nothing -> Left ("unknown setting: " ++ T.unpack key)
-        Just spec -> case checkKind spec value of
-            Left e -> Left e
-            Right () -> go (Right (Map.insert key value acc)) rest
-
-- | 按类型校验一个值（空串表示"清掉"，一律放行）
-checkKind :: SettingItem -> Text -> Either String ()
-checkKind spec value
-    | T.null (T.strip value) = Right ()
-    | Just (lo, hi) <- lookup (siKey spec) [("password-min-length", (8, 256)), ("password-classes", (1, 4))] =
-        case reads (T.unpack (T.strip value)) :: [(Int, String)] of
-            [(n, "")] | n >= lo && n <= hi -> Right ()
-            _ -> Left (T.unpack (siKey spec) ++ " is outside the permitted range")
-    | siKind spec == "int" = case reads (T.unpack (T.strip value)) :: [(Int, String)] of
-        [(_, "")] -> Right ()
-        _ -> Left (T.unpack (siKey spec) ++ " needs an integer, got: " ++ T.unpack value)
-    | siKind spec == "bool" = case T.toLower (T.strip value) of
-        v | v `elem` ["0", "1", "true", "false", "yes", "no", "on", "off"] -> Right ()
-        _ -> Left (T.unpack (siKey spec) ++ " needs a boolean, got: " ++ T.unpack value)
-    | otherwise = Right ()
-
-- | 一项的内置默认值（设置被清掉、也没有别处给值时用它）
-defaultOf :: Text -> Text
-defaultOf key = maybe "" siDefault (findItem key)
-
-- | 本进程启动时生效的配置，摊成键值对
-effectiveSettings :: WebConfig -> Map.Map Text Text
-effectiveSettings cfg =
-    Map.fromList
-        [ ("port", tshow (wcPort cfg))
-        , ("host", T.pack (wcHost cfg))
-        , ("static-dir", T.pack (wcStaticDir cfg))
-        , ("cookie-secure", boolText (wcCookieSecure cfg))
-        , ("body-limit", tshow (wcBodyLimit cfg))
-        , ("session-idle", tshow (wcSessionIdle cfg))
-        , ("session-max", tshow (wcSessionMax cfg))
-        , ("login-max-attempts", tshow (wcLoginMaxAttempts cfg))
-        , ("login-window", tshow (wcLoginWindow cfg))
-        , ("rows-per-page", tshow (wcPageSize cfg))
-        , ("max-page-size", tshow (wcMaxPageSize cfg))
-        , ("max-rows", tshow (wcMaxRows cfg))
-        , ("max-sql-length", tshow (wcMaxSqlLength cfg))
-        , ("user", if T.null (T.strip (wcUser cfg)) then defaultUser else T.strip (wcUser cfg))
-        , ("seed", boolText (wcSeedDemo cfg))
-        , ("data-dir", maybe "" T.pack (wcDataDir cfg))
-        , ("pipe-name", maybe "" T.pack (wcPipeName cfg))
-        ]
-  where
-    tshow = T.pack . show
-    boolText True = "1"
-    boolText False = "0"
@@ -23,7 +23,7 @@ maxNameLength = 128
 allowedExtensions :: [String]
 allowedExtensions = [".html", ".css", ".js", ".svg", ".png", ".ico", ".ttf", ".woff2"]

-- | 把请求里的文件名变成安全的相对路径；不合法给 Nothing
+-- | 把请求文件名校验成安全相对路径，不合法给 Nothing
 safeRelative :: Text -> Maybe FilePath
 safeRelative t
    | T.null t = Nothing
@@ -33,6 +33,7 @@ safeRelative t
    | map toLower (takeExtension (T.unpack t)) `notElem` allowedExtensions = Nothing
    | otherwise = Just (T.unpack t)
  where
+    -- | 文件名里是否出现不允许的字符
    badChar c = not (isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("._-" :: String))

 -- | 读一个静态文件；不存在（或是目录）给 Nothing
@@ -1,113 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.StorageProcess (
-    StorageProcess (..),
-    findStorageServer,
-    startStorageProcess,
-    startStorageProcessAt,
-    platformBinaryName,
-    storageChildArgs,
-    stopStorageProcess,
-    waitForStorage,
-) where
-
-import ChuSQL.Storage.IPC (Request (..), Response (..), closeConnection, sendRequest, setPipeName)
-import ChuSQL.Web.Config (loadWebConfigAt, resolvePipeName)
-import Control.Concurrent (threadDelay)
-import Control.Exception (SomeException, try)
-import Control.Monad (filterM)
-import System.Directory (doesFileExist)
-import System.Exit (ExitCode)
-import System.FilePath ((</>))
-import System.Info (os)
-import System.IO (Handle)
-import System.Process (
-    CreateProcess (..),
-    ProcessHandle,
-    StdStream (..),
-    createProcess,
-    proc,
-    terminateProcess,
-    waitForProcess,
- )
-
-- 拉起并管理 Rust 存储进程，起来后等管道应答 ping 再继续。
-- 调参、管名与数据目录都在全局 chusql.toml 里，孩子自己读；这里只负责起进程、
-- 用 --config 把「读哪份配置文件」告诉它，并等就绪。
-
-data StorageProcess = StorageProcess
-    { spProcess :: ProcessHandle
-    , spPipe :: String
-    }
-
-- | 可执行文件名跟平台走：Windows 带 .exe，其它平台不带。同一个 target 目录里可能
-- 同时躺着一份别处交叉编译出来的 .exe（Windows PE），在 Linux 上误选它只会拿到
-- config file not found（Windows 进程看不到 /tmp/... 这样的路径）。目标平台当参数传，
-- 两个分支都能被测试直接钉住。
-platformBinaryName :: String -> String -> FilePath
-platformBinaryName targetOs stem = if targetOs == "mingw32" then stem ++ ".exe" else stem
-
-- | 找存储进程，没有就给路径提示
-findStorageServer :: Maybe FilePath -> IO (Either String FilePath)
-findStorageServer (Just p) = do
-    ok <- doesFileExist p
-    pure (if ok then Right p else Left ("storage server not found: " ++ p))
-findStorageServer Nothing = do
-    let dirs =
-            [ "chusql-storage/target"
-            , "../chusql-storage/target"
-            , "../../chusql-storage/target"
-            , "target"
-            ]
-        modes = ["release", "debug"]
-        exes = [platformBinaryName os "chusql-storage"]
-        candidates = [d </> m </> e | d <- dirs, m <- modes, e <- exes]
-    found <- filterM doesFileExist candidates
-    pure $ case found of
-        (p : _) -> Right p
-        [] -> Left "no Rust storage server found; run `cargo build --release` in chusql-storage, or pass --storage <path>"
-
-- | 按配置文件里的管名起存储进程
-startStorageProcess :: FilePath -> FilePath -> IO (Either String StorageProcess)
-startStorageProcess bin configPath = do
-    cfg <- loadWebConfigAt configPath
-    startStorageProcessAt bin (resolvePipeName cfg) configPath
-
-- | 给存储子进程的参数：配置文件位置是固定的，唯一的显式覆盖就是写进 --config
-storageChildArgs :: FilePath -> [String]
-storageChildArgs configPath = ["--config", configPath]
-
-- | 用给定的管名起存储进程，并把本进程的端点也指到它；环境原样继承
-startStorageProcessAt :: FilePath -> String -> FilePath -> IO (Either String StorageProcess)
-startStorageProcessAt bin pipe configPath = do
-    let child = (proc bin (storageChildArgs configPath)){std_out = NoStream, std_err = Inherit}
-    started <-
-        try (createProcess child) ::
-            IO (Either SomeException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-    case started of
-        Left e -> pure (Left ("failed to start the storage process: " ++ show e))
-        Right (_, _, _, ph) -> do
-            setPipeName pipe
-            ready <- waitForStorage (200 :: Int)
-            if ready
-                then pure (Right (StorageProcess ph pipe))
-                else do
-                    _ <- try (terminateProcess ph) :: IO (Either SomeException ())
-                    pure (Left "storage process did not become ready within 5 seconds (no ping reply on the pipe)")
-
-- | 停掉存储进程，保留数据目录
-stopStorageProcess :: StorageProcess -> IO ()
-stopStorageProcess sp = do
-    closeConnection
-    _ <- try (terminateProcess (spProcess sp)) :: IO (Either SomeException ())
-    _ <- try (waitForProcess (spProcess sp)) :: IO (Either SomeException ExitCode)
-    pure ()
-
-- | 轮询 ping 直到对面应答
-waitForStorage :: Int -> IO Bool
-waitForStorage 0 = pure False
-waitForStorage n = do
-    r <- try (sendRequest ReqPing) :: IO (Either SomeException Response)
-    case r of
-        Right RespPong -> pure True
-        _ -> threadDelay 25000 >> waitForStorage (n - 1)
@@ -1,163 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Web.TOML
-    ( readSection
-    , writeSection
-    , defaultConfigFile
-    , resolveConfigPath
-    ) where
-
-import Control.Exception (IOException, try)
-import qualified Data.ByteString as BS
-import qualified Data.Map.Strict as Map
-import Data.Map.Strict (Map)
-import qualified Data.Set as Set
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import System.Directory (XdgDirectory (XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
-import System.FilePath (takeDirectory, (</>))
-
-- 全局 chusql.toml 的最小读写：只认 [section] 与 key = value。
-- 读写都是一次性打开就关，不长期占着文件句柄，别的层随时能读同一份文件。
-
-- | 读一个分区；文件不存在或没有这个分区都当空表
-readSection :: FilePath -> Text -> IO (Map Text Text)
-readSection path section = do
-    exists <- doesFileExist path
-    if not exists
-        then pure Map.empty
-        else do
-            raw <- BS.readFile path
-            pure (Map.fromList (sectionEntries section (T.lines (TE.decodeUtf8 raw))))
-
-- | 只重写一个分区，其它行（含注释与别的层）原样保留
-writeSection :: FilePath -> Text -> Map Text Text -> IO (Either String ())
-writeSection path section values = do
-    prepared <- prepareDirectory
-    case prepared of
-        Left err -> pure (Left err)
-        Right () -> do
-            exists <- doesFileExist path
-            raw <- if exists then TE.decodeUtf8 <$> BS.readFile path else pure ""
-            let updated = T.unlines (rewrite section values (T.lines raw))
-            written <- tryWrite (TE.encodeUtf8 updated)
-            pure written
-  where
-    prepareDirectory = do
-        let dir = takeDirectory path
-        if null dir
-            then pure (Right ())
-            else do
-                done <- try (createDirectoryIfMissing True dir) :: IO (Either IOException ())
-                pure (either (Left . show) (const (Right ())) done)
-    tryWrite bytes = do
-        done <- try (BS.writeFile path bytes) :: IO (Either IOException ())
-        pure (either (Left . show) (const (Right ())) done)
-
-- | 分区里的键值对
-sectionEntries :: Text -> [Text] -> [(Text, Text)]
-sectionEntries wanted = go ""
-  where
-    go _ [] = []
-    go current (line : rest)
-        | Just name <- sectionName line = go name rest
-        | current /= wanted = go current rest
-        | otherwise = case assignment line of
-            Nothing -> go current rest
-            Just entry -> entry : go current rest
-
-- | 是不是分区头，返回分区名
-sectionName :: Text -> Maybe Text
-sectionName line = case T.strip line of
-    stripped
-        | "[" `T.isPrefixOf` stripped && "]" `T.isSuffixOf` stripped && T.length stripped > 2 ->
-            Just (T.strip (T.drop 1 (T.dropEnd 1 stripped)))
-    _ -> Nothing
-
-- | 是不是 key = value
-assignment :: Text -> Maybe (Text, Text)
-assignment line = case T.breakOn "=" (stripComment line) of
-    (key, rest)
-        | not (T.null rest)
-        , let name = T.strip key
-        , not (T.null name) ->
-            Just (name, unquote (T.strip (T.drop 1 rest)))
-    _ -> Nothing
-
-- | 去掉行尾注释（引号里的 # 不算）
-stripComment :: Text -> Text
-stripComment = T.pack . go False . T.unpack
-  where
-    go _ [] = []
-    go inString ('#' : rest)
-        | not inString = []
-        | otherwise = '#' : go inString rest
-    go inString ('"' : rest) = '"' : go (not inString) rest
-    go inString (ch : rest) = ch : go inString rest
-
-- | 去掉包裹的引号
-unquote :: Text -> Text
-unquote value
-    | T.length value >= 2 && T.head value == '"' && T.last value == '"' = T.drop 1 (T.dropEnd 1 value)
-    | T.length value >= 2 && T.head value == '\'' && T.last value == '\'' = T.drop 1 (T.dropEnd 1 value)
-    | otherwise = value
-
-- | 行级重写：本分区里已有的键就地更新，空值删行，缺的键补在分区末尾
-rewrite :: Text -> Map Text Text -> [Text] -> [Text]
-rewrite section values = addMissing . replaceInSection . dropEmpties
-  where
-    dropEmpties = filter (\line -> maybe True (not . T.null . snd) (assignment line))
-    replaceInSection = go ""
-    go _ [] = []
-    go current (line : rest)
-        | Just name <- sectionName line = line : go name rest
-        | current /= section = line : go current rest
-        | otherwise = case assignment line of
-            Just (key, _) | Just value <- Map.lookup key values -> assignmentLine key value : go current rest
-            _ -> line : go current rest
-    addMissing lines' =
-        let present = Set.fromList (keysOf section lines')
-            missing = [(key, value) | (key, value) <- Map.toList values, not (Set.member key present), not (T.null value)]
-         in if null missing then lines' else appendSection section missing lines'
-
-assignmentLine :: Text -> Text -> Text
-assignmentLine key value = key <> " = " <> quote value
-
-quote :: Text -> Text
-quote value
-    | T.all allowed value && not (T.null value) = value
-    | otherwise = "\"" <> T.replace "\"" "\\\"" value <> "\""
-  where
-    allowed ch = ch `elem` ("0123456789.-" :: String)
-
-- | 取某个分区里出现过的键
-keysOf :: Text -> [Text] -> [Text]
-keysOf wanted = go ""
-  where
-    go _ [] = []
-    go current (line : rest)
-        | Just name <- sectionName line = go name rest
-        | current /= wanted = go current rest
-        | otherwise = case assignment line of
-            Just (key, _) -> key : go current rest
-            Nothing -> go current rest
-
-- | 没有这个分区就在末尾补一个
-appendSection :: Text -> [(Text, Text)] -> [Text] -> [Text]
-appendSection section entries lines' =
-    lines'
-        ++ (if null lines' || not (T.null (last lines')) then [""] else [])
-        ++ ("[" <> section <> "]") : [assignmentLine key value | (key, value) <- entries]
-
-- | 全局配置文件的位置：安装时定下的固定路径，跟随系统惯例
-- （Windows: %APPDATA%\ChuSQL\chusql.toml；其它平台: $XDG_CONFIG_HOME 或 ~/.config 下的 ChuSQL/chusql.toml）
-defaultConfigFile :: IO FilePath
-defaultConfigFile = do
-    dir <- getXdgDirectory XdgConfig "ChuSQL"
-    pure (dir </> "chusql.toml")
-
-- | 定位配置文件：命令行 --config 指的是哪份就读哪份，否则用固定路径
-resolveConfigPath :: Maybe FilePath -> IO FilePath
-resolveConfigPath (Just path) = pure path
-resolveConfigPath Nothing = defaultConfigFile
@@ -42,15 +42,18 @@ resolveUISettingsFile = do
            ready <- firstExistingDir uiSettingsFileCandidates
            pure (maybe firstCandidate id ready)
  where
+    -- | 首选候选路径
    firstCandidate = case uiSettingsFileCandidates of
        (p : _) -> p
        [] -> "chusql.ui.settings.json"

+    -- | 第一个存在的候选文件
    firstExistingFile [] = pure Nothing
    firstExistingFile (p : ps) = do
        ok <- doesFileExist p
        if ok then pure (Just p) else firstExistingFile ps

+    -- | 目录已存在的第一个候选
    firstExistingDir [] = pure Nothing
    firstExistingDir (p : ps) = do
        let dir = takeDirectory p
@@ -61,6 +64,7 @@ resolveUISettingsFile = do
 validateUISettings :: A.Value -> Either String (Map.Map Text A.Value)
 validateUISettings (A.Object o) = Map.fromList <$> mapM checkField (KM.toList o)
  where
+    -- | 校验一个字段
    checkField (rawKey, value) =
        let key = K.toText rawKey
         in case key of
@@ -80,16 +84,20 @@ validateUISettings (A.Object o) = Map.fromList <$> mapM checkField (KM.toList o)
                "minimap" -> pair key <$> boolValue key value
                _ -> Left ("unknown setting: " ++ T.unpack key)

+    -- | 把键和值配成一对
    pair key value = (key, value)

 validateUISettings _ = Left "settings must be a JSON object"

+-- | 字体链最多几项
 fontChainMax :: Int
 fontChainMax = 10

+-- | 单个字体名最长多少字
 fontNameMax :: Int
 fontNameMax = 64

+-- | 空值占位文本最长多少字
 nullTextMax :: Int
 nullTextMax = 64

@@ -1,5 +1,11 @@
 resolver: lts-24.59

+extra-lib-dirs:
+    - ../chusql-core/storage/target/release
+
 packages:
    - .
-    - ../chusql-engine
+    - ../chusql-core/engine
+    - ../chusql-server
+    - ../chusql-core/model
+    - ../chusql-interface
@@ -1,12 +1,14 @@
 // REST 数据源：与 chusql-web 的 /api/* 一一对应。
-// 所有请求带 X-ChuSQL-Database 头（服务端不保存 USE 状态）；401 时广播登录事件。
+// 请求都带 X-ChuSQL-Database 头；401 时广播登录事件。

 export const AUTH_EVENT = 'chusql-auth-required';

+// 是否是普通对象。
 function isObject(value) {
  return value !== null && typeof value === 'object' && !Array.isArray(value);
 }

+// 发一次请求并处理错误。
 async function request(url, init, database) {
  const headers = new Headers(init && init.headers ? init.headers : undefined);
  if (database) headers.set('X-ChuSQL-Database', database);
@@ -34,6 +36,7 @@ async function request(url, init, database) {
  return body;
 }

+// 组装 JSON 请求参数。
 function jsonInit(method, body) {
  return {
    method,
@@ -44,12 +47,14 @@ function jsonInit(method, body) {

 const identifier = /^[A-Za-z_][A-Za-z0-9_]{0,63}$/;

+// 校验数据库名格式。
 function checkDatabaseName(name) {
  if (!identifier.test(String(name))) throw new Error('数据库名只能是字母、数字与下划线，且以字母或下划线开头。');
 }

 // ---------------------------------------------------------------- 会话

+// 读取当前会话。
 export async function currentSession() {
  const body = await request('/api/session');
  if (!isObject(body) || typeof body.user !== 'string') throw new Error('服务器返回的会话信息无法识别。');
@@ -60,16 +65,19 @@ export async function currentSession() {
  };
 }

+// 提交登录。
 export async function login(user, password) {
  await request('/api/login', jsonInit('POST', { user, password }));
 }

+// 退出登录。
 export async function logout() {
  await request('/api/logout', jsonInit('POST', {}));
 }

 // ---------------------------------------------------------------- 数据库

+// 列出数据库。
 export async function listDatabases() {
  const body = await request('/api/databases');
  if (!Array.isArray(body) || !body.every((name) => typeof name === 'string')) {
@@ -78,16 +86,18 @@ export async function listDatabases() {
  return body;
 }

+// 新建数据库。
 export async function createDatabase(name, database) {
  checkDatabaseName(name);
  await request('/api/databases', jsonInit('POST', { name }), database);
 }

+// 删除数据库。
 export async function dropDatabase(name, database) {
  await request(`/api/databases/${encodeURIComponent(name)}`, jsonInit('DELETE'), database);
 }

-// 切换当前库：走一条 USE 语句，服务端在响应里回带新的库名。
+// 切换当前库（发 USE 语句）。
 export async function useDatabase(name, database) {
  checkDatabaseName(name);
  return query(`USE ${name}`, database);
@@ -95,12 +105,14 @@ export async function useDatabase(name, database) {

 // ---------------------------------------------------------------- 表结构

+// 取类型基名（去掉参数）。
 function columnKind(type) {
  return String(type).split('(')[0].trim().toLowerCase();
 }

 const knownTypes = ['int', 'bigint', 'smallint', 'str', 'text', 'varchar', 'char', 'float', 'double', 'decimal', 'numeric', 'bool', 'date', 'timestamp', 'blob'];

+// 校验并规整列描述。
 function asColumns(value) {
  if (!Array.isArray(value)) throw new Error('服务器返回的列清单无法识别。');
  return value.map((entry) => {
@@ -112,6 +124,7 @@ function asColumns(value) {
  });
 }

+// 校验并规整表描述。
 function asTable(value) {
  if (!isObject(value) || typeof value.table !== 'string' || typeof value.rowCount !== 'number') {
    throw new Error('服务器返回的表描述无法识别。');
@@ -125,38 +138,46 @@ function asTable(value) {
  };
 }

+// 列出表。
 export async function listTables(database) {
  const body = await request('/api/tables', undefined, database);
  if (!Array.isArray(body)) throw new Error('服务器返回的表清单无法识别。');
  return body.map(asTable);
 }

+// 取单表结构。
 export async function getTable(database, table) {
  return asTable(await request(`/api/tables/${encodeURIComponent(table)}`, undefined, database));
 }

+// 新建表。
 export async function createTable(database, name, columns) {
  await request('/api/tables', jsonInit('POST', { name, columns }), database);
 }

+// 删除表。
 export async function dropTable(database, table) {
  await request(`/api/tables/${encodeURIComponent(table)}`, jsonInit('DELETE'), database);
 }

+// 建索引。
 export async function createIndex(database, table, column) {
  await request(`/api/tables/${encodeURIComponent(table)}/indexes`, jsonInit('POST', { column }), database);
 }

+// 删索引。
 export async function dropIndex(database, table, column) {
  await request(`/api/tables/${encodeURIComponent(table)}/indexes/${encodeURIComponent(column)}`, jsonInit('DELETE'), database);
 }

+// 删列。
 export async function dropColumn(database, table, column) {
  await request(`/api/tables/${encodeURIComponent(table)}/columns/${encodeURIComponent(column)}`, jsonInit('DELETE'), database);
 }

 // ---------------------------------------------------------------- 行

+// 分页取表数据。
 export async function fetchRows({ database, table, limit, offset, sort, dir, filters }) {
  const params = new URLSearchParams({ limit: String(limit), offset: String(offset) });
  if (sort) {
@@ -179,14 +200,17 @@ export async function fetchRows({ database, table, limit, offset, sort, dir, fil
  return { columns, rows, total: body.total };
 }

+// 插入一行。
 export async function insertRow(database, table, values) {
  await request(`/api/tables/${encodeURIComponent(table)}/rows`, jsonInit('POST', { values }), database);
 }

+// 更新一行。
 export async function updateRow(database, table, id, values) {
  await request(`/api/tables/${encodeURIComponent(table)}/rows/${encodeURIComponent(id)}`, jsonInit('PATCH', { values }), database);
 }

+// 删除一行。
 export async function deleteRow(database, table, id) {
  await request(`/api/tables/${encodeURIComponent(table)}/rows/${encodeURIComponent(id)}`, jsonInit('DELETE'), database);
 }
@@ -209,6 +233,7 @@ export async function commitChanges(database, changes) {

 // ---------------------------------------------------------------- 查询

+// 执行 SQL 并规整结果。
 export async function query(sql, database) {
  const started = performance.now();
  try {
@@ -231,27 +256,32 @@ export async function query(sql, database) {
  }
 }

+// 灌演示数据。
 export async function seedDemoData(database) {
  return request('/api/demo-data', jsonInit('POST', {}), database);
 }

 // ---------------------------------------------------------------- 设置

+// 读取服务器设置。
 export async function loadServerSettings() {
  const body = await request('/api/settings');
  if (!isObject(body) || !Array.isArray(body.items)) throw new Error('服务器返回的设置清单无法识别。');
  return body;
 }

+// 保存服务器设置。
 export async function saveServerSettings(values) {
  const body = await request('/api/settings', jsonInit('PUT', { values }));
  return isObject(body) ? body : { ok: true };
 }

+// 读取 IDE 设置。
 export async function loadUiSettings() {
  return request('/api/ui-settings');
 }

+// 保存 IDE 设置。
 export async function saveUiSettings(settings) {
  await request('/api/ui-settings', jsonInit('PUT', settings));
 }
@@ -1,6 +1,3 @@
-// ChuSQL Web IDE：纯 HTML + CSS + JS，无 React、无打包器、无 Node 依赖。
-// 结构：全局状态 → 页面骨架 → 各区域渲染 → 事件代理 → 会话/数据/变更动作。
-
 import * as api from './api.js';
 import { AUTH_EVENT } from './api.js';
 import {
@@ -35,6 +32,8 @@ import {
  typeLabel,
 } from './core.js';

+// ChuSQL Web IDE 主逻辑：状态、渲染、事件代理与会话/数据/变更动作。
+
 // ---------------------------------------------------------------- 状态

 const state = {
@@ -63,30 +62,36 @@ const root = document.getElementById('root');

 // ---------------------------------------------------------------- 小工具

+// 按 id 取 DOM 元素。
 function region(id) {
  return document.getElementById(id);
 }

+// 当前时间（时分秒）。
 function now() {
  return new Date().toLocaleTimeString('zh-CN', { hour12: false });
 }

+// 记一条消息并刷新下方面板。
 function log(level, text) {
  state.messages.push({ level, text, time: now() });
  if (state.messages.length > 200) state.messages.shift();
  renderBottom();
 }

+// 设置状态栏文案。
 function setStatus(text) {
  state.status = text;
  const el = region('status-message');
  if (el) el.textContent = text;
 }

+// 取错误的文字描述。
 function describe(error) {
  return error instanceof Error ? error.message : String(error);
 }

+// 记录错误并写到状态栏。
 function fail(error) {
  const message = describe(error);
  log('error', message);
@@ -94,17 +99,20 @@ function fail(error) {
  return message;
 }

+// 生成下一个标签 id。
 function nextTabId(prefix) {
  state.tabSeq += 1;
  return `${prefix}-${state.tabSeq}`;
 }

+// 当前激活的标签。
 function activeTab() {
  return state.tabs.find((tab) => tab.id === state.activeId);
 }

 // ---------------------------------------------------------------- 登录页

+// 渲染登录页。
 function renderLogin(message, level) {
  state.view = 'login';
  root.innerHTML = `
@@ -122,6 +130,7 @@ function renderLogin(message, level) {

 // ---------------------------------------------------------------- 页面骨架

+// 渲染工作台骨架与对话框。
 function renderShell() {
  state.view = 'workbench';
  root.innerHTML = `
@@ -200,7 +209,7 @@ function renderShell() {
  applyLayout();
 }

-// 侧栏宽度与下方面板高度用 CSSOM 写，避免 CSP 拦掉内联 style 属性。
+// 应用侧栏宽度与下方面板高度。
 function applyLayout() {
  const workbench = region('workbench');
  if (!workbench) return;
@@ -210,6 +219,7 @@ function applyLayout() {

 // ---------------------------------------------------------------- 账号区

+// 渲染右上角账号区。
 function renderAccount() {
  const el = region('account');
  if (!el) return;
@@ -225,6 +235,7 @@ function renderAccount() {

 // ---------------------------------------------------------------- 侧栏

+// 渲染资源管理器侧栏。
 function renderSidebar() {
  const el = region('sidebar');
  if (!el) return;
@@ -298,6 +309,7 @@ function renderSidebar() {

 // ---------------------------------------------------------------- 标签栏

+// 渲染标签栏并刷新内容区。
 function renderTabs() {
  const el = region('editor');
  if (!el) return;
@@ -314,6 +326,7 @@ function renderTabs() {

 // ---------------------------------------------------------------- 编辑器区

+// 渲染当前标签的内容。
 function renderEditor() {
  const el = region('tab-content');
  if (!el) return;
@@ -332,11 +345,13 @@ function renderEditor() {

 // ---- 表格标签

+// 单元格显示内容的 HTML。
 function cellContent(value, nullText) {
  if (value === null || value === undefined) return `<span class="null-value">${escapeHtml(nullText)}</span>`;
  return escapeHtml(cellText(value, nullText));
 }

+// 渲染表格标签（工具栏、表头、数据行）。
 function renderTableTab(el, tab) {
  const data = tab.data;
  if (!data) {
@@ -429,13 +444,16 @@ function renderTableTab(el, tab) {

 // ---- SQL 标签

+// 生成行号文本。
 function lineNumbers(sql) {
  const count = String(sql ?? '').split('\n').length;
  return Array.from({ length: count }, (_, index) => index + 1).join('\n');
 }

+// 渲染 SQL 控制台标签。
 function renderSqlTab(el, tab) {
  const result = tab.result;
+  // 结果区 HTML。
  const resultHtml = (() => {
    if (!result) return '<p class="muted">按 Ctrl+Enter 运行，或点上面的"运行"。</p>';
    if (result.type === 'error') return `<p class="alert alert-error">${escapeHtml(result.message ?? '执行失败')}</p>`;
@@ -473,11 +491,13 @@ function renderSqlTab(el, tab) {
  const minimap = region('sql-minimap');
  if (!textarea) return;

+  // 刷新高亮层与行号。
  const refreshLayers = () => {
    if (highlight) highlight.innerHTML = highlightHtml(tab.sql);
    if (gutter) gutter.textContent = lineNumbers(tab.sql);
    sync();
  };
+  // 同步滚动位置与缩略图。
  const sync = () => {
    if (highlight) {
      highlight.scrollTop = textarea.scrollTop;
@@ -496,11 +516,14 @@ function renderSqlTab(el, tab) {
    }
  };

+  // 输入时更新 SQL 并刷新高亮。
  textarea.addEventListener('input', () => {
    tab.sql = textarea.value;
    refreshLayers();
  });
+  // 滚动时同步各层。
  textarea.addEventListener('scroll', sync);
+  // Tab 缩进，Ctrl+Enter 运行。
  textarea.addEventListener('keydown', (event) => {
    if (event.key === 'Tab') {
      event.preventDefault();
@@ -523,17 +546,22 @@ function renderSqlTab(el, tab) {

 // ---- 设置标签

+// 渲染设置标签页。
 function renderSettingsTab(el) {
  const settings = state.settings;
+  // 字体链输入框。
  const fontField = (key) => `
    <label class="field"><span>${escapeHtml(settingLabels[key])}</span>
      <input data-setting="fonts" data-key="${key}" value="${escapeHtml(fontsToText(settings[key]))}" placeholder="字体名用逗号分隔" /></label>`;
+  // 数值输入框。
  const numberField = (key) => `
    <label class="field"><span>${escapeHtml(settingLabels[key])}</span>
      <input type="number" data-setting="number" data-key="${key}" value="${settings[key]}" /></label>`;
+  // 布尔开关。
  const boolField = (key) => `
    <label class="toggle"><input type="checkbox" data-setting="boolean" data-key="${key}"${settings[key] ? ' checked' : ''} /><span>${escapeHtml(settingLabels[key])}</span></label>`;

+  // 服务器设置分组表单。
  const serverHtml = (() => {
    const server = state.serverSettings;
    if (!server) return '<p class="muted">正在读取服务器设置…</p>';
@@ -595,6 +623,7 @@ function renderSettingsTab(el) {

 // ---------------------------------------------------------------- 下方面板

+// 渲染下方面板（变更/消息）。
 function renderBottom() {
  const el = region('bottom');
  if (!el) return;
@@ -635,6 +664,7 @@ function renderBottom() {

 // ---------------------------------------------------------------- 数据加载

+// 读取并缓存当前会话。
 async function refreshSession() {
  try {
    state.session = await api.currentSession();
@@ -645,6 +675,7 @@ async function refreshSession() {
  }
 }

+// 加载数据库列表与当前库的表。
 async function loadWorkspace() {
  try {
    state.databases = await api.listDatabases();
@@ -661,6 +692,7 @@ async function loadWorkspace() {
  }
 }

+// 切换当前数据库。
 async function switchDatabase(name) {
  if (name === state.database) return;
  if (changeCount(state.changes) > 0) {
@@ -680,6 +712,7 @@ async function switchDatabase(name) {
  renderEditor();
 }

+// 打开表标签并加载数据。
 async function openTable(database, name) {
  const opened = openTableTab(state.tabs, database, name, nextTabId('table'));
  state.tabs = opened.tabs;
@@ -697,6 +730,7 @@ async function openTable(database, name) {
  await loadTableData(tab);
 }

+// 加载表标签的一页数据。
 async function loadTableData(tab) {
  const data = tab.data;
  data.loading = true;
@@ -736,6 +770,7 @@ async function loadTableData(tab) {
  }
 }

+// 重新加载所有表标签。
 async function reloadOpenTables() {
  for (const tab of state.tabs) {
    if (tab.kind === 'table') await loadTableData(tab);
@@ -744,6 +779,7 @@ async function reloadOpenTables() {

 // ---------------------------------------------------------------- 变更动作

+// 撤下某行的全部变更。
 function unstageRow(table, pk) {
  const prefix = `${table}:${JSON.stringify(pk)}:`;
  for (const key of [...state.changes.updates.keys()]) {
@@ -752,12 +788,14 @@ function unstageRow(table, pk) {
  state.changes.deletes.delete(deleteKey(table, pk));
 }

+// 暂存单元格修改。
 function stageUpdate(table, database, pk, column, oldValue, newValue) {
  if (oldValue === newValue) state.changes.updates.delete(changeKey(table, pk, column));
  else state.changes.updates.set(changeKey(table, pk, column), { table, database, pk, column, oldValue, newValue });
  afterChange();
 }

+// 暂存新增行。
 function stageInsert(table, database, values) {
  state.insertSeq += 1;
  const tempId = `new-${state.insertSeq}`;
@@ -765,18 +803,21 @@ function stageInsert(table, database, values) {
  afterChange();
 }

+// 暂存删除行。
 function stageDelete(table, database, pk, row) {
  unstageRow(table, pk);
  state.changes.deletes.set(deleteKey(table, pk), { table, database, pk, row });
  afterChange();
 }

+// 变更后重绘相关区域。
 function afterChange() {
  renderSidebar();
  renderEditor();
  renderBottom();
 }

+// 撤下一条暂存变更。
 function removeStaged(key) {
  if (state.changes.updates.has(key)) state.changes.updates.delete(key);
  else if (state.changes.inserts.has(key)) state.changes.inserts.delete(key);
@@ -784,6 +825,7 @@ function removeStaged(key) {
  afterChange();
 }

+// 撤销全部暂存变更。
 function rollbackAll() {
  state.changes = createEmptyChangeSet();
  for (const tab of state.tabs) if (tab.selected) tab.selected.clear();
@@ -791,6 +833,7 @@ function rollbackAll() {
  afterChange();
 }

+// 提交全部暂存变更。
 async function commitAll() {
  const payload = toCommitPayload(state.changes);
  if (!payload.length) {
@@ -832,6 +875,7 @@ async function commitAll() {

 // ---------------------------------------------------------------- SQL 运行

+// 运行 SQL 并展示结果。
 async function runSql(tab) {
  const sql = String(tab.sql ?? '').trim();
  if (!sql) return;
@@ -862,6 +906,7 @@ async function runSql(tab) {

 // ---------------------------------------------------------------- 标签动作

+// 激活指定标签。
 function activateTab(id) {
  state.activeId = id;
  const tab = activeTab();
@@ -870,6 +915,7 @@ function activateTab(id) {
  renderTabs();
 }

+// 关闭指定标签。
 function closeTabById(id) {
  const closed = closeTab(state.tabs, id, state.activeId);
  state.tabs = closed.tabs;
@@ -877,6 +923,7 @@ function closeTabById(id) {
  renderTabs();
 }

+// 新开一个查询标签。
 function openQuery(sql) {
  const title = `查询 ${state.tabs.filter((tab) => tab.kind === 'sql').length + 1}`;
  const opened = openQueryTab(state.tabs, title, nextTabId('sql'), state.database, sql ?? '');
@@ -885,6 +932,7 @@ function openQuery(sql) {
  renderTabs();
 }

+// 打开设置标签。
 function openSettings() {
  const opened = openSettingsTab(state.tabs, '设置', nextTabId('settings'));
  state.tabs = opened.tabs;
@@ -895,6 +943,7 @@ function openSettings() {

 // ---------------------------------------------------------------- 设置动作

+// 把 IDE 设置写到 CSS 变量。
 function applySettingsToDom() {
  const style = document.documentElement.style;
  style.setProperty('--ui-font', fontFamilyValue(state.settings.uiFonts));
@@ -909,6 +958,7 @@ function applySettingsToDom() {
 }

 let saveTimer;
+// 保存 IDE 设置（本地+服务器）。
 function persistSettings() {
  try {
    localStorage.setItem(IDE_SETTINGS_KEY, JSON.stringify(state.settings));
@@ -921,6 +971,7 @@ function persistSettings() {
  }, 400);
 }

+// 更新一项 IDE 设置。
 function updateSetting(key, value) {
  state.settings = { ...state.settings, [key]: value };
  applySettingsToDom();
@@ -928,6 +979,7 @@ function updateSetting(key, value) {
  renderEditor();
 }

+// 从本地存储读 IDE 设置。
 function loadLocalSettings() {
  try {
    const raw = localStorage.getItem(IDE_SETTINGS_KEY);
@@ -938,6 +990,7 @@ function loadLocalSettings() {
  }
 }

+// 从服务器读 IDE 设置。
 async function loadRemoteSettings() {
  try {
    state.settings = { ...state.settings, ...parseUiSettings(await api.loadUiSettings()) };
@@ -947,6 +1000,7 @@ async function loadRemoteSettings() {
  }
 }

+// 读取服务器设置。
 async function loadServerSettings() {
  try {
    state.serverSettings = await api.loadServerSettings();
@@ -956,6 +1010,7 @@ async function loadServerSettings() {
  renderEditor();
 }

+// 保存改过的服务器设置。
 async function saveServerSettings() {
  const inputs = [...document.querySelectorAll('[data-server-setting]')];
  const values = {};
@@ -986,6 +1041,7 @@ async function saveServerSettings() {

 // ---------------------------------------------------------------- 表格动作

+// 切换该列的排序。
 function sortColumn(tab, column) {
  const data = tab.data;
  if (data.sort === column) data.dir = data.dir === 'asc' ? 'desc' : 'asc';
@@ -997,6 +1053,7 @@ function sortColumn(tab, column) {
  void loadTableData(tab);
 }

+// 暂存删除选中的行。
 function deleteSelected(tab) {
  const keyColumn = tab.data.columns.find((column) => column.name === 'id');
  if (!keyColumn || !tab.selected) return;
@@ -1007,7 +1064,7 @@ function deleteSelected(tab) {
  afterChange();
 }

-// 点一下就地把单元格变成输入框；Enter/失焦提交，Esc 放弃。
+// 就地编辑单元格：提交或放弃。
 function beginCellEdit(cell, options) {
  if (cell.querySelector('input')) return;
  const input = document.createElement('input');
@@ -1018,6 +1075,7 @@ function beginCellEdit(cell, options) {
  input.focus();
  input.select();
  let done = false;
+  // 结束编辑并按需提交。
  const finish = (save) => {
    if (done) return;
    done = true;
@@ -1025,6 +1083,7 @@ function beginCellEdit(cell, options) {
    input.remove();
    options.commit(save ? parseEdited(raw, options.type) : undefined);
  };
+  // Enter 提交，Esc 放弃。
  input.addEventListener('keydown', (event) => {
    if (event.key === 'Enter') {
      event.preventDefault();
@@ -1034,9 +1093,11 @@ function beginCellEdit(cell, options) {
      finish(false);
    }
  });
+  // 失焦时提交。
  input.addEventListener('blur', () => finish(true));
 }

+// 在新建表对话框加一列。
 function addColumnRow(name, type) {
  const container = region('dlg-table-columns');
  if (!container) return;
@@ -1049,6 +1110,7 @@ function addColumnRow(name, type) {
  container.appendChild(row);
 }

+// 打开新建表对话框。
 function openCreateTableDialog() {
  region('dlg-table-name').value = '';
  region('dlg-table-error').textContent = '';
@@ -1058,6 +1120,7 @@ function openCreateTableDialog() {
  region('dlg-table').showModal();
 }

+// 打开建索引对话框。
 function openIndexDialog(table) {
  const meta = state.tables.find((entry) => entry.name === table);
  const select = region('dlg-index-column');
@@ -1070,6 +1133,7 @@ function openIndexDialog(table) {
  region('dlg-index').showModal();
 }

+// 提交新建数据库。
 async function createDatabase() {
  const name = region('dlg-db-name').value.trim();
  try {
@@ -1082,6 +1146,7 @@ async function createDatabase() {
  }
 }

+// 提交新建表。
 async function createTable() {
  const name = region('dlg-table-name').value.trim();
  const rows = [...region('dlg-table-columns').querySelectorAll('.column-row')];
@@ -1107,6 +1172,7 @@ async function createTable() {
  }
 }

+// 提交建索引。
 async function createIndexFor(table) {
  const dialog = region('dlg-index');
  const column = region('dlg-index-column').value;
@@ -1121,6 +1187,7 @@ async function createIndexFor(table) {
  }
 }

+// 删除当前数据库。
 async function dropCurrentDatabase() {
  const name = state.database;
  if (!window.confirm(`删除数据库 ${name}？此操作不可撤销。`)) return;
@@ -1136,6 +1203,7 @@ async function dropCurrentDatabase() {
  }
 }

+// 删除指定表。
 async function dropTableByName(table) {
  if (!window.confirm(`删除表 ${table}？`)) return;
  try {
@@ -1150,6 +1218,7 @@ async function dropTableByName(table) {
  }
 }

+// 删除指定列。
 async function dropColumnByName(table, column) {
  if (!window.confirm(`删除 ${table}.${column}？`)) return;
  try {
@@ -1162,6 +1231,7 @@ async function dropColumnByName(table, column) {
  }
 }

+// 删除指定索引。
 async function dropIndexByName(table, column) {
  if (!window.confirm(`删除 ${table}.${column} 上的索引？`)) return;
  try {
@@ -1175,9 +1245,11 @@ async function dropIndexByName(table, column) {

 // ---------------------------------------------------------------- 事件代理

+// 拖动分隔条调整尺寸。
 function startSplitterDrag(kind, event) {
  event.preventDefault();
  const workbench = region('workbench');
+  // 按鼠标位置调整宽度或高度。
  const move = (moveEvent) => {
    if (kind === 'v') {
      const width = Math.min(560, Math.max(180, moveEvent.clientX - 48));
@@ -1189,6 +1261,7 @@ function startSplitterDrag(kind, event) {
      workbench.style.setProperty('--dock-height', `${height}px`);
    }
  };
+  // 移除拖动监听。
  const stop = () => {
    window.removeEventListener('mousemove', move);
    window.removeEventListener('mouseup', stop);
@@ -1204,10 +1277,12 @@ const DATABASE_ACTIONS = new Set([
  'drop-database', 'commit', 'rollback', 'copy-sql',
 ]);

+// 该动作是否需要当前库。
 function needsDatabase(action) {
  return DATABASE_ACTIONS.has(action);
 }

+// 点击事件代理。
 function onClick(event) {
  const splitter = event.target.closest('[data-split]');
  if (splitter) {
@@ -1451,6 +1526,7 @@ function onClick(event) {
  }
 }

+// 输入与选择事件代理。
 function onChange(event) {
  const target = event.target;
  if (target.dataset.action === 'switch-database') {
@@ -1495,6 +1571,7 @@ function onChange(event) {
  else updateSetting(key, target.value);
 }

+// 提交事件代理（登录表单）。
 function onSubmit(event) {
  if (event.target.id !== 'login-form') return;
  event.preventDefault();
@@ -1524,6 +1601,7 @@ function onSubmit(event) {
  })();
 }

+// 键盘事件代理。
 function onKeydown(event) {
  if (event.key === 'Enter' && event.target.id === 'dlg-db-name') {
    event.preventDefault();
@@ -1533,6 +1611,7 @@ function onKeydown(event) {

 // ---------------------------------------------------------------- 启动

+// 会话过期时回到登录页。
 window.addEventListener(AUTH_EVENT, () => {
  if (state.view === 'login') return;
  state.session = null;
@@ -1546,6 +1625,7 @@ root.addEventListener('change', onChange);
 root.addEventListener('submit', onSubmit);
 root.addEventListener('keydown', onKeydown);

+// 启动：读设置、恢复会话、渲染。
 async function boot() {
  loadLocalSettings();
  applySettingsToDom();
@@ -1,9 +1,9 @@
-// 纯逻辑层：SQL 生成、变更集、筛选、类型、标签页与 IDE 设置默认值。
-// 不碰 DOM、不发请求，方便单独阅读与替换。
+// 纯逻辑层：SQL 生成、变更集、筛选、类型、标签页与 IDE 设置。
+// 不碰 DOM、不发请求。

 // ---------------------------------------------------------------- 转义

-// 所有拼进 innerHTML 的文本都要先过这里（表名、列名、单元格值都是用户数据）。
+// 转义 HTML 特殊字符。
 export function escapeHtml(value) {
  return String(value ?? '')
    .replaceAll('&', '&amp;')
@@ -20,7 +20,7 @@ const identifierPattern = /^[A-Za-z_][A-Za-z0-9_]*$/;
 // 账号表：在 system 库里像普通表一样浏览，写入会翻译成账号命令。
 export const accountsTable = '__chusql_users';

-// 字面量：NULL / 数字 / 布尔原样，其它按字符串加单引号并把单引号翻倍。
+// 值转 SQL 字面量（字符串加引号转义）。
 export function sqlLiteral(value) {
  if (value === null || value === undefined) return 'NULL';
  if (typeof value === 'number' || typeof value === 'boolean') return String(value);
@@ -70,11 +70,12 @@ export function changeSql(change) {

 // ---------------------------------------------------------------- 变更集

-// 空变更集：updates 按"表:主键:列"记，inserts/deletes 按各自的键记。
+// 建一个空变更集。
 export function createEmptyChangeSet() {
  return { updates: new Map(), inserts: new Map(), deletes: new Map() };
 }

+// 复制变更集。
 export function cloneChangeSet(changes) {
  return {
    updates: new Map(changes.updates),
@@ -83,6 +84,7 @@ export function cloneChangeSet(changes) {
  };
 }

+// 变更总条数。
 export function changeCount(changes) {
  return changes.updates.size + changes.inserts.size + changes.deletes.size;
 }
@@ -92,7 +94,7 @@ export function changeKey(table, pk, column) {
  return `${table}:${JSON.stringify(pk)}:${column}`;
 }

-// 插入行的键（临时 id，不落库）。
+// 插入行的键。
 export function insertKey(table, tempId) {
  return `${table}:${tempId}`;
 }
@@ -121,7 +123,7 @@ export function toCommitPayload(changes) {
  ];
 }

-// 面板里要显示的一条条变更：[{ key, kind, table, sql, … }]
+// 面板展示用的变更条目列表。
 export function changeEntries(changes) {
  const updates = [...changes.updates.entries()].map(([key, update]) => ({
    key,
@@ -155,16 +157,18 @@ export function changesSql(changes) {

 // ---------------------------------------------------------------- 筛选

+// 转义正则元字符。
 function escapeRegExp(value) {
  return value.replace(/[.*+?^${}()|[\]\\]/g, '\\$&');
 }

+// like 通配转正则。
 function likePattern(raw) {
  const escaped = escapeRegExp(raw).replaceAll('%', '.*').replaceAll('_', '.');
  return new RegExp(`^${escaped}$`, 'i');
 }

-// 表格筛选表达式：null / true / false / like 通配 / 数值比较 / 纯文本包含。
+// 判断单元格值是否命中筛选表达式。
 export function matchesFilter(value, rawExpression) {
  const expression = String(rawExpression ?? '').trim();
  if (!expression) return true;
@@ -209,23 +213,27 @@ export const creatableTypes = [
  'float', 'double', 'decimal(10,2)', 'date', 'timestamp', 'blob',
 ];

+// 取类型基名（去掉参数）。
 export function columnKind(type) {
  return String(type).split('(')[0].trim().toLowerCase();
 }

+// 是否整数类型。
 export function isIntegerType(type) {
  return ['int', 'bigint', 'smallint'].includes(columnKind(type));
 }

+// 是否数值类型。
 export function isNumericType(type) {
  return ['int', 'bigint', 'smallint', 'float', 'double', 'decimal', 'numeric'].includes(columnKind(type));
 }

+// 是否布尔类型。
 export function isBooleanType(type) {
  return ['bool', 'boolean'].includes(columnKind(type));
 }

-// 显示名：按基名查标签，参数原样跟在后面（varchar(20) → VARCHAR(20)）。
+// 类型的显示名。
 export function typeLabel(type) {
  const kind = columnKind(type);
  const label = typeLabels[kind];
@@ -236,7 +244,7 @@ export function typeLabel(type) {

 // ---------------------------------------------------------------- 值渲染

-// 单元格显示的文本；null/undefined 用设置里的占位文本。
+// 单元格显示文本（空值用占位文本）。
 export function cellText(value, nullText) {
  if (value === null || value === undefined) return nullText;
  if (typeof value === 'boolean') return value ? 'true' : 'false';
@@ -249,7 +257,7 @@ export function editText(value) {
  return String(value);
 }

-// 把编辑框里的文本变回提交给服务的值（空串按 null 处理，与界面上的"清空"一致）。
+// 编辑框文本转提交值（空串当 null）。
 export function parseEdited(raw, type) {
  const text = String(raw ?? '').trim();
  if (text === '') return null;
@@ -296,6 +304,7 @@ export function tokenizeSql(sql) {
  let plain = '';
  let index = 0;
  const text = String(sql ?? '');
+  // 收尾当前普通片段。
  const flush = () => {
    if (plain) {
      tokens.push({ text: plain, kind: 'plain' });
@@ -352,7 +361,7 @@ export function tokenizeSql(sql) {
  return tokens;
 }

-// 高亮片段转 HTML（词法切分的结果，文本仍然要转义）。
+// 高亮 SQL 片段转 HTML。
 export function highlightHtml(sql) {
  return tokenizeSql(sql)
    .map((token) => (token.kind === 'plain' ? escapeHtml(token.text) : `<span class="tok-${token.kind}">${escapeHtml(token.text)}</span>`))
@@ -492,6 +501,7 @@ export function fontsFromText(text) {
    .slice(0, 10);
 }

+// 字体链转逗号分隔文本。
 export function fontsToText(chain) {
  return chain.join(', ');
 }
@@ -1,8 +1,5 @@
 <!doctype html>

-<!-- ChuSQL Web IDE 页面壳：纯 HTML + CSS + JS，无打包器、无 Node 依赖。
-     这里不要写内联样式表或内联脚本：CSP 只给带 nonce 的样式放行。 -->
-
 <html lang="zh-CN">
  <head>
    <meta charset="UTF-8" />
@@ -11,6 +8,7 @@
    <title>ChuSQL 数据库终端</title>
    <link rel="stylesheet" href="/static/style.css" />
    <script type="module" src="/static/app.js"></script>
+    <!-- ChuSQL Web IDE 页面壳：挂载 #root，加载样式与 app.js。 -->
  </head>
  <body>
    <div id="root"></div>
@@ -1,5 +1,4 @@
-/* ChuSQL Web IDE 样式：VS Code Dark+ 风格，纯手写，无框架。
-   字体与字号由 app.js 通过 CSS 变量（--ui-font 等）按 IDE 设置覆盖。 */
+/* ChuSQL Web IDE 样式：VS Code Dark+ 风格，变量由 app.js 覆盖。 */

 :root {
  --bg-base: #1e1e1e;
@@ -0,0 +1,269 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Gates (gateSpec) where
+
+import qualified Data.ByteString as BS
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import System.Directory (doesFileExist)
+import System.FilePath ((</>))
+import Test.Hspec
+
+-- 门禁测试：安装打包脚本、发布流水线、文档结构里必须出现的内容。
+
+-- | 按 UTF-8 读取文件
+readUtf8 :: FilePath -> IO Text
+readUtf8 path = TE.decodeUtf8 <$> BS.readFile path
+
+-- | 门禁用例入口
+gateSpec :: Spec
+gateSpec = do
+    describe "Installer scripts (scripts/)" $ do
+        it "install.sh releases files, writes chusql.toml, sets PATH and removes the package" $ do
+            installer <- readUtf8 (".." </> "scripts" </> "install.sh")
+            installer `shouldSatisfy` T.isInfixOf "libchusql_core_storage"
+            installer `shouldSatisfy` T.isInfixOf "chusql.toml"
+            installer `shouldSatisfy` T.isInfixOf "PATH"
+            installer `shouldSatisfy` T.isInfixOf "rm -rf"
+        -- 一份脚本三种来源：包内（旁边有 bin/）、在线（管道进来时 $0 是 sh，按平台取 release 资源）、
+        -- 显式归档或源码。去掉任何一条，从 GitHub 装的用法就断了。
+        it "install.sh picks the package by platform and can fall back to source" $ do
+            installer <- readUtf8 (".." </> "scripts" </> "install.sh")
+            installer `shouldSatisfy` T.isInfixOf "bin/libchusql_core_storage"
+            installer `shouldSatisfy` T.isInfixOf "uname -s"
+            installer `shouldSatisfy` T.isInfixOf "uname -m"
+            installer `shouldSatisfy` T.isInfixOf "releases/latest/download"
+            -- 一个平台一个包（web 和 cli 都在里面那一个归档里），按平台标签找，没有组件名那一层
+            installer `shouldSatisfy` T.isInfixOf "chusql-$label.$ext"
+            installer `shouldSatisfy` T.isInfixOf "chusql.$ext"
+            -- 释放按这次的选择走：没选的组件一个文件都不落地
+            installer `shouldSatisfy` T.isInfixOf "cp \"$pack/bin/csql\""
+            installer `shouldSatisfy` T.isInfixOf ".sha256"
+            installer `shouldSatisfy` T.isInfixOf "--url"
+            installer `shouldSatisfy` T.isInfixOf "--from-source"
+            installer `shouldSatisfy` T.isInfixOf "stack build --fast"
+            -- 版本可以指定、也可以先列出来：latest 先去 GitHub API 里挑「最新正式版且带本平台包」，
+            -- 自建站点（GHE / 镜像 / 本地夹具）走 /api/v3，取包也换同一套基地址。
+            installer `shouldSatisfy` T.isInfixOf "--list-versions"
+            installer `shouldSatisfy` T.isInfixOf "api/v3"
+            installer `shouldSatisfy` T.isInfixOf "CHUSQL_GITHUB_BASE"
+            -- 版本接口未认证只有 60 次/小时，两个脚本都要能用 token 抬高限额
+            installer `shouldSatisfy` T.isInfixOf "CHUSQL_GITHUB_TOKEN"
+        -- Windows 侧要跟 install.sh 对齐：旁边没有包就去发行站下 zip，版本可指定、可列出来，
+        -- 自建站点同样靠 CHUSQL_GITHUB_BASE 换基地址（api/v3 + 下载路径一起换）。
+        it "install.ps1 downloads the package, picks a version and can list versions" $ do
+            installer <- readUtf8 (".." </> "scripts" </> "install.ps1")
+            installer `shouldSatisfy` T.isInfixOf "bin\\chusql_core_storage.dll"
+            -- 与 install.sh 同一套命名：一个平台一个包，没有组件名那一层
+            installer `shouldSatisfy` T.isInfixOf "chusql-$label.zip"
+            installer `shouldSatisfy` T.isInfixOf "'chusql.zip'"
+            installer `shouldSatisfy` T.isInfixOf "releases/latest/download"
+            installer `shouldSatisfy` T.isInfixOf "-Version"
+            installer `shouldSatisfy` T.isInfixOf "-ListVersions"
+            installer `shouldSatisfy` T.isInfixOf ".sha256"
+            installer `shouldSatisfy` T.isInfixOf "api/v3"
+            installer `shouldSatisfy` T.isInfixOf "CHUSQL_GITHUB_BASE"
+            -- 版本接口未认证只有 60 次/小时，两个脚本都要能用 token 抬高限额
+            installer `shouldSatisfy` T.isInfixOf "CHUSQL_GITHUB_TOKEN"
+            installer `shouldSatisfy` T.isInfixOf "Expand-Archive"
+            -- PowerShell 7 的两个坑：Content 可能是字节数组（.sha256 会变成一串数字），
+            -- 函数 return 数组会被折成「装数组的单个对象」（版本挑选会拿到整张 tag 表）。
+            -- 两处都要绕开，否则校验和版本选择会静默出错。
+            installer `shouldSatisfy` T.isInfixOf "Get-ResponseText"
+            installer `shouldSatisfy` T.isInfixOf "-is [byte[]]"
+            installer `shouldSatisfy` T.isInfixOf "ConvertFrom-Json"
+        -- 装什么由人当场选：逐个问、问答用英文、默认装 csql 不装 Web，选完才问管理员口令。
+        -- 提问顺序固定：先 cli 后 web。两个脚本文案必须一致，改一个就得改另一个。
+        it "both installers ask which components to install, in the same words" $ do
+            sh <- readUtf8 (".." </> "scripts" </> "install.sh")
+            ps <- readUtf8 (".." </> "scripts" </> "install.ps1")
+            let cliAsk = "Install the command line client (csql)? [Y/n]"
+                webAsk = "Install the web front end (browser UI)? [y/N]"
+            mapM_
+                ( \src -> do
+                    src `shouldSatisfy` T.isInfixOf cliAsk
+                    src `shouldSatisfy` T.isInfixOf webAsk
+                    src `shouldSatisfy` T.isInfixOf "Root password for"
+                    -- cli 的问题必须出现在 web 之前（文档里的用法示例也按这个顺序写）
+                    T.length (fst (T.breakOn cliAsk src)) `shouldSatisfy` (< T.length (fst (T.breakOn webAsk src)))
+                )
+                [sh, ps]
+            sh `shouldSatisfy` T.isInfixOf "--interactive"
+            sh `shouldSatisfy` T.isInfixOf "both"
+            ps `shouldSatisfy` T.isInfixOf "-Interactive"
+            ps `shouldSatisfy` T.isInfixOf "both"
+            -- 到底装的哪个版本要打出来：latest 解析来的和显式指定的，两处都得有。
+            sh `shouldSatisfy` T.isInfixOf "echo \"  version    $version\""
+            sh `shouldSatisfy` T.isInfixOf "note \"version    $version\""
+            ps `shouldSatisfy` T.isInfixOf "  version    {0}"
+        -- 本机打发行包：文件名叫法和 CI 出的资产一致（install.sh / install.ps1 按同一套平台标签取），
+        -- 落在 releases/ 下（不入库），并自带 sha256。缺任何一样，自己打的包安装脚本就认不出来。
+        it "the packaging scripts write the same asset names as the release pipeline" $ do
+            sh <- readUtf8 (".." </> "scripts" </> "package.sh")
+            ps <- readUtf8 (".." </> "scripts" </> "package.ps1")
+            mapM_
+                ( \src -> do
+                    src `shouldSatisfy` T.isInfixOf "releases"
+                    src `shouldSatisfy` T.isInfixOf "install.sh"
+                    src `shouldSatisfy` T.isInfixOf "install.ps1"
+                )
+                [sh, ps]
+            sh `shouldSatisfy` T.isInfixOf "tar -czf"
+            sh `shouldSatisfy` T.isInfixOf "sha256"
+            -- 一个平台一个包：名字里不再有组件那一层，web 与 cli 都在同一个归档里，
+            -- 装哪个由包内脚本问；脚本自己也要按两种选择各验一遍（没选的不许落地）
+            sh `shouldSatisfy` T.isInfixOf "chusql-$platform"
+            sh `shouldSatisfy` T.isInfixOf "chusql-web/static"
+            sh `shouldSatisfy` T.isInfixOf "bin/csql"
+            sh `shouldSatisfy` T.isInfixOf "for comp in cli web"
+            -- 打包脚本自己不再有组件开关：--component 只留在包内安装脚本里（给非交互用），
+            -- 这里的自检要靠「它自己的选项表里没有组件项」来证明，不能一口咬定全文不出现这三个字。
+            sh `shouldSatisfy` T.isInfixOf "try --no-build, --out-dir DIR, --platform LABEL"
+            sh `shouldSatisfy` (not . T.isInfixOf "--component)")
+            ps `shouldSatisfy` T.isInfixOf "Compress-Archive"
+            ps `shouldSatisfy` T.isInfixOf "Get-FileHash"
+            ps `shouldSatisfy` T.isInfixOf "chusql-$Platform"
+            ps `shouldSatisfy` T.isInfixOf "chusql-web\\static"
+            ps `shouldSatisfy` T.isInfixOf "bin\\csql.exe"
+            ps `shouldSatisfy` T.isInfixOf "Test-Installed $name 'cli'"
+            ps `shouldSatisfy` (not . T.isInfixOf "$Component")
+
+            ignore <- readUtf8 (".." </> ".gitignore")
+            ignore `shouldSatisfy` T.isInfixOf "releases/"
+        -- static_dir 是相对路径，启动器必须先切到安装目录；少了这一句，从别处执行
+        -- csql-web 就会因为找不到 static/ 直接退出（Windows 的 .ps1 靠 -WorkingDirectory）。
+        it "csql-web.sh switches to the install dir before starting" $ do
+            launcher <- readUtf8 (".." </> "scripts" </> "csql-web.sh")
+            launcher `shouldSatisfy` T.isInfixOf "cd \"$home_dir\""
+            launcher `shouldSatisfy` T.isInfixOf "chusql-server"
+        -- 默认数据目录按平台惯例算，四处必须说同一件事：Rust 代码、配置示例、模板、文档。
+        -- 跟安装脚本装的位置也是一处：Windows 装到 %LOCALAPPDATA%\ChuSQL、Unix 装到 ~/.local/share/chusql，
+        -- 数据都放在它下面的 data/ 里。
+        it "the default data dir follows the platform, and code, template and docs agree" $ do
+            rust <- readUtf8 (".." </> "chusql-core" </> "storage" </> "src" </> "config.rs")
+            rust `shouldSatisfy` T.isInfixOf "default_data_dir"
+            rust `shouldSatisfy` T.isInfixOf "LOCALAPPDATA"
+            rust `shouldSatisfy` T.isInfixOf "XDG_DATA_HOME"
+            rust `shouldSatisfy` (not . T.isInfixOf "DEFAULT_DATA_DIR")
+
+            exampleFile <- readUtf8 (".." </> "chusql-core" </> "storage" </> "chusql-core-storage.toml.example")
+            -- 示例文件说自己列的值就是默认值：data_dir 不能是能生效的一行
+            exampleFile `shouldSatisfy` (not . T.isInfixOf "\ndata_dir =")
+            exampleFile `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%"
+            exampleFile `shouldSatisfy` T.isInfixOf "XDG_DATA_HOME"
+
+            template <- readUtf8 (".." </> "scripts" </> "chusql.toml")
+            -- 模板那行是安装时被 sed / -replace 替换的占位，必须保持能生效
+            template `shouldSatisfy` T.isInfixOf "\ndata_dir = "
+            template `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%"
+
+            configDoc <- readUtf8 (".." </> "doc" </> "config.md")
+            configDoc `shouldSatisfy` T.isInfixOf "%LOCALAPPDATA%\\ChuSQL\\data"
+            configDoc `shouldSatisfy` T.isInfixOf "chusql/data"
+        -- 管道传输退休后，两侧都不该再算套接字路径、也不该再认管名。
+        it "neither side computes a socket path or a pipe name any more" $ do
+            haskellIpc <- readUtf8 (".." </> "chusql-core" </> "engine" </> "src" </> "ChuSQL" </> "Core" </> "Engine" </> "Storage" </> "IPC.hs")
+            haskellIpc `shouldSatisfy` (not . T.isInfixOf "XDG_RUNTIME_DIR")
+            haskellIpc `shouldSatisfy` (not . T.isInfixOf ".sock")
+            haskellIpc `shouldSatisfy` (not . T.isInfixOf "pipe")
+            rustModules <- readUtf8 (".." </> "chusql-core" </> "storage" </> "src" </> "lib.rs")
+            rustModules `shouldSatisfy` (not . T.isInfixOf "endpoint")
+            storageConfig <- readUtf8 (".." </> "chusql-core" </> "storage" </> "src" </> "config.rs")
+            storageConfig `shouldSatisfy` (not . T.isInfixOf "pipe_name")
+        it "the Linux pipeline builds both toolchains and runs every test suite" $ do
+            pipeline <- readUtf8 (".." </> ".github" </> "workflows" </> "linux.yml")
+            pipeline `shouldSatisfy` T.isInfixOf "ubuntu-latest"
+            pipeline `shouldSatisfy` T.isInfixOf "cargo test --release"
+            pipeline `shouldSatisfy` T.isInfixOf "cargo clippy"
+            pipeline `shouldSatisfy` T.isInfixOf "stack test --fast"
+            -- 打包与安装冒烟只在发版流水线里做（tag 触发 / 手动 dispatch），这条流水线不再出包
+            pipeline `shouldSatisfy` (not . T.isInfixOf "package.ps1")
+            pipeline `shouldSatisfy` (not . T.isInfixOf "smoke-linux.sh")
+            -- 仓库里没有 rustfmt.toml，历史代码不是按当前 rustfmt 排的：格式化不是门禁
+            pipeline `shouldSatisfy` (not . T.isInfixOf "cargo fmt")
+        -- 装的人不该被要求装两个工具链：发版流水线出预编译包，install.sh 按同一套平台标签去取。
+        -- 流水线里装配与打归档是直接写的（两个平台各一段）；本机要打同一个包用 scripts/ 下的
+        -- package.sh 与它的 PowerShell 版，两边的布局必须一致。
+        it "the release pipeline publishes one archive per platform, tagged the way install.sh looks it up" $ do
+            release <- readUtf8 (".." </> ".github" </> "workflows" </> "release.yml")
+            release `shouldSatisfy` T.isInfixOf "linux-x86_64"
+            release `shouldSatisfy` T.isInfixOf "macos-arm64"
+            release `shouldSatisfy` T.isInfixOf "macos-x86_64"
+            release `shouldSatisfy` T.isInfixOf "windows-x86_64"
+            release `shouldSatisfy` T.isInfixOf "cargo build --release"
+            release `shouldSatisfy` T.isInfixOf "stack build --fast chusql-web:exe:chusql-web"
+            release `shouldSatisfy` T.isInfixOf "stack build --fast chusql-cli:exe:csql"
+            release `shouldSatisfy` T.isInfixOf "tar -czf"
+            release `shouldSatisfy` T.isInfixOf "Compress-Archive"
+            release `shouldSatisfy` T.isInfixOf "scripts/install.sh"
+            release `shouldSatisfy` (not . T.isInfixOf "package.ps1")
+            release `shouldSatisfy` T.isInfixOf "sha256"
+            release `shouldSatisfy` T.isInfixOf "gh release upload"
+            -- 四个平台各一个包，名字里没有组件那一层：一个包里 web 与 cli 都有；
+            -- 矩阵里也不该再出现 web / cli 这一维（那样又会产出两个按组件命名的资产）
+            release `shouldSatisfy` T.isInfixOf "name: ${{ matrix.platform }}"
+            release `shouldSatisfy` T.isInfixOf "name=\"chusql-${{ matrix.platform }}\""
+            release `shouldSatisfy` T.isInfixOf "name = \"chusql-${{ matrix.platform }}\""
+            release `shouldSatisfy` (not . T.isInfixOf "matrix.component")
+            release `shouldSatisfy` (not . T.isInfixOf "component: [web, cli]")
+        it "no layer looks for a storage executable or a pipe name any more" $ do
+            engine <- readUtf8 (".." </> "chusql-core" </> "engine" </> "test" </> "Spec.hs")
+            bench <- readUtf8 (".." </> "benchmark" </> "src" </> "Main.hs")
+            template <- readUtf8 (".." </> "scripts" </> "chusql.toml")
+            mapM_
+                (\src -> src `shouldSatisfy` (not . T.isInfixOf "pipe_name"))
+                [engine, bench, template]
+            mapM_
+                (\src -> src `shouldSatisfy` (not . T.isInfixOf "chusql-storage.exe"))
+                [engine, bench]
+            -- 起存储进程那一整个模块已经删掉，别再长回来
+            moduleGone <-
+                doesFileExist
+                    (".." </> "chusql-server" </> "src" </> "ChuSQL" </> "Server" </> "StorageProcess.hs")
+            moduleGone `shouldBe` False
+
+    -- 细节分到 doc/ 下四份，README 只留面向用户的关键内容；链接断了或者文档没了，等于没写。
+    describe "Documentation (doc/)" $ do
+        it "the README keeps only the essentials and links the split documents" $ do
+            readme <- readUtf8 (".." </> "README.md")
+            mapM_
+                (\target -> readme `shouldSatisfy` T.isInfixOf ("doc/" <> target <> ".md"))
+                ["install", "config", "commands", "architecture"]
+            -- 安装选项与配置键的长表已经搬走，不该在 README 里再长回来
+            readme `shouldSatisfy` (not . T.isInfixOf "--from-source")
+            readme `shouldSatisfy` (not . T.isInfixOf "pool_size")
+            -- 仓库布局这类开发者信息属于 doc/architecture.md，不属于 README
+            readme `shouldSatisfy` (not . T.isInfixOf "chusql-engine/")
+        it "each split document covers what its name promises" $ do
+            let expectations =
+                    [ ("install", ["install.sh", "install.ps1", "--component", "--install-dir", "--from-source", "--version", "--list-versions", "-Component", "-Version", "-ListVersions", "-Interactive", "CHUSQL_GITHUB_TOKEN", "rm -rf"])
+                    , ("config", ["[web]", "[page]", "data_dir", "host", "port"])
+                    , ("commands", ["csql", "--format", "\\dt", "CREATE ROLE", "GRANT", "/api/roles"])
+                    , ("architecture", ["chusql-core", "chusql-server", "chusql-web", "csql", "data_dir", "CREATE DATABASE"])
+                    ]
+            mapM_
+                ( \(name, needles) -> do
+                    doc <- readUtf8 (".." </> "doc" </> name <> ".md")
+                    mapM_ (\needle -> doc `shouldSatisfy` T.isInfixOf needle) needles
+                )
+                expectations
+        -- doc/ 只写面向用户的内容：构建、测试、打包这些开发流程不进文档
+        it "the split documents stay user-facing (no build, test or packaging recipes)" $ do
+            let developerOnly =
+                    [ "package.ps1"
+                    , "stack build"
+                    , "stack test"
+                    , "cargo build"
+                    , "cargo test"
+                    , "cargo clippy"
+                    , ".stack-work"
+                    , ".github/workflows"
+                    , "smoke-linux.sh"
+                    ]
+            mapM_
+                ( \name -> do
+                    doc <- readUtf8 (".." </> "doc" </> name <> ".md")
+                    mapM_ (\needle -> doc `shouldSatisfy` (not . T.isInfixOf needle)) developerOnly
+                )
+                ["install", "config", "commands", "architecture"]