修bug，完善功能

.agents/README.md

@@ -1,6 +1,10 @@
 # AI agent 协作资料
 
-按任务读取，不将全部资料作为每次工作的上下文。
+本页帮助 AI agent 选择任务所需资料。按任务读取，不将全部资料作为每次工作的上下文。
+
+## 资料入口
+
+各文件的职责如下：
 
 - 根目录 `AGENTS.md`：开发规则和测试入口。
 - `context/progress.txt`：唯一进度、测试计数和验收来源。
@@ -8,6 +12,10 @@
 - `context/main-roadmap.txt`：长期阶段；`side-branch-plan.txt`：近期任务及依赖。
 - `skills/chusql-*/`：类型、存储、跨组件边界三个项目专用技能。
 
+## 文档与技能
+
+文档写作使用全局 `technical-documentation` 和 `plain-writing`，具体规则见根目录 `AGENTS.md` 的“文档编写”一节。
+
 通用技能、安装锁文件及技能生成提示词仅保留在本地，不纳入版本控制。
 `gate-check/` 为开发者和 CI 共用的门禁工具；`logs/` 为忽略的本地产物。
 这些协作资料不参与应用构建、运行或发行打包。

.agents/context/design-decisions.txt

@@ -2,66 +2,142 @@
 进度见 progress.txt，限制见 known-issues.txt，用户操作见 docs/。
 
 ## 架构与接口
-- 用户文档按主题记录于 docs/commands.md、docs/types.md、docs/architecture.md 和 docs/install.md；只读范式入口已提供。后续实施 bound IR / DOMAIN，再推进物化、递归、MVCC、compact 和并行写；规划不代表现有能力。
+
+### 文档与后续方向
+
+- 用户文档按主题记录于 docs/commands.md、docs/types.md、docs/architecture.md 和 docs/install.md；只读范式入口已提供。
+
+  后续完善绑定后的中间表示（bound IR）与 DOMAIN，扩展物化资源控制、递归查询，并按实测减少行版本发布与在线整理的开销；规划不代表现有能力。
 - 范式迁移首版保留来源，拒绝 NULL、重复行与依赖不保持；发布目标须验证约束、完整重建并使用独立原子结构 WAL 组，不能复用禁止 DDL 的会话事务拼接执行。
-- 发布真实性采用 TUF 元数据链与 Ed25519，初始 root 必须可信取得；离线验证不证明最新版本，操作系统原生代码签名另行接入。
+- 发布真实性规划采用 TUF（用于验证软件更新元数据的框架）与 Ed25519 签名；初始 root 信任元数据必须可信取得，离线验证不证明最新版本。操作系统原生代码签名另行接入；这些签名能力尚未实现。
+
+### 组件边界与分层
+
 - Web / CLI → server TCP → Haskell 引擎 → FFI → Rust 存储；server 独占数据目录，Haskell 库静态链接，存储为 cdylib。
 - 引擎按 AST → 语义检查 → RelOp → 优化 → 执行分层；语义与优化只读 schema，表存在性以 catalog 为准，索引由存储管理。
-- JSON 使用显式稳定标签，FFI 仅提供 version / open / close / request / free / last_error；Web 不本地执行 SQL。
+- JSON 使用显式稳定标签，FFI 提供 version / open / close / request / maintenance / free / last_error；Web 不本地执行 SQL。
+
+### 类型语义的职责
+
 - 兼容值与类型语义集中于 Core.Model，运行时类型与版本化编码集中于 Core.Runtime，函数注册与绑定集中于 Engine.Runtime；旧运算符保留 Engine.Builtin，错误分类集中于 Engine.Error。
 - 比较与赋值兼容性分开，整数与整值浮点统一相等和哈希，SQL NULL 比较走三值逻辑；DML 的 CHECK 随写计划一次绑定，结构变更对新 schema 重新绑定。
+
+### 写入求值与约束
+
 - 写表达式和 CHECK 复用查询的列槽位绑定及行布局整理，避免按物理返回顺序取错值；UPDATE 在执行前按 schema 一次绑定目标槽位及列定义，按槽位校验、转换并覆盖单个值。目标不存在或歧义明确失败，不保留缺失类型时直接写入的兜底；保留逐项赋值、全部赋值后的 CHECK 及未命中行不求值。
 - INSERT 目标清单拒绝重复列，合法目标在本次执行中一次映射到 VALUES 槽位；行构造保留 schema 顺序及原输入表达式求值顺序，默认值、自增、显式 NULL 和整批校验沿用既有语义。缺少已绑定输入值明确失败，不把它作为省略列处理。
 - UPDATE 在全部行求值及 CHECK 成功后、调用存储写入前，复用 INSERT 的 NOT NULL 和 UNIQUE / PRIMARY KEY 检查；唯一性以最终整表结果判断，多个 NULL 不冲突。约束失败不发布部分行修改，事务快照保留并允许修正后继续提交。
-- NOT NULL 和 UNIQUE / PRIMARY KEY 检查使用 schema 位置绑定列，缺值或位置不符明确失败，不用 mapMaybe 跳过缺列。INSERT 的已有行与经引擎重写 schema 的 ALTER 输入行在约束边界按原 schema 整理；保留列级错误顺序、NULL 去重规则和数值规范化比较。
-- 写语句及已有表 DDL 使用仅保存 schema 的 BoundWrite，复用查询的依赖验证规则；收集目标、嵌套查询和传递 DOMAIN，新增列或改类型包含新声明 DOMAIN。先以只读 validate_write 确认写守卫能力，再发送实际写入；存储按库名排序取门，在目标库独占门及其他依赖共享门内复查后执行，不改变单次请求之间的数据隔离语义。
+- NOT NULL 和 UNIQUE / PRIMARY KEY 检查使用 schema 位置绑定列，缺值或位置不符明确失败，不用 mapMaybe 跳过缺列。
+
+  INSERT 的已有行与经引擎重写 schema 的 ALTER 输入行在约束边界按原 schema 整理；保留列级错误顺序、NULL 去重规则和数值规范化比较。
+
+### 写计划与结构守卫
+
+- 写语句及已有表 DDL 使用仅保存 schema 的 BoundWrite，复用查询的依赖验证规则；收集目标、嵌套查询和传递 DOMAIN，新增列或改类型包含新声明 DOMAIN。
+
+  先以只读 validate_write 确认写守卫能力，再发送实际写入；存储按库名排序取门，在目标库独占门及其他依赖共享门内复查后执行，不改变单次请求之间的数据隔离语义。
 - BoundWrite 的 DML 动作保存 INSERT 输入槽位、UPDATE 赋值目标、DELETE 布局和预绑定 CHECK / 非空 / 唯一性约束，执行期不再重新解析或按名称绑定目标；自动编号仍从当前行集求起点，唯一性仍按最终行集校验，保持逐项赋值及未命中行不求值。
 - CHECK 定义与执行共用布尔条件、函数和槽位绑定；聚合及子查询拒绝。结构变更先按新 schema 校验保留约束、默认值及键能力，空表不跳过；CHECK 文本未采用独立列身份，改名不自动重写，失效引用明确拒绝。
 
 ## 查询与优化
+
+### 优化与成本选择
+
 - 优化保持结果语义和可观察行序；相关外层列不能被投影删除，LEFT JOIN 只下推安全的左侧谓词。
 - schema 携带行数、distinct、索引和直方图，缺统计时保守退回原计划。范围成本使用 16 桶等宽直方图，无直方图时按四分之一估算。
 - 内连接从各起点贪心选序，仅在严格更省且行序不可观察处重排；统计不足或不安全条件时不改写。
+
+### 名称与作用域
+
 - 表 / 列限定名在语义层按作用域及唯一候选解析，别名优先；会话将当前库限定 DDL 转为裸名，拒绝跨库目标，库名随请求传递。
 - 相关子查询的语义列环境按词法层逐层查找，保留最近层的列及类型，不把不同外层并成一张表；本层歧义不向外回退。JOIN ON 和外部引用收集使用同一外层环境，来源检查失败明确传播。执行期仍使用既有扁平外层行布局。
 - SELECT 在引擎入口直接进入 BoundQuery，避免规范化引用再次作为原始来源名解析；二段限定名被最近层同名来源遮蔽，该来源缺列时不回退。裸列仍按列可见性逐层查找，已解析引用的类型推导不重新解释来源遮蔽。
+
+### 列槽位与重绑定
+
 - 绑定后的子查询保存父布局中的局部或外层列槽位，取值与复用缓存键共享该绑定；诊断名称相同不表示位置相同。重绑定不把外层引用转为局部引用，布局失配和引用清单失配明确返回错误；原始关系执行 API 保留未绑定 Subquery 的名称入口。
 - 已绑定列重绑定时保留仍匹配名称的有效位置，原位置不匹配仅允许唯一同名列重定位；歧义或负位置拒绝。外层槽位保留相对位置并更新局部宽度；独立列身份未实现，结构改写仍须在绑定前完成，不能凭同名槽位识别重排后的不同列。
 - 相关子查询保留已解析外层限定名；求值绑定补回单表物理列的限定名，绑定去重与扫描投影使用同一列值，库限定引用仍校验 schema 来源。
+
+### 子查询执行与复用
+
 - JOIN 条件按子查询外层引用的值缓存替换后的表达式；首次遇到行对时才求值，每个行对仍计算普通条件，保留输出顺序、空输入和错误返回。
-- 半连接仅重写独立 IN 或单表唯一等值相关 EXISTS 的单独过滤谓词；键按两侧布局分别绑定，输出只保留原左行。独立 IN 沿用物化身份，NOT IN 感知右侧 NULL，反 EXISTS 保留空值键；大数混合比较退回原比较语义。复杂条件、可能报错的相关投影和相关聚合不重写，空左侧不执行右侧，保持完整右侧求值；空集 IN 为假、NOT IN 为真（含 NULL 左值），非空集合保持三值逻辑。
+- 半连接仅重写独立 IN 或单表唯一等值相关 EXISTS 的单独过滤谓词；键按两侧布局分别绑定，输出只保留原左行。独立 IN 沿用物化身份，NOT IN 感知右侧 NULL，反 EXISTS 保留空值键；大数混合比较退回原比较语义。
+
+  复杂条件、可能报错的相关投影和相关聚合不重写，空左侧不执行右侧，保持完整右侧求值；空集 IN 为假、NOT IN 为真（含 NULL 左值），非空集合保持三值逻辑。
 - 每次查询执行用独立状态物化成功行集，子查询按已解析定义和具名外层绑定值共享，原始名称调用保守包含整个外层行；派生表按执行子树和外层行缓存，先共享再应用别名。各消费者独立处理标量基数与三值逻辑，失败仍明确返回，保持既有求值顺序；不跨执行保留，也不提供整条查询快照或磁盘溢出。
+
+## 存储提交前校验
+
 - WAL 提交组落盘后、首次应用前进入 recovery_required；任何应用、刷盘或检查点错误都保持该状态，完整落盘与截断成功后才解除。
+- 普通提交组在分配对象编号及写 WAL 前，使用 HeapTable::encode_row 检查全部载荷行；单写、批写、整表替换、事务及结构重写共用此边界，避免可预见的行大小错误在提交后触发恢复封闭。账号专用 WAL 路径保留原有账号行预校验；不改变页格式与已有恢复顺序。
+- 索引键容量共用 DiskBTree::check_key，存储提交预检复用堆表实际键编码；结构替换只检查保留的内置 id 索引，删列重写排除已移除索引。建索引在写 WAL 前扫描目标列校验；堆表插入、建索引和整表替换在修改数据前检查键长，不用截断键或跳过错误降级。
+- 新插入 id 的冲突预检复用 row_key，在同库写门内按 WAL 操作顺序维护键计数；未涉及的现存键按需查询 id 索引，不为单次插入全表扫描。
+
+  删除键在一条操作内去重且每键只减一，保留旧重复 id 的首行删除规则；整表替换重建预检基线，沿用其兼容重复 id 的行为。预检不改变恢复重放与原有页格式。
+- 目录预演覆盖普通写入可能触发的扩列及结构重写的载荷行，列推导与版本递增共用 Catalog::ensure_columns；只在结构操作或输入可能扩列时克隆目录。
+
+  按行及操作顺序累计变化，在写 WAL 前拒绝版本耗尽，保留同一行多列只递增一次及未定型 NULL 不扩列的规则；已有列的数据写入不因版本达到上限而被拒绝。
+- Request::valid_columns 检查所有写入载荷的顶层字段名及事务内行，存储表名与列名字符集共用 valid_storage_name；保持已有非空 ASCII 字母、数字及下划线规则。
+
+  只在请求边界约束新载荷，不递归检查值内部键，不对旧目录、堆行及 WAL 重放加新名称限制，也不静默改名或丢字段。
+
+## 查询来源与排序
+
 - FROM 是来源树，派生表必须带别名且不能引用外层，输出取裸列名，重名报错；未定型 NULL 保留独立查询推导类型，不能声明为存储类型。
 - ORDER BY 优先匹配唯一输出别名，再查来源列；只将排序表达式提前计算，非排序投影保持在 LIMIT 后求值。CTE 列清单同步重命名内层排序别名。
 - ORDER BY 输出序号保留到计划生成，不转换为诊断名称；普通查询选定对应投影表达式，DISTINCT 按去重结果槽位排序，重复别名不丢失位置。名称排序仍拒绝歧义，序号不作为相关子查询自由列，排序键遵守类型能力、分组及 LIMIT 求值时序。
 - 派生表从透明算子与 schema 统计估算行数，缺统计或表达式可能报错时不重排；投影下推保留计算项，避免删除错误。内存存储提供实时行数及封顶去重统计。
+
+### 数值与子查询语义
+
 - DECIMAL(p,s) 使用有限浮点、ties-to-even 舍入和舍入后溢出检查，要求 1 <= p <= 308、0 <= s <= p；Haskell 与 Rust 写入入口统一边界，日志记录规范化值。
-- CTE 解析期展开为派生表，只接受 SELECT，不物化；多次引用重复执行，以减少实现改动面。
+- CTE 解析期展开为派生表，只接受 SELECT。相同执行子树在一次查询中物化复用；不同投影或优化后的子树仍分别执行，不支持递归或显式物化语法。
 - 比较及 ANY / ALL 使用独立 AST 节点，量词复用三值逻辑，空集 ANY=false、ALL=true。
-- 子查询在 Filter / Compute 中按外层绑定分组复用，暂不引入半连接；扫描按页分片，至少 1000 行、最多 8 线程，结果保序，safe FFI 释放执行能力。
+- 子查询在 Filter / Compute 中按外层绑定分组复用；适用的独立 IN 与简单等值相关 EXISTS 使用半连接或反连接，复杂条件保留原路径。扫描按页分片，至少 1000 行、最多 8 线程，结果保序，safe FFI 释放执行能力。
 
 ## 会话、事务与存储
+
+### 会话快照与差分
+
 - 每连接独立会话及工作库；短锁取得库句柄后执行，每库读写门控制可见性，表锁保护页，在用库不强行删除。
 - BEGIN 物化当前库快照，事务内走内存执行，COMMIT 提交相对基线差分，ROLLBACK 丢弃快照。
 - COMMIT 先跳过数据未修改的表，整数 id 用 IntMap / IntSet 查找差异与冲突；保留原行顺序及重复 id 的首行查找语义，冲突检查和提交操作共享一次差分。
+- SQL 数据语句和提交使用共享全局门与共享库门；同库最终校验和发布使用单独的短提交门。自动提交也走事务计划、行锁和版本复查，保持失败不部分发布。权限与 DDL 全局独占，原始管理员存储写入通过版本变化参与冲突检查。
 - 有整数 id 时按键提交及检查写写冲突，无整数 id 时整表比对；未修改表不回写，冲突保留事务并返回 serialization_failure。
+- COMMIT 在短提交门内预演实际事务操作，并复用引擎的领域 / CHECK / 非空 / 唯一性规则校验合并最终行集，避免不同整数主键绕过业务唯一约束；校验失败不写 WAL，事务保留。内存预演与存储一致，每个去重删除键只删除首个旧重复 id 行。
+- 可选 BEGIN [TRANSACTION] ISOLATION LEVEL SERIALIZABLE / START TRANSACTION ISOLATION LEVEL SERIALIZABLE 保留整库快照，在写事务提交时复查读写语句全部表的 schema 和行集，包含子查询与幻行；按表保守拒绝冲突，默认 BEGIN 的不同行差分合并不变。保存点恢复语句列表，也恢复读依赖；只读事务不因数据变化拒绝提交。
 - 保存点保存不可变快照引用，同名取最近一层，回退 / 释放丢弃之后的点，结束清空；事务命令由会话层执行。
+
+### 日志与恢复
+
 - WAL 先记录操作及提交标记，再应用、刷数据与 catalog、写检查点、截断；仅重放已提交且超过检查点的记录。
 - WAL 帧保留长度、LSN、类型码、表名及 JSON payload，兼容旧记录；恢复按内容、schema 和文件存在性判断幂等。
 - 检查点按库 LSN，前缀截断用同目录临时文件原子替换，未提交尾部直接截短；失败保留 WAL 并进入 recovery_required。
 - 检查点采用同目录临时文件替换，长度必须为 8 字节；完整 WAL 帧损坏明确报错，尾部不完整帧保留撕裂处理。刷盘或检查点失败后封闭请求，重启重放已提交组。
+
+### 统计与页面整理
+
 - distinct 在封顶前按值引用计数维护，列封顶不清除其他列状态；直方图独立累计与递减，桶重映射导致删除目标为空时扣最近非空桶以保持总量。rebuild_stats 先扫描数值范围，再按固定边界计数，消除重建过程的桶重映射偏差并保持输入顺序无关。
 - 表 / 索引 DDL 进 WAL，删表不重取已移除句柄；库建删不进 WAL，删除以墓碑目录收敛。
-- 页内 compact 保持槽号及索引位置，死空间达到四分之一时自动整理；无隐藏列逐页整理，有隐藏列整表重写，不跨页填空以保留行序。
+- 自动页内 compact 保持槽号及索引位置，死空间达到四分之一时触发；显式 compact 经 WAL 按原扫描顺序打包存活行，回收跨页空洞和隐藏列字节，并重建索引位置。
 
 ## 身份、权限与引导
+
+### 对象编号
+
 - 对象标识使用数据库编号与库内表编号组合；数据库编号从 system catalog 的对象高水位分配，表编号从本库高水位分配，删除不降低计数器。对象解析只读取 catalog。
 - 建表编号在 WAL 组写入前分配，随建表记录提交；目录应用时推进高水位，恢复使用日志编号。只有建表组复制操作列表，普通数据提交沿用借用列表。
+
+### 身份与角色
+
 - 用户是可登录角色，共用名称空间；identities 保存属性、时间、稳定编号及版本，users 只存编号和口令哈希，编号不复用。
 - 最高权限按身份属性判断，不按名称、不继承；默认用户 LOGIN、角色 NOLOGIN，两者 NOSUPERUSER / ENABLED。保护最后一个启用的登录管理员。
 - 仅旧格式迁移按管理员参数识别初始最高权限；旧账号保留信息，角色补编号，重名拒绝；身份、凭据及删除清理用同一 Accounts WAL。
 - server 判定权限，目录封装于 Server.Catalog；角色成员取向上闭包，写入拒绝环。GRANT role TO member 表示 member 继承 role 权限。
+
+### 对象授权与会话失效
+
 - members 保持身份成员目录；对象授权存于受保护 __system_object_acl，使用稳定对象与身份编号，保存所有者、授予者和 grant option。CONNECT / CREATE 限数据库，四项数据权限限表或单库表范围；ALL 按作用域展开。
 - PUBLIC 默认只提供业务数据库 CONNECT，可逐库撤销；CREATE 建表登记创建者所有权，数据库所有权不隐含他人表的数据权限。启用角色可继承所有权，不继承 SUPERUSER。
 - 授权链从独立管理来源及所有权展开固定点；撤销清理无来源下游，保留独立来源，循环不能自持。禁用保留所有权和管理来源授权，停止权限贡献并清理失效下游。
@@ -69,45 +145,115 @@
 - 权限快照按字符分块存储，比较旧快照后以同一 WAL 组替换；跨页及 Unicode 不受单行上限限制。普通存储入口隐藏并拒绝访问权限快照表。
 - 服务端共享公平读写锁排序查询与权限变更；事务提交复查身份、权限和稳定对象。建表前写入创建者声明，启动时依据现存对象恢复所有权或清理未完成声明。
 - 口令 / 属性推进 revision，权限变更预先展开受影响身份；TCP 只标记连接失效，下一请求回 unauthorized 后关闭，避免 Windows 阻塞句柄异步中断；登记在 finally 清理。
+
+### 系统目录与引导
+
 - 系统表统一 __system_ 前缀并分层保护，内部目录按白名单访问；旧名按文件先、catalog 后迁移，崩溃后可重复收敛。
 - 安装先 bootstrap：建立 system、默认 root（LOGIN / SUPERUSER / ENABLED）、18 个内置名称，再起服务；引导请求不开放 TCP。
 - 清单编入引导并与解析器测试比对；system.__system_types 保存名称、基础表示、参数能力、编号。重复引导保留口令并补齐类型，冲突或身份降权失败；类型建表与写入用同组 WAL。
 
+### 本机 sudo 认证
+
 - sudo 认证用独立 allow_sudo_auth 属性和显式 sudo_auth_user 映射；默认关闭，只有 SUPERUSER 能管理，不继承、不隐含权限。目录管理者不得管理启用该属性的身份。
 - 选择操作系统保护的随机本机凭据与 TCP 一次性 HMAC 挑战，以复用三平台既有会话协议；Unix 只信任有效 UID 0，Windows 只信任提升 Administrators 令牌。双方校验内核回环地址，不接受客户端自报 OS 用户或 SUDO_USER。
 - 本机凭据只存放于系统保护的端口专属目录，原生入口校验提升身份；实例重启重新生成，现存目录拒绝覆盖。此方案要求服务端也提升运行，以保证创建凭据时的操作系统保护边界。
 - 挑战绑定账号、连接及实例，60 秒过期并在每次尝试时消费；证明常量时间比对，凭据不经网络发送。成功登录复用身份版本、登录时间及连接失效机制，审计不含凭据或证明。
 - sudo 属性由 Accounts WAL 持久化，旧目录缺列触发身份快照重写，旧记录缺属性默认 false，已有的错误类型明确拒绝。
 
+## 范式分析
+
+- 范式检查采用阿姆斯特朗属性闭包与子集枚举，候选键声明转为决定全关系的依赖；完整覆盖声明与领域原子性分别控制可证明结论，不从样本推断。二元 BCNF 建议按违反依赖无损拆分，投影依赖之并用于验证依赖保持。
+
 ## 自定义类型
- - 范式检查采用阿姆斯特朗属性闭包与子集枚举，候选键声明转为决定全关系的依赖；完整覆盖声明与领域原子性分别控制可证明结论，不从样本推断。二元 BCNF 建议按违反依赖无损拆分，投影依赖之并用于验证依赖保持。
-- DOMAIN 命名基础类型，列编码 domain(名称,基础类型) 保留引用，值及索引沿用底层语义。
+
+### DOMAIN 定义与变更
+
+- DOMAIN 命名基础类型，列编码 domain(名称,基础类型) 保留引用，值及索引沿用底层语义。领域目录的 base 列保存类型、可空性与默认值，check_名称 列保存具名条件，旧的仅基础类型定义继续可读；未改变值、页或 WAL 编码版本。
+- DOMAIN CHECK 在独立 VALUE 槽位绑定，拒绝聚合及子查询，TRUE / UNKNOWN 通过。领域继承全部 CHECK 和非空限制，默认值按列、最近领域、基础领域选取；继承属性只在绑定时合成，不写回列声明。
+- ALTER DOMAIN 在库读门内取完整定义及数据快照，引擎校验传递依赖、默认值和已有行；库身份与 WAL 检查点组成精确令牌，在写门内复查后走 ReplaceSchema WAL。
+
+  并发提交返回 serialization_failure；复用已有恢复与结构版本，不引入通用结构事务。创建依赖领域的表 / 领域也在发布点验证结构守卫；事务提交复查修改表及传递领域依赖。
 - 各库 __system_domain_<名称> 空目录表的 base 列保存定义，复用 catalog / DDL WAL；普通 SQL 隐藏并保护目录。
 - 嵌套只引用当前库已有类型，语义层从 schema 递归解析并拒绝循环，存储写锁内逐层校验；删除检查类型间及间接列依赖。
-- 类型 DDL 要求管理员、事务内禁止；约束与默认值后续扩展，暂不引入自定义函数 / 运算符。
+- 类型 DDL 要求管理员，事务内禁止。DOMAIN 已支持默认值、非空与 CHECK 约束；暂不引入自定义函数 / 运算符。
+
+### 运行时类型与表达式
+
 - 运行时类型使用稳定构造器编号与结构化 TypeId，逻辑类型与 PhysicalType 分离；递归值使用版本 1 标签编码，读取时校验类型、形状及载荷。
 - TypedExpression / TypedPlan 仅使用 schema 绑定，SQL BoundQuery 通过既有 RelOp 执行并按输出位置验证；输出类型保留嵌套 DOMAIN 名称，基础日期、时间戳及 Blob 保留兼容类型，函数结果不继承参数领域。
-- TypedExpression 列引用保存输入 schema 槽位与诊断名称；独立求值要求行顺序匹配，TypedPlan 扫描边界校验并按 schema 排序，每层投影绑定到子计划输出。SQL RelOp 在优化后绑定表达式列槽位，投影单向转为 Compute，排序/分组转为 BoundSort/BoundAggregate，存储结果按算子布局排列；子查询局部列在前、外层绑定在后。绑定算子不参与后续投影下推；独立作用域身份仍待迁移。
+- TypedExpression 列引用保存输入 schema 槽位与诊断名称；独立求值要求行顺序匹配，TypedPlan 扫描边界校验并按 schema 排序，每层投影绑定到子计划输出。
+
+  SQL RelOp 在优化后绑定表达式列槽位，投影单向转为 Compute，排序/分组转为 BoundSort/BoundAggregate，存储结果按算子布局排列；子查询局部列在前、外层绑定在后。
+
+  绑定算子不参与后续投影下推；独立作用域身份仍待迁移。
 - SQL 局部引用使用 ColumnSlot，外层引用使用 OuterColumnSlot 的相对位置及局部布局宽度。重新绑定外层引用只查询外层布局，避免同名局部捕获；语义输入拒绝执行槽位。外层行仍扁平化，多级词法作用域/来源编号另行迁移。
-- BoundQuery 执行前重新取得 schema 并比较依赖对象身份、schema 版本及列定义，依赖覆盖全部嵌套子查询及来源列的传递 DOMAIN 定义。IPC 将依赖守卫限定在本次执行环境；扫描、分片、点查及范围读均在相关库读锁内复查全部依赖后读取，跨库读锁按库名排序，持有库引用防止删除。数据、统计和无关对象不参与比较；旧目录缺失版本时仍比较列定义，已知身份或版本丢失则拒绝。守卫响应必须明确确认，旧二进制忽略字段时拒绝；未实现守卫的后端明确报错，纯内存视图可直接执行。守卫不改变既有多请求查询的数据隔离语义。
-- 内建函数先解析为稳定 FunctionId 并验证签名，再执行；SQL NULL 保留三值语义。缺少能力字典的运行时类型拒绝比较、排序、分组、极值、索引及唯一键声明。
+
+### 查询依赖的结构守卫
+
+- BoundQuery 执行前重新取得 schema 并比较依赖对象身份、schema 版本及列定义，依赖覆盖全部嵌套子查询及来源列的传递 DOMAIN 定义。
+
+  IPC 将依赖守卫限定在本次执行环境；扫描、分片、点查及范围读均在相关库读锁内复查全部依赖后读取，跨库读锁按库名排序，持有库引用防止删除。数据、统计和无关对象不参与比较；旧目录缺失版本时仍比较列定义，已知身份或版本丢失则拒绝。
+
+  守卫响应必须明确确认，旧二进制忽略字段时拒绝；未实现守卫的后端明确报错，纯内存视图可直接执行。守卫不改变既有多请求查询的数据隔离语义。
+- 内建函数先解析为稳定 FunctionId 并验证签名，再执行；SQL NULL 保留三值语义。运行时描述保存 Eq / Ord / Hash 能力，List、Maybe、Tuple 根据参数递归派生，DOMAIN 沿用基础类型。SQL 比较和量词按运算要求能力，GROUP BY / DISTINCT 同时要求 Eq 和 Hash。
+- 复合值排序使用类型身份与结构的字典序；哈希按构造器与子值递归计算，统一浮点正负零，不依赖显示文本。类型和值编码仍为版本 1；哈希只用于内存执行，不需重建持久化索引。SQL NULL 与 Maybe Nothing 分开，空容器也保留完整身份。
+- 复合值的 Eq / Ord / Hash 不等于索引键能力；运行时索引及 UNIQUE / PRIMARY KEY 继续拒绝，索引连接仅对现有整数或文本键探测，其余走扫描 / 哈希回退。
 - SQL 字面量生成返回明确错误，先验证运行时值与有限浮点；复合值在 Web 使用 SQL 修改。
 
 ## 配置、构建与发行
+
+### Web 编辑与受限管理
+
 - Web 编辑在首个业务表加载时建立快照，在提交 / 回退时结束；既有大库基准 BEGIN 269.806 ms、COMMIT 376.345 ms，不按每次单元格编辑重建整库快照。
 - Web 登录分别建立普通 API / SQL 和编辑连接，页面 / 数据库标识绑定编辑事务，SQL 事务另绑定查询标签；同 Cookie 请求串行执行。
 - 编辑集保留在浏览器，提交从固定保存点重放；失败回退整个编辑集，冲突回滚并重新加载，成功回执去重；系统身份修改不进入数据事务。
 - system_catalog_manager 只管理普通身份，不继承、不隐含业务访问权限；存储写锁内再次拒绝特权目标及特权属性修改。
+
+### 离线维护与配置
+
 - bootstrap 维护使用独占数据目录锁，在副本中修复并验证后保留原目录备份再发布；repair 不重放 WAL、不补初始化数据，原有数据文件必须字节一致。
 - listen_host 是监听配置，static 固定为静态目录，管理员名由 --user 指定；data_dir 存数据，log_files 存日志，相对路径以启动目录解释。
-- resources/chusql.toml 入库并打包，UI 设置样本不入库、不进包，运行时按 resources、上一级 resources、工作目录候选查找。
+- resources/settings.toml.linux 与 resources/settings.toml.windows 入库并打包，安装时填入平台路径并生成 settings.toml；UI 设置样本不入库、不进包。配置路径以 docs/config.md 为准。
+
+### 安装与门禁
+
 - 预编译包优先，server / 存储必装，Web / CLI 可选；Windows zip、Linux/macOS tar.gz。包内模板也放 resources/，按确切产物名打包并拒绝未知工件。
 - 本地解包安装不联网，管理员名同时传 bootstrap 和 server；安装冒烟隔离配置并恢复用户 PATH，卸载可保留数据 / 配置。
 - 门禁先刷新 release cdylib，再并行 Rust、串行 Haskell、注释三条车道；Server / Web 先刷新各工程的本地依赖，任一步失败即失败。
 - 局部改动只测试受影响模块；较大改动由 agent 执行全量门禁。日志 / 临时文件在 logs/，必要时 -Full；门禁及打包强制 UTF-8 以避免 GBK 编码失败。
+
+### 口令输入与诊断
+
 - CLI 终端隐藏口令，管道兼容 LF / CRLF / 无行尾，保留空格与内部回车，提示写 stderr。
 - CLI 禁用逐行自动历史，只记录完整 SQL 与元命令；含 IDENTIFIED / PASSWORD（忽略大小写）的输入整体排除，避免多行口令或执行失败留下片段。解析错误也隐藏此类原文，筛选保守包含字符串和标识符中的同名文本，已有历史不自动删除。
 - TCP 与 Web 使用同一解析诊断脱敏路径；Web 回归校验整个 HTTP 错误响应不含口令。内置 SQL 控制台记录结果或诊断，不将 SQL 原文写入日志，外部代理和采集需自行配置。
+
+### 对象及结构版本编码
+
 - BoundQuery 保存来源对象身份及列定义；DOMAIN 依赖从来源列递归展开，执行前复查。库 / 对象编号在 TableInfo 中输出十进制字符串，读取兼容旧数值，零对象编号表示无有效身份。
-- 表级 schema_version 由 catalog 持久化，新表从 1 开始，旧目录缺失版本保留 0；结构变化递增，新增结构 WAL 记录保存确定目标版本，恢复不重新分配。线上使用精确十进制字符串并兼容数值输入，0 或缺失表示未知版本；IPC schema / 快照与内存 Server 保留版本，内存 DDL 同样递增并拒绝耗尽。
+- 表级 schema_version 由 catalog 持久化，新表从 1 开始，旧目录缺失版本保留 0；结构变化递增，新增结构 WAL 记录保存确定目标版本，恢复不重新分配。
+
+  线上使用精确十进制字符串并兼容数值输入，0 或缺失表示未知版本；IPC schema / 快照与内存 Server 保留版本，内存 DDL 同样递增并拒绝耗尽。
 - 注释以 AGENTS.md 为准；原因写本文件，限制写 known-issues.txt，进度及计数只以 progress.txt 为准。
+
+### 容器部署
+
+- 同一运行镜像包含数据库、引导、CLI 和 Web，Compose 将数据库与 Web 分为单进程服务；Web 不挂载数据库目录。运行 UID/GID 为 10001，命名卷保存数据、日志及编辑器偏好。
+- 每次 server 启动复用既有幂等 bootstrap，口令从文件经 stdin 输入，不使用文件标记判断系统目录状态；失败阻止启动，不自动 repair / reset。已有口令不随 secret 文件修改而重设。
+- Rust 与 Haskell 使用固定 digest 的 Bookworm 构建阶段，运行层沿用 Bookworm。BASE_REGISTRY 只替换下载地址，保持 digest 校验；Debian 与 Cargo 镜像源保留签名及锁文件校验。源码构建单任务且限制 GHC 堆，WSL 使用 1 核 / 3 GiB、无额外交换空间的 Buildx 或异机构建导入。
+- Compose 通过 CHUSQL_IMAGE 固定验收镜像，服务默认限制 1 核 / 512 MiB、128 个进程或线程且无额外交换空间。不同 UID 的旧数据卷须停机备份后显式调整所有者，不由服务启动脚本自动递归改权限。
+
+## 博客业务接入
+
+- 业务用户与数据库身份分离，角色使用标量 CHECK；账号完整 Argon2id PHC、发布授权、文章权威状态、评论、互动、审计及迁移标记持久化，可重建文章索引独立。正文与资源留在 Git 文件，接入验收见 docs/blog-database.md。
+- 标量索引键上限为 min(128, floor((page_size - 11) / (order - 1)) - 12)，保留按旧 64 字节预算校验配置的规则，避免现有合法页 / 分支数组合失效。旧索引头可读取，首次写长键更新能力字段；页、槽位、WAL 与键排序编码不变，提交前及堆直接写入共用配置上限。
+
+## 存储并发与页恢复
+
+- 全局公平门排序权限和 DDL；SQL 数据准备共享库门，最终约束校验与 WAL 发布串行，以保留连续已应用提交前缀。行锁等待位于库门外，持有内部行编号及旧、新唯一值锁；固定名称顺序用于跨库门，等待图用于跨请求行锁。环中的新等待者中止，锁等待总上限 5 秒。保存点回滚恢复计划和读依赖，严格持锁到事务结束。
+- 行版本保存在独立的 mvcc.json，以 WAL 提交 LSN 为可见序号，使用不复用内部行编号、起止序号、内容版本和逻辑行序。内容版本与位置变化分开，避免其他行的删除或排序造成伪写冲突。发布顺序是逻辑 WAL、数据与索引、版本目录、库检查点；重放后幂等发布版本。版本超前于可恢复 WAL 时拒绝打开，不冒充已完成恢复。
+- 选择独立版本文件以保留现有页与键格式，代价是整库扫描和版本文件写放大。SQL 仍使用物化工作行集；默认快照隔离，SERIALIZABLE 写事务按表保守复查读依赖。版本保留到最老活跃快照，结束事务回收内存，后续发布回收磁盘版本。database_snapshot 的单版本缓存继续供普通后端读取，不承担事务存活登记。
+- 保留现有页内布局，以 .page-wal 记录 CPW1 全页镜像、写序号与校验和，以版本 1 的 .pages 保存页 LSN。镜像先同步，数据文件再同步，页元数据经临时文件原子替换并同步目录，最后清理镜像；库 WAL 检查点在这些步骤之后推进。
+- 同一逻辑提交可多次刷新同一页，镜像按独立写序号恢复，不仅按页 LSN 比较；截断也写入重置标记。缓存淘汰先记录并写回当前脏页批次，避免反复记录未修改的缓存页。日志错误使当前页句柄进入恢复封闭，保留材料而不靠析构重试。
+- 已提交逻辑组重放前丢弃受影响表的派生索引，再依据修复后的堆重建；整表载荷直接重写，避免残缺根或部分行集阻断幂等恢复。账号变更统一走带提交标记和检查点的组，保留旧账号日志解码 / 恢复。
+- 显式 compact 在独立文件代次复制堆与索引，最终库写门内追平并发变更，保留切换时逻辑行序。影子文件同步后用 Migrate WAL 发布 catalog.file_generation，对象身份与结构版本不变。旧快照阻止退役文件删除；启动恢复后清理孤立代次。保留有序前缀、重写其余后缀避免重排可观察行序，代价是变化较多时切换窗口变长。启动隐藏列整理保留离线 Compact 日志兼容。

.agents/context/known-issues.txt

@@ -2,29 +2,60 @@
 进度见 progress.txt，设计见 design-decisions.txt；仅记录未解决的限制。
 
 ## 事务、恢复与并发
-- 事务是整库内存快照，不是行版本 MVCC；每会话一个事务，无嵌套事务，事务内禁止 DDL / USE。
-- BEGIN / COMMIT 仍有整库快照传输与修改表比较成本，复测见 docs/performance.md。
+
+### 事务快照与冲突
+
+- SQL 工作行集仍整库物化，持久化行版本目录每次发布也会读取整库并写出文件。每会话一个事务，无嵌套事务，事务内禁止 DDL / USE；未提供按需版本读取和增量版本日志。
+- BEGIN / COMMIT 仍有快照传输和修改表比较成本。SERIALIZABLE 写事务按表复查读依赖，可能因不同行的变化发生保守冲突；未提供谓词锁或 SSI。长期快照阻止旧版本和退役文件回收，增加内存、磁盘与 I/O 成本。旧版本的内存回收随事务结束完成，磁盘版本文件在后续发布时收缩。
+
+### Web 编辑生命周期
+
 - Web 首次加载业务表即固定编辑快照，同一登录会话只允许一个页面持有编辑事务；系统身份表只读，通过 SQL 管理。
 - 页面关闭的回滚请求可能因断线未送达；此时按会话空闲 / 最长寿命过期清理，后台每分钟检查一次。编辑连接失效后必须重新登录，不能恢复旧快照。
-- COMMIT 按整数 id 校验写写冲突，缺少整数 id 时整表比对及替换；冲突返回 serialization_failure，调用方回滚或重试，无自动重试或死锁检测。
-- WAL 只有 redo，检查点按库 LSN 而非页 LSN，幂等恢复代价随数据量增长；库目录建删不走 WAL，删库用墓碑目录处理。
+
+### 提交与存储边界
+
+- 行锁和唯一键锁跨请求保留到事务结束，保存点回滚不提前释放锁。总锁等待上限为 5 秒，死锁或超时中止事务；调用方须 ROLLBACK 后重做业务检查，无自动重试。缺少可用整数 id 或旧重复 id 时，物理提交可能整表替换，但合并与冲突使用内部行编号。
+- 原始存储整表替换仍兼容旧重复 id；普通插入会在提交前拒绝 id 索引冲突。这不表示存储端已完整执行 SQL 的全部唯一性和类型约束，SQL 约束仍由引擎校验。
+
+### 恢复与锁
+
+- 逻辑 WAL 仍为 redo，逻辑重放范围按库检查点决定。页 LSN 与全页镜像用于修复撕裂页，不代表已经实现按页跳过任意逻辑操作；恢复需重建受影响表的派生索引，代价随数据量增长。库目录建删不走 WAL，删库用墓碑目录处理。
 - recovery_required 期间除 Ping / SystemStatus 外请求被拒绝，需恢复后继续。
-- 每库读共享、写独占，写入会阻塞同库跨表读取，尚无并行写。
+- 同库可并行准备不同行的修改；最终校验、WAL 发布和页刷盘仍按库串行。权限和 DDL 全局排序。管理员原始存储写入不取得 SQL 事务行锁，版本变化会使冲突的旧事务拒绝提交。未给出吞吐量或尾延迟保证。
 - 权限变更只标记 TCP 连接失效，客户端下一次请求收到 unauthorized 后关闭，空闲连接不会立即断开；并发测试不证明性能提升。
 
 ## 查询与性能
+
+### 行与索引容量
+
+- 堆行的 JSON 编码必须放入单页（默认 4096 字节，含页头与槽位开销），尚无长行溢出页；TEXT 不表示可存任意长度正文。普通提交组会在写 WAL 前拒绝超页行。
+- 标量索引键默认最多 128 字节，按页容量与分支数计算有效上限，密集旧配置可能仍只有 64 字节；字符串按 UTF-8 字节计数，普通写入与建索引在提交前拒绝超限。非索引文本仅受声明长度和整行容量限制；写入长键后不得降级到仅支持 64 字节的旧二进制。
+
+### 成本估算与统计
+
 - 基础成本及贪心连接重排，无动态规划或跨外连接重排；只在行序不可观察处重排。
 - catalog 行数可能滞后，distinct 有上限；16 桶等宽直方图只统计数值并按闭区间估算，增量维护可能偏差，桶内分布仍为估算。
 - 内存统计去重上限为 4096，暂不提供直方图或索引成本；派生表可从透明算子估计行数，含聚合或可能报错表达式时仍保守。投影下推保留所有计算项，不消除潜在错误。
+
+### 子查询与并行执行
+
 - 查询内物化只在内存保存结果，尚无容量预算或磁盘溢出；既有按绑定分组求值可能更早报告同一错误。
 - CTE 解析期展开，不支持递归、写语句或 MATERIALIZED / NOT MATERIALIZED 指定；不同优化子树不能共享物化。只能引用前面定义的 CTE，前向引用按普通表名解析。
 - 半连接重写尚未覆盖组合谓词、复杂相关条件、多键、相关聚合或排序截断；可能报错的相关投影继续走原执行路径。
 - 并行只覆盖页区间扫描：schema 至少 1000 行、最多 8 线程，无页内并行，统计滞后可退回顺序扫描。
-- compact 不填跨页空洞，含隐藏列时仍需整表重写。
+- 显式 compact 使用影子文件在线复制和 WAL 代次切换，但仍物化完整行集。最终追平与切换独占库门；并发变化较多时可能重写较长后缀，不能保证固定切换时延。中途失败的未发布代次在重启恢复后清理；启动隐藏列整理仍离线重写。
 
 ## 权限与兼容性
+
+### 旧数据与对象身份
+
+- 旧目录或历史行中的非法字段名不自动改名；原始扫描与旧 WAL 重放仍可用，但新写入或重写载荷须提供合法顶层字段名。迁移需显式整理字段，不能靠升级自动修正。
 - 对象权限快照整体写入，鉴权会读取身份、成员和对象元数据；尚未针对大规模权限目录做性能基准。
 - 对象高水位损坏或回退后无法恢复已删除对象的编号上限；旧二进制会丢弃新增目录字段，不应降级使用已升级的数据目录。
+
+### 权限功能与迁移
+
 - 无列级权限、所有权转移或角色 ADMIN OPTION。
 - 旧授权缺少授予来源，迁移为管理来源；旧全局 * 只绑定迁移时现存表。没有身份改名命令；已有同名 public 身份在删除前不会解析为虚拟 PUBLIC。
 - 尚无 CREATEDB / CREATEROLE、继承开关、口令到期、连接上限或 Web 专门的身份属性编辑界面。
@@ -33,24 +64,58 @@
 - 引导不重设已有口令、不提升已降权身份；类型定义冲突需人工解决。
 
 ## 类型与语义
+
+### 范式与类型能力
+
 - 范式分析最多 12 列；领域原子性和依赖完整性由用户声明，信息不足时不认证高阶范式。分解建议仅一轮，不保证子关系已达 BCNF；尚无自动迁移。
-- DOMAIN 无自身 CHECK / NOT NULL / DEFAULT、ALTER DOMAIN、CASCADE；尚无 ENUM 或用户定义复合类型。内置目录不能靠增加行扩展基础类型。
+- DOMAIN 尚无 CASCADE、改名、修改基础类型、NOT VALID 及显式事务内 DDL；ALTER DOMAIN 读取整库快照，尚无按依赖扫描或磁盘溢出；尚无 ENUM 或用户定义复合类型。内置目录不能靠增加行扩展基础类型。
 - DECIMAL 仍使用浮点表示，不是精确十进制存储；整数类型共用整数表示，CHAR 不补空格。
 - 少量接口设置仍用字符串类型名；Haskell 值语义和 Rust 索引键分开维护。旧 ColumnType / RelOp 仍是兼容桥，完整能力、转换及关系 IR 迁移待后续阶段。
+
+### 绑定与执行隔离
+
 - 多请求查询不提供整条查询的数据快照；旧目录无有效对象编号时无法证明历史对象身份。执行期外层行仍使用扁平布局，原始关系执行 API 仍允许名称引用；尚无独立作用域或来源编号。
-- 写入的存储操作分别取门，尚无整条语句的数据快照或数据冲突检测。来源/列缺少独立身份，不能视作完整写入 bound IR；建表、库及 DOMAIN 管理不在已有表写计划范围。
+- 引擎直接调用存储时，各次操作分别取门，尚无整条语句的数据快照或数据冲突检测。服务端会话已对数据写入及提交整体串行，但不提供自动提交语句在 I/O 失败后的整体回滚。来源/列缺少独立身份，不能视作完整写入 bound IR；建表、库及 DOMAIN 管理不在已有表写计划范围。
 - CHECK 仍以表达式文本持久化；RENAME COLUMN 不自动改写依赖 CHECK，引用旧列名时拒绝改名。普通原始存储 DDL 不具有 Haskell 的完整表达式语义校验。
-- 运行时类型尚无 Eq / Ord / Hash 等 capability 字典，不提供比较、排序、分组、极值、去重和索引；复合字段在 Web 通过 SQL 修改，没有结构化单元格编辑器。
+
+### 复合值与协议
+
+- 内建运行时类型已提供 Eq / Ord / Hash 能力，尚无用户注册的运算实现或复合索引键编码；运行时类型的索引、UNIQUE / PRIMARY KEY 仍拒绝。复合字段在 Web 通过 SQL 修改，没有结构化单元格编辑器。
 - 运行时协议使用版本 1，旧客户端不支持新增类型化值；Web 的 JSON 数值仍受 JavaScript 安全整数范围限制。
 - 派生表输出取裸列名，重复名称报错；未定型 NULL 仅用于查询类型推导，不可声明为存储列类型。
 
 ## 构建、发行与安全
+
+### 离线维护
+
 - 离线 recover 依赖完整可用 WAL，不能保证修复损坏数据页或已截断的历史；未知系统表缺少结构时需备份或 reset。目录计数器损坏后无法还原已删除身份编号上限。
 - 旧版进程不支持数据目录独占锁；维护前必须停止所有相关进程。
+
+### 本机认证与平台验收
+
 - sudo 本机认证需提升身份启动 server；当前只映射 Unix root / Windows 提升 Administrators 到一个显式配置身份，无任意 OS 用户映射或自动提权。异常退出留下的端口凭据目录须在确认停止后手工清理。
 - sudo 的 Windows 提升成功路径、macOS 编译运行及 Linux 完整提升 server/CLI 链路仍待目标平台实机验收；Debian/WSL 已验证原生凭据安全边界。
+
+### 构建与发行
+
 - 直接构建独立 Stack 工程时可能复用旧注册库，必要时使用 --force-dirty 或全量门禁 -Full；Haskell 构建须串行。
 - 存储协议变化后必须重建实际 cdylib，开发环境须配置 PATH / LD_LIBRARY_PATH；旧命名构建工件仍可能残留。
 - 真实 server 测试须先引导并能找到 bootstrap；注释检查对部分多行语法可能误报。
 - GitHub 在线安装、Linux $ORIGIN 与 macOS 发布仍需实机验证；无 Release 时在线安装无法取得预编译资源。
 - SHA256 只能检测损坏，无发布签名；外部采集仍可能记录 SQL 原文。旧 CLI 历史不自动清理，任意业务字符串中的敏感数据不自动识别。
+
+### 容器验收范围
+
+- 容器仅验收 Linux amd64、本次工作区源码镜像及本机已有 ChuBlog 数据库镜像的升级；五分钟负载与 SIGKILL / 检查点 ENOSPC 回归不替代生产长期稳定性、真实断电或任意版本升级验证。
+- 部分 Docker 代理的镜像源模式会返回 502，可显式设置 BASE_REGISTRY；构建器不自动继承 Engine 的镜像源。WSL 曾退出但原因未确认，仍须限额构建，或在构建机生成后导入。
+
+## 博客接入边界
+
+- examples/blog 提供数据库 schema、旧文件字段映射及真实驱动验收，不修改 ChuBlog 当前文件账户实现。生产账户迁移、HTTP / SSH 授权、会话与查阅凭据版本检查、哈希升级、限流、匿名身份合并及文件访问控制仍由 ChuBlog 配套实现。数据库或身份查询失败时应用必须拒绝受保护访问。
+- 博客关联尚无数据库外键；双方写入及物理删除需采用 SERIALIZABLE 事务检查存在性和关联明细。评论按字数、UTF-8 字节、请求体和配额限制，整行仍须适配页容量，不提供长行 / 溢出存储。
+- 本阶段没有重建 Docker 镜像；已验收镜像仍对应 progress.txt 中的可靠性阶段版本，不含当前事务及长键改动。腾讯云内网 Debian 源仅按要求修改，未执行网络或构建验证。
+
+### 页格式与升级边界
+
+- 新增 .pages（版本 1 页 LSN / 写序号）、.page-wal（CPW1 全页镜像）及临时 .pages.pending。停机备份和迁移必须复制整个数据目录，不得只复制 .db / .idx；首次写入页版本后禁止旧二进制写该目录。
+- 全页镜像可修复镜像已完整同步后的撕裂写；可检测到的镜像或页元数据格式损坏会报错，不能检测或修复任意介质损坏。不提供真实断电、文件系统或硬件缓存丢失的保证。

.agents/context/main-roadmap.txt

@@ -1,20 +1,29 @@
-ChuSQL 长期路线图
+# ChuSQL 长期路线图
 
 交付状态和验收只以 progress.txt 为准；近期顺序见 side-branch-plan.txt。
 本文件描述目标，不代表现有实现或功能承诺。
 
-目标链路：SQL → Parser / Binder → Typed IR → Planner / Optimizer → Executor → Rust Storage。
+目标链路：SQL → 解析与绑定 → 类型化中间表示 → 规划与优化 → 执行 → Rust 存储。
+
+类型化中间表示（Typed IR）是已经确定类型与引用关系的查询结构；能力（Capability）描述类型支持的运算。代数数据类型（ADT）用于表达多个可选构造分支，多版本并发控制（MVCC）用于管理数据版本和读取快照。
+
 类型能力与权限保持独立；catalog 保存对象、依赖和语义，内核保留必要基础机制。
 
-阶段
-- A 类型与函数基础：稳定 TypeId / FunctionId、注册表、逻辑/物理类型分离、版本化值；验收见 progress.txt。
-- B 能力与运算（2–6）：Capability、Operator、Cast、Aggregate、参数多态与约束解析。
-- C 复合与自定义类型（7–12）：ADT、Record/Composite、Newtype/Domain、参数化类型、Range、用户类型。
-- D 函数与效果（13–16）：用户函数、Effect、纯 Generated Column、有副作用的 Trigger。
-- E 权限与类型化查询（17–19）：权限 Capability、Query a、Rewrite / Optimizer 函数化。
-- F 扩展：对象体系统一后实现 Extension 的版本、依赖、安装/升级/移除；其他访问方法按真实需求推进。
+## 阶段目标
+
+按以下阶段推进；括号中的编号沿用原路线图：
+
+| 阶段 | 目标 |
+| --- | --- |
+| A 类型与函数基础 | 稳定 TypeId / FunctionId、注册表、逻辑/物理类型分离、版本化值；验收见 progress.txt。 |
+| B 能力与运算（2–6） | 类型能力、运算符、类型转换、聚合，以及参数多态与约束解析。 |
+| C 复合与自定义类型（7–12） | 代数数据类型、记录/复合类型、命名类型/领域、参数化类型、范围和用户类型。 |
+| D 函数与效果（13–16） | 用户函数、效果管理、纯计算生成列和有副作用的触发器。 |
+| E 权限与类型化查询（17–19） | 权限能力、类型化查询 Query a，以及查询重写与优化器的函数化。 |
+| F 扩展 | 对象体系统一后实现 Extension 的版本、依赖、安装/升级/移除；其他访问方法按真实需求推进。 |
+
+## 贯穿约束
 
-贯穿约束
 - 现有 ColumnType / Expr / RelOp 有真实消费者；迁移时逐步收拢，不提前删除兼容桥。
 - 每阶段验证持久化、升级、依赖和恢复，不能靠重新初始化掩盖不兼容。
 - 内建对象可由可信 bootstrap 元数据恢复；用户对象依赖 WAL / 备份。

.agents/context/progress.txt

@@ -1,9 +1,11 @@
-ChuSQL 已完成事项
-更新：2026-10-13
+# ChuSQL 已完成事项
+更新：2026-10-16
 
 本文件是当前完成状态及最新验收的唯一来源，等价于 project-plan.txt；不保留历史批次、提交记录或修改流水。
 设计见 design-decisions.txt，未解决限制见 known-issues.txt，后续计划见 side-branch-plan.txt。
 
+近期第一阶段“数据库可靠性与部署验收”、第二阶段“博客业务持久化与驱动联调”及第三阶段“存储并发与恢复扩展”已完成数据库侧本地验收。第三阶段包括持久化行版本、行与唯一键锁、死锁与锁等待取消、同库并行数据准备、在线文件代次迁移，以及页 LSN / 全页镜像恢复。整库物化、串行最终提交和切换窗口的成本见 known-issues.txt。ChuBlog 实际业务接入、生产文件迁移、长期运行及真实断电仍保留配套边界。
+
 ## SQL 与查询执行
 
 - 实现 CRUD、表列约束、索引、INNER / LEFT JOIN、聚合、GROUP BY、HAVING、ORDER BY、LIMIT、投影别名、DISTINCT / ALL；排序支持输出序号、表达式、函数、聚合及子查询。
@@ -12,30 +14,116 @@ ChuSQL 已完成事项
 
 ## 类型与绑定
 
+### 类型表示与 DOMAIN
+
 - 建立固定类型 / 函数编号、TypeId / TypeExpr / Kind、逻辑与物理类型、版本化复合值编码；支持 Int / Double / Bool / String / List / Maybe / Tuple、length / not，接入 SQL、存储、CLI 和 Web。
-- 实现 CREATE / DROP / SHOW DOMAIN、库内嵌套定义、列引用、依赖与循环校验及持久化；查询输出保留 DOMAIN 身份。
+- 内建类型描述提供 Eq / Ord / Hash 能力，List / Maybe / Tuple 根据参数递归派生，DOMAIN 沿用基础能力。复合值支持结构比较、排序、JOIN、IN / ANY / ALL、分组、去重及 MIN / MAX；完整身份不隐式转换，保留 SQL NULL / Nothing、稳定排序及正负零的相等哈希一致性。索引与唯一键边界见 known-issues.txt。
+- 实现 CREATE / ALTER / DROP / SHOW DOMAIN、库内嵌套定义、列引用、依赖与循环校验及持久化；支持领域 DEFAULT / NOT NULL / 多条具名或匿名 CHECK、约束继承、默认值优先级与旧数据校验，查询输出保留 DOMAIN 身份。
+
+### 查询与写入绑定
+
 - 查询使用 BoundQuery；表达式、投影、连接、排序和分组按 schema 槽位绑定，存储返回行按布局整理，缺列和位置失配明确失败。
 - 相关列按最近到最远的独立词法作用域解析，局部 / 外层槽位分离；重绑定保留有效位置，失配仅允许唯一同名列重定位。子查询取值与缓存共享槽位绑定。
 - DML 使用可复用 BoundWrite，预绑定 INSERT 输入、UPDATE 目标、DELETE 布局及 CHECK / 非空 / 唯一性约束；保留默认值、自增、逐项赋值和未命中行不求值，唯一性按最终行集判断，失败不发布修改。
+
+### 依赖复查与约束发布
+
 - 查询与已有表写计划保存对象身份、schema 版本、列定义及传递 DOMAIN 依赖；执行前及实际存储操作锁内复查。写前握手拒绝不支持守卫的存储，跨库按名称排序取门；数据、统计和无关结构变化不使计划失效。
+- ALTER DOMAIN 校验一致整库快照，并在存储写门内复查库身份和提交点后通过既有结构 WAL 发布；并发提交返回 serialization_failure。依赖领域的建表及领域创建使用结构守卫，事务提交复查修改表及传递领域依赖。
 - CHECK 定义与执行共用类型及槽位绑定；建表、加列和结构变更校验条件、默认值与键能力，空表不跳过，失效引用明确拒绝。
 
 ## 存储与事务
 
+- SQL 查询与数据写语句使用存储事务；同库不同行可以并行准备，行锁等待不占库提交门。最终权限 / 对象 / 约束校验与 WAL 发布仍串行；权限与 DDL 全局独占。真实 TCP 验证不同行合并提交、旧快照读取、死锁返回和断线释放行锁。
+
 - 实现页、堆表、B+Tree、catalog、WAL、LSN 检查点、已提交组幂等恢复及页内 compact；持久化对象编号、高水位和 schema 版本，失败进入 recovery_required。
-- 实现按连接隔离工作库、整库快照事务、写写冲突检查、保存点和差分提交；权限及对象身份在事务提交时复查。
+- 实现按连接隔离工作库、持久化行版本快照、行级写写冲突检查、保存点和合并提交；权限及对象身份在事务提交时复查。COMMIT 在发布前复用引擎规则校验合并最终行集，拒绝不同整数主键形成的 UNIQUE 冲突，失败不发布其他表修改。
+- 支持 BEGIN [TRANSACTION] ISOLATION LEVEL SERIALIZABLE 及 START TRANSACTION ISOLATION LEVEL SERIALIZABLE，写事务提交按表复查全部读依赖的 schema 和数据，包含子查询和幻行；保存点回退恢复读依赖，只读快照可完成，默认 BEGIN 保留不同行合并行为。
+
+### 提交前校验
+
+- 普通 WAL 提交组在落盘前复用堆行与索引键编码检查行大小及有效索引键长度，覆盖单行 / 批量插入、整表替换、事务、结构替换及整理；超限输入不改变数据、索引、catalog、WAL 或检查点，不触发 recovery_required。
+
+  建索引先校验已有值，结构替换按实际保留的索引校验；堆表直接写入与整表替换也在修改前拒绝超限键。
+- 新插入 id 的冲突在普通 WAL 提交前按操作顺序预检，覆盖单行、批量及跨表事务；复用实际键编码，按需点查并缓存键计数，支持先删除再插入及整表替换。保留 NULL / 缺失 id、旧重复 id 与重复删除键只删除首行一次的兼容行为。
+- 普通写入可能扩列时，在提交前按操作顺序复用 catalog 规则预演列推导和 schema 版本递增；结构替换及整理的载荷行参与预演。版本耗尽不发布数据或日志修改；同一行多列只递增一次，未定型 NULL 不扩列，版本上限不阻断无需结构变化的数据写入。
+- 存储协议的表名、列定义及写入行顶层字段名共用名称规则；单行、批量、整表替换、结构替换和事务载荷在处理请求时拒绝非法字段名。值内部键和文本不受字段名校验影响，旧数据扫描与已提交旧 WAL 重放保持兼容。
+
+### Web 编辑事务
+
 - Web 编辑使用独立连接与页面绑定，支持跨表原子提交、保存点重放、提交去重、冲突重载、SQL 标签隔离及退出清理。
 
 ## 身份、工具与发行
 
 - 用户与角色统一名称空间，支持 LOGIN / SUPERUSER / ENABLED、稳定编号、角色继承、迁移及删除清理；权限变更使受影响会话失效。
 - 实现对象所有权、grant option、DATABASE CONNECT / CREATE、表级数据权限及 PUBLIC、SHOW GRANTS、REVOKE GRANT OPTION FOR 和失效授权级联清理。
+
+### 认证、工具与发行
+
 - 实现默认关闭的本机 sudo 身份映射、受保护凭据、回环校验与一次性 HMAC 挑战；已验证 Windows 非提升拒绝及 Debian/WSL root 凭据安全边界。
 - 范式检查通过 Haskell / TCP / CLI / Web 提供只读分析，依据 schema 与声明检查 1NF / 2NF / 3NF / BCNF，输出违反依赖、一次无损分解及依赖保持结果。
 - 引导初始化 system、默认 root 与 18 个内置类型，重复引导保留口令并拒绝冲突；实现 system_catalog_manager 及 bootstrap repair / recover / reset。
 - 统一监听、数据 / 日志目录与配置模板；完成 Windows 分组件打包安装冒烟、管道口令兼容、敏感 SQL 诊断 / 历史脱敏及 UTF-8 构建。发行与平台未验收事项见 known-issues.txt。
 
+## 容器部署
+
+- 提供多阶段 Dockerfile、默认数据库与可选 Web 的 Compose 配置、非 root 服务、文件口令、幂等引导、数据 / 日志 / Web 偏好卷、协议健康检查和停机备份说明。
+- 构建按单任务执行，GHC 构建堆上限 1536 MiB；运行服务各限制 1 核和 512 MiB，文档提供 3 GiB 上限的 Buildx 构建器及异机构建导入方式。
+
 ## 最新验证
 
-- 全量门禁通过：Rust 191 / Engine 598 / Server 163 / Web 80 / CLI 20 / Bootstrap 9，均零失败；动态库重建、Clippy、注释检查及 git diff --check 通过；受影响 HLint 仅保留既有惰性相关建议。
-- 验收入口：gate-check/run-gate.ps1；最新日志：logs/empty-in-gate.log。局部改动验证受影响模块，较大改动执行全量门禁；当前工作区改动未提交。
+### 门禁结果
+
+- 全量门禁通过：Rust 221 / Engine 619 / Server 177 / Web 80 / CLI 20 / Bootstrap 9，均零失败；release 动态库重建、Clippy、注释检查及 git diff --check 通过。
+
+  受影响 Haskell 源码与测试 HLint 无建议；Fourmolu 格式及幂等检查通过。
+
+### 存储回归
+
+- 回归验证超页行与超长索引键在提交前拒绝，失败后文件不变且可继续读写和重启；覆盖 UTF-8 字节边界、NULL、建索引失败与移除索引后的结构替换。真实 TCP 验证超限 SQL 写入后仍可查询与写入。
+- 重复 id 回归验证单行 / 批内 / 跨操作冲突均不改变持久文件，事务早先的跨表修改不发布；合法删除再插入可提交并重启点查。验证整值浮点等键、NULL / 缺失 id 及旧重复 id 的删除顺序；真实 TCP 验证重复 id SQL 插入报错后仍可查询和合法写入。
+- 扩列回归验证单行、批量、整表替换、结构替换及事务在 schema 版本耗尽前拒绝，失败后持久文件不变，原表可读、合法写入及重启正常；同一行多列与未定型 NULL 的版本行为保持一致。
+- 非法字段名回归覆盖六种写入路径，空名、路径字符、点号、空白、非 ASCII 字符和 NUL 均在写入前拒绝且文件不变；合法文本及嵌套对象可重启读取，旧式字段名的已提交日志仍可重放并继续合法写入。
+- 验收入口：gate-check/run-gate.ps1；最新日志：logs/mvcc-stage-gate-final.log，真实 TCP 日志：logs/id-preflight-tcp.log。当前工作区改动未提交。
+
+### DOMAIN 回归
+
+- DOMAIN 回归覆盖继承默认值、显式 NULL、UNKNOWN、非空、多条约束及命名、空表定义校验、加列 / 改类型、旧行与依赖默认值拒绝、绑定失效、真实 FFI 重启与并发插入冲突；Rust 验证发布失败不改持久文件、结构版本递增及已提交日志重复恢复，Server 验证管理员权限、事务 DDL 禁止和领域变更后的旧事务提交拒绝。
+
+### 复合值运算回归
+
+- 覆盖数字与前缀排序、可选值和元组顺序、嵌套 Eq / Ord / Hash 一致性、NULL / Nothing、空容器身份、非有限数拒绝、分组 / 去重 / 极值、连接 / 成员 / 相关存在与量词比较；真实 FFI 验证重启后的复合 DOMAIN、隐式 id 索引回退、修改和删除，Web 经 HTTP / TCP 验证结构值比较、排序和分组。值与类型编码保持版本 1。
+
+### Docker 验证
+
+- 完整多阶段源码镜像构建通过，Rust / Haskell / 运行阶段均为固定 digest 的 Bookworm 镜像；本地验收镜像为 chusql:local，ID / 仓库摘要为 sha256:4b22ced1f95c80c6904a5c794acac02d141b3e1dc91a619692c07dc020fcc720。构建器限制 1 核 / 3 GiB、无额外交换空间，GHC 堆上限 1536 MiB；构建完成后已停止构建器。
+- 默认与 Web profile 的 Compose 配置、TOML、脚本语法、入口与健康检查错误分支通过；独立 Compose 项目验证固定镜像、首次引导、非 root 卷权限、TCP / HTTP 健康检查、CLI、Web 登录、1 核 / 512 MiB / 128 进程限制及无额外交换空间。
+- docker/test-runtime.py 在真实源码镜像上完成 300 秒、三个会话并发负载：1696 次成功提交、2415 次明确冲突；SIGKILL 恢复后 1701 个关联事务完整，全部已确认提交保留，未提交数据丢弃。
+- 用容器内 16 MiB 临时文件系统制造检查点 ENOSPC，验证 WAL 已提交后的错误、业务请求封闭、日志保留、重启幂等重放及恢复后写入；不填满宿主磁盘。验证重复引导不覆盖原口令，停机备份恢复到空卷后业务行、账号和只读授权保留。
+- 本机已有 ChuBlog 镜像 sha256:afd2394af5606169b7dbf5b08f4e30fe0521fe47b0b6fbd7c53a67154388c354 的测试数据，在停机并将卷所有者从 10003 调整为 10001 后，可用本次镜像打开、保留原口令并继续写入；不据此承诺任意版本升级兼容。
+- ChuBlog 当前固定 Rust 驱动的 2 项单元测试与 4 项协议测试通过，覆盖错误码、断线、超时、取消及响应大小；真实 TCP 示例完成 Unicode / 布尔值 CRUD 与结果映射。博客业务数据库侧验收见下节；ChuBlog 生产文件迁移仍需配套实现。
+- 日志为 logs/docker-source-build.log、logs/docker-runtime-acceptance.log、logs/docker-integration-check.log、logs/docker-upgrade-check.log 和 logs/blog-driver-tests.log。全部测试容器、网络及测试卷已清理；本次未改动 ChuBlog 源码。
+
+### 博客业务与驱动验收
+
+- examples/blog/schema.sql 与 acceptance.rs 提供账户、完整 Argon2id PHC、角色 CHECK、发布路径 / SSH 公钥、文章权威状态、评论、互动、计数、审计及迁移标记的模型和实际 Rust 驱动验收；正文不入库，可重建索引独立。
+- 实际驱动验证旧 reader / publisher / admin 及禁用账号映射，完整 PHC 原样保存、参数与盐保留且可验证原口令；独立盐产生不同哈希，错误口令拒绝。迁移输入缺失授权时拒绝，同一来源重复迁移不重复写入。该验收使用构造的旧文件副本，不读取或迁移生产账户。
+- 验证不同主键并发注册仍只有一个用户名、跨表失败不部分发布、撤权后的旧读事务拒绝、文章删除与并发评论冲突、点赞 / 收藏并发计数、去重与重复取消、负数拒绝、匿名 / 登录评论关联、同时间游标分页、可见评论聚合 / 重算及超页评论拒绝后继续读写。
+- 验证文章查阅口令完整 PHC、撤销版本及管理审计持久化，文章索引重建不覆盖隐藏 / 删除 / 精华等权威状态；仅获文章索引表权限的数据库账号不能读口令哈希或改管理状态，关闭连接后的查询明确失败。HTTP / SSH / 文件访问授权仍由博客实现。
+- 标量索引键默认支持 128 字节，实际上限按页容量及分支数计算；真实驱动验证 113 字节文章键，Rust 回归覆盖 128 字节键跨页 / 重启、旧 64 字节头无写打开及首次长键升级、密集旧配置边界与超限写前拒绝。无正文或长行存储改动。
+- examples/blog/test-business.py 以真实本机服务和 ChuBlog 固定 Rust 驱动完成 seed、重启 verify 及停机备份副本 verify，账户哈希、授权版本、评论、互动计数及审计均保留；临时业务目录和副本自动清理。日志为 logs/blog-business-driver.log。
+- Dockerfile 的 Debian 源改为 http://mirrors.tencentyun.com，按用户要求未验证或重建镜像；既有 Docker 验收结果只适用于上节固定镜像。接入方式及应用边界见 docs/blog-database.md。
+
+### 行版本、并发与在线迁移
+
+- 持久化 mvcc.json 记录格式版本、提交序号、不复用行编号、可见起止序号、内容版本与逻辑行序。默认快照隔离与自身修改可见，SERIALIZABLE 写事务按表复查读依赖；旧目录首次事务或写入前导入，原堆页格式不变。堆 / 索引同步后原子发布版本目录，再推进检查点；重启重放幂等发布，版本超前于可恢复 WAL 时拒绝打开。
+- 行锁和旧 / 新唯一值锁跨请求持有，NULL 不争用唯一值锁。等待图检测环、5 秒总等待超时、显式取消与存储恢复封闭均可释放或唤醒等待者；deadlock_detected、lock_timeout 和 serialization_failure 保留结构化错误码。保存点回滚同步最终计划与读依赖，锁保留到事务结束；断线和重新认证清理旧事务。
+- 同库数据准备共享执行门，最终校验和 WAL 发布使用短提交门；其他库可独立推进。内部行编号用于合并与冲突，内容版本避免其他行位置移动造成伪冲突；整数 id 可增量物理写入，其余情况保留整表写入兼容。事务结束回收内存旧版本，后续发布回收磁盘版本；原始管理员写入通过发布版本参与冲突检查。
+- database_snapshot 保留完整结构 / 数据与提交点返回、相同令牌 snapshot_unchanged 及最近一个库的缓存；SQL 事务另行登记快照存活期，不依赖缓存保留旧版本。工作行集仍整库物化，不宣称按需版本索引扫描或增量版本日志。
+- 页与索引页写入前同步 CPW1 全页镜像，数据同步后发布版本 1 的 .pages 元数据，再清理 .page-wal。页 LSN 关联逻辑 WAL 提交点，独立写序号区分同一提交内多次页写；旧无元数据页文件按既有格式打开，首次写入建立元数据。
+- 回归验证撕裂数据页修复、重复打开幂等、未完整尾帧丢弃、完整镜像校验失败保留材料、截断后旧页不复活、镜像 I/O 失败后禁止继续刷新，以及小缓存淘汰时镜像量不随缓存页数重复放大。页大小、堆和索引页内布局未变；备份须保留整个目录，新版写入后不得降级旧二进制。
+- 逻辑恢复在重放已提交组前重建受影响的派生索引，整表日志直接重写，残缺索引根不再阻断恢复。账号初始化与变更也使用带提交标记、检查点和页 LSN 的普通提交组；旧账号 WAL 仍可恢复。文件删除和改名同步处理页元数据与镜像，并传播发布路径 I/O 错误。
+- 显式 compact 在线复制影子堆与全部索引，最终写门内追平并发修改，经 Migrate WAL 切换 catalog.file_generation，逻辑对象与结构版本保持不变。旧快照保留退役文件，结束后回收；重启恢复后清理孤立代次。固定并发窗口验证复制期间删除、更新、新增和行序保持；验证提交切换日志后、发布 catalog 前的中断可幂等恢复。启动隐藏列整理保留离线兼容路径。
+- 版本与锁专项验证不同行合并、等待后旧版本拒绝、死锁中止、锁超时、等待取消、旧版本引用回收、SERIALIZABLE 幻行拒绝和重启读取。在线整理回归验证文件缩小、隐藏字节回收、旧快照结束前旧文件保留及重启索引点查。
+- 实际 ChuBlog Rust 驱动业务验收后连续提交关联明细与计数，收到十次回执后强杀一次性服务；重启保留全部十次已确认提交，明细 / 计数一致，停机备份副本再次通过。日志为 logs/mvcc-driver-final.log；不据此承诺真实断电或任意介质损坏恢复。
+- 本阶段源码动态库、全量门禁、补充 Rust 回归、实际驱动业务 / 并发 / 强杀恢复、HLint、Fourmolu 与差异空白检查通过；日志为 logs/mvcc-stage-gate-final.log、logs/mvcc-lifecycle.log、logs/mvcc-hlint.log。未重建 Docker 镜像，ChuBlog 实现未修改。

.agents/context/side-branch-plan.txt

@@ -1,16 +1,69 @@
-ChuSQL 近期任务与依赖
+# ChuSQL 近期任务与依赖
 
-实现、测试及门禁状态只以 progress.txt 为准；设计见 design-decisions.txt，限制见 known-issues.txt。
-下列顺序是规划，不是已完成能力；每批按实际进度选择任务。
+本计划帮助开发者按个人博客落地所需的顺序推进数据库。实现、测试及门禁状态只以 progress.txt 为准；设计见 design-decisions.txt，限制见 known-issues.txt。
+下列顺序是规划，不是已完成能力；按大阶段交付，阶段内运行受影响模块测试，较大改动完成后运行全量门禁。
 
-1. 统一绑定与类型系统：完成多级作用域、来源/列身份、写语句和约束绑定，收拢旧兼容桥；完善 DOMAIN 约束与 ALTER DOMAIN、精确 DECIMAL、复合类型 Eq / Ord / Hash，再推进 ENUM / 用户复合类型 / ADT。统一写入、导入、事务提交与 Rust 索引语义，保留 nullable、错误时序和布局语义；明确整数范围、CHAR、旧目录身份升级及数据迁移。已有 schema 版本和读取守卫的验收见 progress.txt。
-2. 查询语言与执行优化：推进递归 CTE 和写入型 CTE，扩展复杂条件去相关，完善物化内存预算及磁盘溢出，合并连接搜索、外连接变换及统计成本改进；写入型 CTE 依赖统一写入校验。优化保持行序、重复、错误时序及来源解析规则。
-3. 原子结构变更与范式迁移：将库建删、DDL、对象依赖及版本复查纳入原子发布和恢复，维护绑定失效、权限、回滚与编号高水位；在对象目录、DOMAIN 约束及结构事务基础上支持 CASCADE 和范式自动迁移，发布前验证旧数据与嵌套依赖。迁移首版保留来源，拒绝 NULL、重复行及依赖不保持，后续推进多轮分解。
-4. 存储并发与恢复：推进 MVCC、死锁检测和并行写，完善页 LSN、恢复、跨页整理及隐藏列重写。保留幂等、隔离、句柄生命周期、行序与资源预算，以实测决定并行扩展。
-5. 权限与客户端能力：完善列级权限、所有权转移、ADMIN OPTION 和身份属性；统一 Web 复合值编辑、大整数及多页面事务的交互与会话约束。按真实需求选择实施范围。
+## 1. 数据库可靠性与部署验收
+
+以 ChuBlog 最新 TODO.md 的优先级为准；其 PLAN.md 保留原始规划，不能据此排除账户、评论、互动或内部文章需求。先验证现有数据库和驱动，再承接不可重建的业务数据。
+
+完成现有多阶段 Dockerfile 的完整源码镜像构建，在受限 Buildx 或异机构建后导入，避免在 WSL 无限制并行编译。验证该镜像的首次引导、非 root 运行、健康检查、卷权限、重启持久化、升级及备份恢复，并固定通过验收的版本与镜像 digest。
+
+在实际镜像上执行持续负载、并发冲突、进程崩溃、磁盘满及提交失败恢复验证，区分已确认提交、失败和断线后提交结果未知。验证驱动连接、超时、错误传播及回滚行为；未知提交结果不能直接重试非幂等操作。先处理发现的数据一致性缺陷，不要求先实现完整 MVCC。
+
+在副本演练备份恢复，区分可从 Git 重建的文章索引与必须恢复的业务数据。域名、公网证书、SSH 发布、Git 硬配额和整站加密备份属于 ChuBlog 部署工作，数据库阶段提供相应验证支持，不替代整站验收。
+
+## 2. 博客业务持久化与驱动联调
+
+覆盖用户、Argon2id 密码哈希及参数、角色、发布授权和迁移；支持 BANNED / MEMBER / AUTHOR / MASTER 所需的业务数据。角色继承、文章所有权及撤权后的会话 / SSH 发布失效由博客服务端落实，不要求为每名读者创建数据库身份。ENUM 先评估驱动兼容性，可用现有标量字段及 CHECK 约束交付，不作为默认前置条件。
+
+核对实际字段、SQL 和协议需求，验证并发注册唯一性、业务关联写入及权限变更的原子性。现有多请求写语句缺少整条语句的数据快照与冲突检查，须验证显式事务能否满足这些场景，并补齐必要的数据库或驱动缺口；不能把单次存储操作持锁等同于整条 SQL 原子性。
+
+保存内部文章可见性、查阅口令的加盐慢哈希及授权撤销版本、站长隐藏 / 删除 / 精华状态和管理审计。将这些权威业务状态与可重建文章索引分开，验证作者再次推送、索引重建或恢复不会覆盖站长管理决定；数据库或身份查询失败时拒绝受保护访问。哈希计算、限流及正文 / 资源访问控制由博客实现。
+
+验证评论的作者 / 文章关联、时间、管理状态、分页和必要索引，以及匿名 / 登录身份关联、重复提交与点赞 / 收藏去重所需的持久数据。并发新增、取消、删除及计数更新须保持约定的一致性，避免重复计数、丢失更新和负数；热度权重、时间衰减、防刷及保留规则由博客定义，数据库验证聚合、排序和重算所需能力。按实际查询检查稳定分页、可见性过滤与资源消耗。
+
+正文和资源落盘为文件，不存入数据库；长行 / 溢出存储不属于博客需求。评论虽然入库，也不据此引入长行支持：由博客明确字数、UTF-8 字节数、请求体和累计配额，数据库按实际整行编码验证容量。按实际索引字段验证 64 字节键限制，只有实际超限时才补所需标量长键支持，不截断或静默丢值。
+
+使用 ChuBlog 的 Rust 驱动完成上述数据库场景联调及账户迁移、业务备份恢复验证。博客实现和旧文件迁移属于 ChuBlog 的配套工作，修改该仓库前遵循其开发约束；前两个阶段完成表示数据库满足已验收的博客场景，不代表博客前端、审核或所有后续功能已完成。
+
+## 3. 存储并发与恢复扩展
+
+本阶段范围为持久化行版本、快照引用与回收、行锁和唯一键锁、等待 / 取消与死锁、同库并行准备、连续 WAL 发布，以及影子文件在线迁移与恢复。实现和验收状态只见 progress.txt。
+
+后续性能工作根据实测减少整库物化、版本文件写放大和最终切换窗口，保留隔离、行序、句柄生命周期和恢复约束；不把这些优化混同于未完成基础并发能力。
+
+## 4. 统一绑定与类型系统
+
+在已有多级词法作用域、查询和写入绑定基础上，完善独立来源 / 列身份及约束绑定，收拢旧兼容桥。
+
+在 DOMAIN 约束、ALTER DOMAIN 和内建复合类型 Eq / Ord / Hash 的基础上，推进精确 DECIMAL、复合索引键编码及用户运算实现，再推进枚举（ENUM）、用户复合类型和代数数据类型（ADT）。博客若采用 ENUM，须连同驱动映射另行验收，不作为账户持久化的默认依赖。
+
+统一写入、导入、事务提交与 Rust 索引语义，保留 nullable、错误时序和布局语义；明确整数范围、CHAR、旧目录身份升级及数据迁移。已有 schema 版本和读取守卫的验收见 progress.txt。
+
+## 5. 原子结构变更与范式迁移
+
+将库建删、DDL、对象依赖及版本复查纳入原子发布和恢复，维护绑定失效、权限、回滚与编号高水位。
+
+在对象目录、DOMAIN 约束及结构事务基础上支持 CASCADE 和范式自动迁移，发布前验证旧数据与嵌套依赖。
+
+迁移首版保留来源，拒绝 NULL、重复行及依赖不保持，后续推进多轮分解。
+
+## 6. 查询语言与执行优化
+
+推进递归 CTE 和写入型 CTE，扩展复杂条件去相关，完善物化内存预算及磁盘溢出，合并连接搜索、外连接变换及统计成本改进；写入型 CTE 依赖统一写入校验。
+
+优化保持行序、重复、错误时序及来源解析规则。博客基线查询若出现资源耗尽或性能问题，先按实测补必要预算或优化，不等待本阶段整体完成。
+
+## 7. 权限与客户端扩展
+
+完善数据库列级权限、所有权转移、ADMIN OPTION 和身份属性；统一 Web 复合值编辑、大整数及多页面事务的交互与会话约束。
+
+按真实需求选择实施范围。博客业务用户与角色由博客表及应用授权管理，不要求为每名读者创建数据库登录身份；现有数据库权限不足以隔离博客服务账号时，必要修复提前到博客业务联调阶段。
+
+## 持续验收
 
-持续验收
 - 局部改动通过受影响模块测试；较大改动由 agent 执行全量门禁，通过后再提交。模块测试不替代异常恢复、磁盘错误、持续负载及并发冲突演练。
-- sudo、在线安装、Linux $ORIGIN、macOS 构建发行与发布签名按目标平台验证，结果登记 progress.txt。
-- 升级明确账号/授权/配置迁移、禁止降级、旧历史和异常凭据清理；不承诺旧二进制兼容、损坏页自动修复或任意 OS 用户映射。
+- sudo、在线安装、Linux $ORIGIN、macOS 构建发行与发布签名按目标平台验证，结果登记 progress.txt；非博客部署目标的平台验收不阻塞博客接入。
+- 升级明确账号 / 授权 / 配置迁移、禁止降级、旧历史和异常凭据清理；不承诺旧二进制兼容、损坏页自动修复或任意 OS 用户映射。
 - Haskell 构建串行，存储协议变化重建实际动态库；门禁入口为 gate-check/run-gate.ps1。

.agents/skills/chusql-boundary-contracts/SKILL.md

@@ -5,14 +5,16 @@ description: 修改 ChuSQL Rust/Haskell FFI、客户端与 Server 协议、跨
 
 # ChuSQL 边界契约
 
-## Scope
+## 适用范围
 
 负责组件间表示、调用与生命周期。类型内容使用 chusql-type-system，落盘与恢复使用 chusql-storage-integrity，通用 unsafe 检查使用 rust-c-ffi-safety。路径相对仓库根目录，按变更读相关消费者。
 
-## Architecture
+## 模块与调用路径
 
 - CLI / Web 后端通过 `chusql-interface/src/ChuSQL/Interface/Link.hs` 连接 Server TCP；`Protocol.hs` 定义网络消息，`Session.hs` 提供客户端会话操作。
-- `chusql-server/src/ChuSQL/Server/TCP.hs` 分派消息，`Session.hs` 管登录 / 鉴权，`Backend.hs` 调引擎。浏览器通过 `chusql-web/src/ChuSQL/Web/API.hs` 的 HTTP API 访问 Web 后端，不直接访问 Rust。
+- `chusql-server/src/ChuSQL/Server/TCP.hs` 分派消息，`Session.hs` 管登录 / 鉴权，`Backend.hs` 调引擎。
+
+  浏览器通过 `chusql-web/src/ChuSQL/Web/API.hs` 的 HTTP API 访问 Web 后端，不直接访问 Rust。
 - `chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs` 将 MonadStorage 操作编码为 JSON，经 localStorageLink 调 FFI；IPC 名称不表示当前另起存储进程或 Socket 服务。
 - FFI 两端是 `chusql-core/engine/src/ChuSQL/Core/Engine/Storage/FFI.hs` 与 `chusql-core/storage/src/ffi.rs`，方向 Haskell → Rust，没有回调 ABI。
 - 存储 JSON 定义于 `chusql-core/model/src/ChuSQL/Core/Protocol.hs` 与 `chusql-core/storage/src/protocol.rs`；它与 Interface TCP 属于不同协议。
@@ -27,38 +29,49 @@ description: 修改 ChuSQL Rust/Haskell FFI、客户端与 Server 协议、跨
 | open | const char* → Storage* | NULL 路径用默认；失败 NULL，成功由 close 归还 |
 | close | Storage* → void | NULL 安全；非空句柄只关闭一次 |
 | request | const Storage*, const u8*, usize, u8**, usize* → i32 | 输入借用；输出由 Rust 分配；0 / -1 |
-| maintenance | const char*, const u8*, usize, u8**, usize* → i32 | 离线操作；响应 ownership 同 request |
+| maintenance | const char*, const u8*, usize, u8**, usize* → i32 | 离线操作；响应所有权同 request |
 | free | u8*, usize → void | 归还原始指针 / 长度对，不跨分配器、不重复释放 |
 | last_error | usize* → const u8* | 借用线程局部错误，立即复制、不释放 |
 
-## Invariants
+## 必须保持的不变量
+
+### 表示与指针
 
 - 路径为 NUL 结尾 UTF-8；请求 / 响应为显式长度 UTF-8 JSON，响应不保证 NUL 结尾，不能用 C 字符串函数读取。
 - Haskell request 使用 Ptr CChar、CSize、Ptr (Ptr CChar)、Ptr CSize 并返回 CInt，maintenance 以 CString 替代句柄。改签名同步两端与实际动态库。
-- 借用指针整个调用中有效，输出可写且不与输入或其他输出重叠。Rust 拒绝 NULL / 超过 isize::MAX 的请求长度，但不能验证非空指针的分配范围 / provenance；catch_unwind 不是非法指针保护。
+- 借用指针整个调用中有效，输出可写且不与输入或其他输出重叠。Rust 拒绝 NULL / 超过 isize::MAX 的请求长度，但不能验证非空指针的分配范围 / 来源合法性（provenance）；catch_unwind 不是非法指针保护。
+
+### 所有权与错误
+
 - 成功输出是 Box<[u8]> 转出的所有权；Haskell callStorage 复制后 finally 调 free，失败清空输出。保留取消屏蔽，避免复制 / 释放窗口泄漏。
 - open / request / maintenance 捕获 Rust panic，经 NULL / -1 和 last_error 返回；业务错误也可能是 ABI 成功响应中的 JSON error，两层失败都要处理。
 - close / free 捕获析构 panic 但没有状态返回，当前忽略捕获结果；不能依靠析构保证提交或宣称它报告落盘失败。
+
+### 线程与句柄
+
 - onStorageThread 在支持 bound threads 的 RTS 中绑定调用和错误读取到同一 OS 线程；last_error 缓冲只到本线程下次设置错误前有效。
 - Haskell open / close / request / maintenance 是 safe ccall，version / free / last_error 是 unsafe ccall；长 I/O 不改为 unsafe。请求期间不得关闭句柄。
 - IPC 的 withStorageLink 计数在途请求，closeConnection 等空闲再关闭；不绕过它更换 / 释放链路。Env 保存会话工作库，不把全局默认库当多连接状态。
+
+### 消息与消费者
+
 - Interface TCP 是一行 UTF-8 JSON，Hello 校验 protocolVersion=1；同一 Client 的 MVar 串行化请求 / 响应。Server 每连接建 Session 并限制行长度，客户端锁不是全局数据库锁。
 - SchemaColumn 字段、method / status 标签、缺省字段、错误码及 QueryResult columns / rows 的位置关系是消费者契约，不用自动派生构造器名替代稳定标签。
 - 复合值标签为 __chusql_runtime_v1，由 Core.Runtime 编解码；Rust 行仍是通用 JSON。封装变化检查 CLI / Web / 存储重载，Web 数值受 JavaScript 安全整数限制。
 - 原始存储透传仍经过 Server 会话鉴权；新入口核对 TCP 分派、会话策略与 Web 消费者，不绕过对象权限或业务错误。
 
-## Engineering Decisions
+## 实现取舍与边界
 
 优先扩展共享协议与真实调用者，不增加无用途适配层；确认无人依赖的内部接口可直接调整。新增类型化值沿 JSON 载荷传递，只有实际需要才扩展 ABI。
 Rust panic、Haskell IO 失败与业务错误按边界转成明确失败；当前没有自动 ABI 兼容协商或后台回调生命周期管理。
 
-## Validation
+## 验证入口
 
 - ABI / ownership 变更验证 `chusql-core/storage/tests/ffi_test.rs` 的成功、错误、长度、编码和释放路径；必要时用可用 Miri，不为普通消息变更强制安装工具。
 - 存储协议变化测试相关 Rust 模块并重建实际 cdylib，再串行验证受影响 Haskell 模块；rlib 或 mock 不能证明实际 FFI 可用。
 - TCP 改动验证 Hello、错误响应和真实消费者，复用 `chusql-server/test/Spec.hs`、`chusql-web/test/Spec.hs`、`chusql-cli/test/Spec.hs` 中相关行为。
 - 入口见 `gate-check/run-step.ps1`，测试范围按风险决定，不自动运行所有者全量门禁。
 
-## References
+## 相关资料
 
 Web 值展示 / SQL 生成消费者见 `chusql-web/static/core.js`；总体路径见 `docs/architecture.md`。核对协议时读两端编码 / 解码和调用者，不依赖绝对行号。

.agents/skills/chusql-storage-integrity/SKILL.md

@@ -5,49 +5,64 @@ description: 修改 ChuSQL 存储页、索引、序列化、catalog、系统元
 
 # ChuSQL 存储完整性
 
-## Scope
+## 适用范围
 
 负责持久化状态及其与服务端事务的关系。类型语义使用 chusql-type-system，接口生命周期使用 chusql-boundary-contracts；不照搬 PostgreSQL 内核设计。路径相对仓库根目录，只读受影响模块。
 
-## Architecture
+## 模块与调用路径
 
 - `chusql-core/storage/src/runtime.rs`：Storage 持有数据目录文件锁、管理数据库；Server 管每库 catalog、WAL、表缓存和读写门。
-- 数据根目录中 system/ 保存系统库，databases/<name>/ 保存业务库。每库有 catalog.json、<table>.db、内建 <table>.idx、其他 <table>.<column>.idx、wal.log 与 wal.checkpoint；诊断日志由 log_files 单独配置。
+- 数据根目录中 system/ 保存系统库，databases/<name>/ 保存业务库。
+
+  每库有 catalog.json、mvcc.json、<table>.db、内建 <table>.idx、其他 <table>.<column>.idx、wal.log 与 wal.checkpoint；非空 file_generation 使用 <table>.g<代次> 前缀；页文件另有 .pages、.page-wal 和可能残留的 .pages.pending，备份复制整个目录；诊断日志由 log_files 单独配置。
 - `chusql-core/storage/src/page.rs` 管定长页与缓存刷盘；`heap.rs` 管页内槽位、JSON 行、隐藏列和 compact；`btree.rs` 管变长字节键、重复键与叶子链范围扫描。
 - `chusql-core/storage/src/catalog.rs` 管 schema、索引、统计、隐藏列、对象编号 / 高水位；`protocol.rs` 定义线上 schema 和系统表常量。
+- `chusql-core/storage/src/mvcc.rs` 管持久化行版本、稳定行编号、快照引用、行 / 唯一键锁、等待图与回收。
 - `chusql-core/storage/src/wal.rs` 管 LSN、提交组、日志扫描与检查点；runtime.rs 的 group_via_wal、recover_wal、replay_op 连接记录与应用。
-- `chusql-server/src/ChuSQL/Server/Session.hs` 管会话快照、保存点、差分与冲突；`Backend.hs` 向存储提交操作。`chusql-bootstrap/` 调用 Storage::maintenance 与 maintenance_candidate 做离线维护。
+- `chusql-server/src/ChuSQL/Server/Session.hs` 管会话快照、保存点、差分与冲突；`Backend.hs` 向存储提交操作。
 
-## Invariants
+  `chusql-bootstrap/` 调用 Storage::maintenance 与 maintenance_candidate 做离线维护。
+
+## 必须保持的不变量
+
+### 目录与提交顺序
 
 - 表存在性以 catalog 为准，文件存在不表示已登记；不能靠打开文件创建逻辑表。语义与优化只读取 schema。
 - Catalog::save 写 pending 文件、同步后替换；单文件替换不等于 catalog、页与索引已整体原子提交。
-- 普通组先 append_group 落盘，再设置 recovery_required，然后应用、刷表、推进检查点、截断日志，全部成功才解除恢复状态。
+- 普通组先 append_group 落盘，再设置 recovery_required，然后应用、刷表、原子发布行版本目录、推进检查点、截断日志，全部成功才解除恢复状态。
 - 应用 / 刷盘 / 检查点 / 截断失败必须保持恢复状态并报错。普通业务请求被阻断；Ping / SystemStatus 例外由各自分派层处理，新增入口不得绕过状态。
 - 恢复仅重放检查点之后已提交组，保持 replay_op 幂等；不应用未提交组。现有 WAL 是 redo，检查点是库级 LSN，不是 undo 或页级恢复。
-- 账号引导 / 变更存在独立 WAL 路径，不能假定所有写入都走普通组函数。
+- 账号引导 / 变更已走普通带提交标记的组；旧账号 WAL 仍须兼容恢复，不删除既有解码和迁移规则。
+- 全页镜像先同步，再覆盖页文件；数据同步后发布页 LSN 元数据，最后清理镜像。镜像用独立写序号区分同一提交内的重复页写，错误后当前页句柄不得继续刷新。
+
+### 身份与生命周期
+
 - 库 / 表对象和身份编号依赖持久化高水位，删除后不复用；迁移不能降低计数器，不能从现存对象推断已删除编号上限。
 - 系统身份 / 凭据、角色、授权、类型与 DOMAIN 元数据保持对应关系。引导保留已有口令和降权状态，拒绝定义 / 保留文件冲突；类型目录不是可动态扩展基础类型的机制。
-- 数据目录锁覆盖存储和维护生命周期；维护前停止占用进程。每库读共享 / 写独占、表句柄加锁，不假定同库跨表并行写。
-- 会话事务是整库内存快照，无嵌套事务，事务内禁止 DDL / USE。提交跳过未修改表，整数 id 按键差分，否则整表比较 / 替换；对象身份和权限需复查，冲突返回 serialization_failure 并保留事务。
+- 数据目录锁覆盖存储和维护生命周期；维护前停止占用进程。同库行修改可并行准备，行锁等待不占提交门；最终 WAL 发布、页刷盘和版本发布仍串行，表句柄加锁。
+
+### 事务与格式
+
+- SQL 使用持久化行版本快照，工作行集仍整库物化，无嵌套事务，事务内禁止 DDL / USE。提交按内部行编号合并，整数 id 可差分物理写入，否则整表替换；对象身份、权限和最终约束需复查。行锁等待图中止环的新等待者，5 秒总等待超时；保存点回滚不释放已有锁。错误后调用方回滚，不能只重发 COMMIT。
 - 页内 compact 保留槽位编号与索引位置；隐藏列 compact 可能整表重写。布局、键编码、行序和隐藏列改动须检查真实消费者。
 - 页大小、B+Tree magic / 布局、槽位小端字段、JSON 行、WAL 标签 / 帧和 catalog 字段是格式契约。改变前明确加载、迁移或拒绝策略，不以重新初始化掩盖不兼容。
 
-## Engineering Decisions
+## 实现取舍与边界
 
 - 优化可减少分配或重复读取，但保留验证、刷盘顺序、错误传播与可观察行序。结构变更同时核对 WAL、应用、幂等恢复与 catalog 保存。
 - 数据库目录建删不走普通表 WAL，删库使用墓碑目录；不能承诺表提交组相同的崩溃原子性。
 - 离线维护在候选目录操作并保留备份；repair 不改既有表数据，recover 依赖可用 WAL，reset 重建系统目录且保留业务库。失败保留原目录 / 恢复材料。
-- 当前 Catalog::load 对不存在或空文件返回空目录，JSON 损坏报错；不能宣称所有损坏都会拒绝。rename_table_files 和部分析构 / 清理路径仍忽略 I/O 错误，不作为成功持久化保证。
-- 尚无行版本 MVCC、页级恢复、跨页填洞、并行写或通用结构迁移事务，不据此放松校验。
+- 当前 Catalog::load 对不存在或空文件返回空目录，JSON 损坏报错；不能宣称所有损坏都会拒绝。文件发布路径改名与删除须同时维护页侧文件并传播错误；部分析构 / 清理路径仍可能忽略 I/O 错误，不作为成功持久化保证。
+- 在线 compact 复制影子堆 / 索引，最终库写门内追平，经 Migrate WAL 切换 file_generation；影子文件先同步，catalog 再发布。快照结束后回收退役文件，启动先恢复再清理孤立代次。对象编号、schema 版本和逻辑行序不变；同名重建不能复用仍被快照保留的旧文件。
+- 行版本以提交 LSN 为可见序号，内容变化和行序变化分开；版本超前于可恢复 WAL 时拒绝打开。旧版本保留到最老活跃快照，不复用行编号。尚无通用结构迁移事务，不据此放松校验。
 
-## Validation
+## 验证入口
 
 - 按影响选择 `chusql-core/storage/tests/` 的 page / heap / btree / catalog / wal / runtime 测试；说明修正核对源码即可。
 - 格式 / 元数据 / WAL 改动验证重开、提交前后中断、重复恢复、缺失 / 截断 / 损坏输入与失败后状态；断言须检测实际不一致。
 - 会话差分 / 冲突变更还验证 `chusql-server/test/Spec.hs`；并发压力测试不是正确性证明。
 - 规定入口为 `gate-check/run-step.ps1 -Kind cargo`，动态库构建为 -Kind build；受影响 Haskell 模块按脚本命令串行构建，全量门禁遵守 AGENTS.md。
 
-## References
+## 相关资料
 
 恢复操作按需读 `docs/bootstrap.md`，配置见 `docs/config.md`，限制见 `.agents/context/known-issues.txt`；涉及拟议能力时仍以源码为准。

.agents/skills/chusql-type-system/SKILL.md

@@ -5,44 +5,57 @@ description: 修改 ChuSQL SQL 类型、值表示、赋值转换、类型推导
 
 # ChuSQL 类型系统
 
-## Scope
+## 适用范围
 
 负责类型语义；落盘顺序交给 chusql-storage-integrity，传输契约交给 chusql-boundary-contracts。通用语言与测试规范使用已有 Skills，不重复加载。下列路径相对仓库根目录，只读本次相关模块。
 
-## Architecture
+## 模块与调用路径
 
 - `chusql-core/model/src/ChuSQL/Core/Model.hs`：`ColumnType`、列约束、`Value`；集中提供 `assignable`、`comparableTypes`、`valueFits`、`coerceValue`、相等与哈希语义。
 - `chusql-core/model/src/ChuSQL/Core/Runtime.hs`：`TypeExpr` / `TypeId`、`Kind`、独立 `PhysicalType`、`RuntimeValue`、注册表和版本化编码；Engine 的 `Runtime/Types.hs` 只是重新导出。
 - `chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs` 与 `Syntax/AST.hs` 解析声明和构造表达式；`Semantic.hs` 根据 schema 解析 DOMAIN、推导表达式并绑定身份。
 - `chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Functions.hs` 定义固定 FunctionId 与签名，现有函数 length / not；`Runtime/SQL.hs` 连接 SQL 标量和运行时值。
-- `chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Query.hs` 的 BoundQuery 保存 schema、输出类型和优化后的 RelOp，执行后按位置校验。`Runtime/Binding.hs` 另提供类型化表达式与基础计划，尚未替代完整 SQL 关系代数。
+- `chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Query.hs` 的 BoundQuery 保存 schema、输出类型和优化后的 RelOp，执行后按位置校验。
+
+  `Runtime/Binding.hs` 另提供类型化表达式与基础计划，尚未替代完整 SQL 关系代数。
 - `chusql-core/model/src/ChuSQL/Core/Protocol.hs` 共享值的 JSON 转换；Rust 的 `chusql-core/storage/src/protocol.rs` 使用 `HashMap<String, serde_json::Value>` 保存行。
 
-## Invariants
+## 必须保持的不变量
+
+### 类型身份与值
 
 - 构造器编号固定：Int=1、Double=2、Bool=3、String=4、List=5、Maybe=6、Tuple=7。使用 resolveType 检查参数 / kind，不把显示名当身份，不再维护第二份注册表。
 - CRuntime / VRuntime 身份必须匹配；递归检查列表元素、Maybe 内容与元组字段数，Double 必须有限。保留逻辑类型与物理表示的区别。
 - SQL VNull 与 RMaybe Nothing 不同；CNull 是查询推导类型，不能声明为存储列。保留三值逻辑与函数 NULL 传播。
+
+### 转换与数值语义
+
 - 赋值兼容和比较兼容分别使用 Model 入口。coerceValue 负责值收敛；整值浮点转整数、字符串长度、日期格式、DECIMAL 舍入沿现有规则处理，不在 Parser / Eval / Web 重复实现转换。
-- 整数与可规范化整值浮点保持相等 / 哈希一致。底层 compareValue 的实现不表示 SQL 已开放该类型的比较、排序、分组或索引。
+- 整数与可规范化整值浮点保持相等 / 哈希一致。内建运行时类型的 Eq / Ord / Hash 由 TypeDescriptor 按参数递归派生，排序和哈希按结构实现；索引键编码仍独立，不能因已有查询能力放开索引或唯一键声明。
+
+### 领域与兼容表示
+
 - DOMAIN 使用 domainTableName 与目录定义解析基础类型、依赖及循环；不能拿解析器占位基础类型直接执行。系统内建类型目录也不是通过增加行即可扩展的插件注册表。
 - Date / Timestamp / Blob 在 QueryType 保留 CompatibilityType；ColumnType 与 RelOp 仍有真实消费者，不能作为无用兼容层删除。
+
+### 编码与错误传播
+
 - 类型 / 值编码版本为 1；身份、类型名、封装或值结构变化可能影响 catalog、WAL、FFI、TCP 和 Web，组合相关 Skills 核对消费者。
-- Rust 当前保存通用 JSON，只做局部校验（隐藏列、DOMAIN 依赖、DECIMAL 规范化），没有 Haskell validateValue 的完整等价检查；不要依赖原始存储请求完成所有 SQL 类型校验。
+- Rust 当前保存通用 JSON，只做局部校验，包括隐藏列、DOMAIN 依赖和 DECIMAL 规范化。它没有 Haskell validateValue 的完整等价检查，不要依赖原始存储请求完成所有 SQL 类型校验。
 - 错误沿 Either String 返回；`chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs` 用消息规则映射类别 / 协议码。修改错误文字须检查分类，不用默认值或 NULL 掩盖错误。
 
-## Engineering Decisions
+## 实现取舍与边界
 
-复用 Model / Runtime 的语义入口，在现有类型桥上做最小修改。尚无完整 capability / operator / cast 注册机制、通用显式 CAST、用户 ADT 或 Extension；DOMAIN 自身 CHECK / NOT NULL / DEFAULT 尚未实现。不要将规划当现有契约。
-DECIMAL 是有限浮点表示，采用 ties-to-even 舍入与舍入后溢出检查，并非精确十进制存储。运行时复合类型尚无 SQL Eq / Ord / Hash capability 字典。
+复用 Model / Runtime 的语义入口，在现有类型桥上做最小修改。尚无完整 capability / operator / cast 注册机制、通用显式 CAST、用户 ADT 或 Extension；DOMAIN 的继承约束、默认值和变更校验集中在 Engine/Domain.hs；ALTER DOMAIN 通过一致快照和提交点复查发布。不要将规划当现有契约。
+DECIMAL 是有限浮点表示，采用 ties-to-even 舍入与舍入后溢出检查，并非精确十进制存储。内建运行时复合类型已提供 SQL Eq / Ord / Hash 能力，尚无用户注册的运算实现或复合索引键编码。
 
-## Validation
+## 验证入口
 
 - 语义改动验证解析 → schema 绑定 → 执行，关注 NULL、边界值、明确错误与输出位置；说明修正只需核对源码。
 - 复用 `chusql-core/engine/test/RuntimeSpec.hs`、`chusql-core/engine/test/Spec.hs`，按需覆盖固定编码、错误身份和嵌套值。
 - 持久化类型变更验证 Rust 写入 / 重载与实际协议消费者；Web 值展示 / SQL 生成参考 `chusql-web/test/runtime-values.mjs`。
 - 测试入口见 `gate-check/run-step.ps1`，不因加载 Skill 自动执行全量门禁或追求覆盖率。
 
-## References
+## 相关资料
 
 按需读 `docs/types.md`，区分当前类型用法与未来约束设计。以上源码模块是契约核对入口。

.dockerignore

@@ -0,0 +1,22 @@
+# 只发送构建所需源码，排除凭据、数据及宿主构建缓存。
+.git
+.agents
+.codex
+.aws
+**/.stack-work
+**/target
+**/dist
+**/dist-newstyle
+**/__pycache__
+logs
+secrets
+.env
+.env.*
+**/*.db
+**/*.idx
+**/wal.log
+**/wal.checkpoint
+Dockerfile*
+compose*.yaml
+docs
+benchmark

.gitignore

@@ -103,3 +103,10 @@ learning
 !/.agents/skills/chusql-type-system/
 /.agents/context/prompt.txt
 /skills-lock.json
+
+# Docker 部署口令仅保存在本机。
+/secrets/
+/.env
+/.env.*
+
+examples

AGENTS.md

@@ -20,11 +20,31 @@
 - 跨领域组合相关 Skills，无关任务不加载；Skills 不覆盖更高优先级的安全和工程约束。
 - 简单任务直接执行；采用最小必要改动，允许有明确收益且能验证的局部结构优化，优先删除重复和无用代码。
 - 保持代码最简：用最少且易读的代码完整解决当前需求，优先复用现有实现与标准库；相同规则只维护一份，不引入仅为缩短函数或预留未来而存在的抽象、包装、配置和依赖。简化须保持求值顺序、错误传播、边界校验及恢复约束，不以压缩行数牺牲清晰度或正确性。
-- Haskell 编码后对受影响源码运行 HLint（与 nvim 的提示来源一致），修复能保持语义的建议；不通过禁用提示绕过检查。优先使用 `void`、`when/unless`、`fromMaybe`、`isJust/isNothing`、`maybeToList`、`zipWithM` 等惯用函数，避免冗余 lambda、括号、绑定、导入与 LANGUAGE pragma；涉及惰性、严格性或类型表示变化的建议须核对语义，不能机械套用。
+- Haskell 编码后对受影响源码运行 HLint（与 nvim 的提示来源一致），修复能保持语义的建议；不通过禁用提示绕过检查。
+
+  优先使用 `void`、`when/unless`、`fromMaybe`、`isJust/isNothing`、`maybeToList`、`zipWithM` 等惯用函数，避免冗余 lambda、括号、绑定、导入与 LANGUAGE pragma；涉及惰性、严格性或类型表示变化的建议须核对语义，不能机械套用。
 - 测试强度与实际风险及影响范围匹配，不机械新增测试，不盲目追求覆盖率；数据库内核微改动也须验证关键行为。
 - 不强制 TDD、子代理或多阶段审查；减少无关读取、重复搜索、工具调用和输出，Skills 不应增加无收益的流程。
 - 文档描述当前状态；不创建整改报告、修改流水账或无用途的兼容层，不修改 Git 历史。
 
+## 文档编写
+
+编写、修改或审阅 README、`docs/` 及其他说明文档时，加载以下全局 Skills：
+
+- `technical-documentation`：先确定读者和阅读目的，再安排标题、操作步骤、示例与参考信息。入口为 `~/.codex/skills/technical-documentation/SKILL.md`。
+- `plain-writing`：用常用词解释行为，删除空话，拆开堆叠的术语与长句。入口为 `~/.codex/skills/plain-writing/SKILL.md`。
+
+涉及设计理由时，另用 `documentation-and-adrs`，沿用现有设计文件，不另建决策或进度来源。全局目录以 `$CODEX_HOME/skills` 为准，未设置时使用 `~/.codex/skills`。
+
+文档须遵守以下约定，中文不机械套用英文语法规则：
+
+- 开头说明本页帮助谁完成什么任务。README 先帮助安装和使用，内部实现放在架构文档中，通过链接提供深入阅读。
+- 按问题或任务分节，每段只解释一个主题，通常用 2 至 4 句。长段落优先拆分主题，不把整页改成零碎列表。
+- 有先后顺序的操作用编号步骤，并说明前提和验证结果；并列要点用列表；参数和能力对比用表格。标题、正文、列表和代码块之间留空行。
+- 必要术语首次出现时用一句中文解释，再保留准确名称。同一概念使用同一名称，不连续堆叠缩写、内部类型和函数名。
+- 命令和示例标明语言及占位符含义。链接文字说明目标内容，图示须有正文说明，不让关键信息只存在于图中。
+- 完稿后按读者顺序通读，核对链接、命令、条件、错误行为和限制。排版与措辞优化不得删掉技术边界，不为简化表达夸大能力；规划与已实现能力分开说明。
+
 ## 注释规范
 - 文件级：外部引用语句（Haskell `import`、Rust `use`、JS `import`、HTML 的 `<link>`/`<script>`、
   CSS `@import`、脚本的依赖/参数区）之后写一段注释，概括本文件的功能；没有引用语句的文件写在

Dockerfile

@@ -0,0 +1,66 @@
+# syntax=docker/dockerfile:1
+
+# 分阶段构建存储和四个程序，运行镜像不包含编译器。
+ARG DEBIAN_MIRROR=http://mirrors.tencentyun.com
+ARG BASE_REGISTRY=docker.io
+
+FROM ${BASE_REGISTRY}/library/rust:1-bookworm@sha256:e12566d5abc17a0da741628782cdb504b68b8961f5bfcf677936bf3e8b32de29 AS storage
+ARG CARGO_REGISTRY=sparse+https://rsproxy.cn/index/
+ENV CARGO_BUILD_JOBS=1 CARGO_HTTP_TIMEOUT=30
+WORKDIR /build/chusql-core/storage
+COPY chusql-core/storage/Cargo.toml chusql-core/storage/Cargo.lock ./
+COPY chusql-core/storage/src ./src
+RUN --mount=type=cache,target=/usr/local/cargo/registry \
+    cargo --config 'source.crates-io.replace-with="build-mirror"' \
+    --config "source.build-mirror.registry=\"${CARGO_REGISTRY}\"" \
+    build --release --locked --jobs 1
+
+FROM ${BASE_REGISTRY}/library/haskell:9.10.3-slim-bookworm@sha256:4f1f62fec9cea4cbb03e885c9ad45642609cadd3897b1e64a7f61d0862b575b1 AS haskell
+ARG DEBIAN_MIRROR
+RUN sed -i "s|http://deb.debian.org|${DEBIAN_MIRROR}|g" /etc/apt/sources.list.d/debian.sources \
+    && apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 update \
+    && apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 install -y --no-install-recommends libgmp-dev zlib1g-dev \
+    && rm -rf /var/lib/apt/lists/*
+ENV LD_LIBRARY_PATH=/build/chusql-core/storage/target/release \
+    GHCRTS=-M1536m
+WORKDIR /build
+COPY --from=storage /build/chusql-core/storage/target/release/libchusql_core_storage.so ./chusql-core/storage/target/release/
+COPY chusql-core/model ./chusql-core/model
+COPY chusql-core/engine ./chusql-core/engine
+COPY chusql-interface ./chusql-interface
+COPY chusql-bootstrap ./chusql-bootstrap
+COPY chusql-server ./chusql-server
+COPY chusql-web ./chusql-web
+COPY chusql-cli ./chusql-cli
+RUN --mount=type=cache,target=/root/.stack \
+    stack --stack-yaml chusql-cli/stack.yaml --system-ghc --no-install-ghc \
+    build --fast --jobs 1 --ghc-options=-j1 --copy-bins --local-bin-path /out/bin \
+    chusql-server:exe:chusql-server chusql-bootstrap:exe:csql-bootstrap \
+    chusql-web:exe:chusql-web chusql-cli:exe:csql
+
+FROM ${BASE_REGISTRY}/library/debian:bookworm-slim@sha256:7c7b2c966bc9ee8cedfeef67e0e279108992c77681fa595db4a9d65c06ccc587 AS runtime
+ARG DEBIAN_MIRROR
+RUN sed -i "s|http://deb.debian.org|${DEBIAN_MIRROR}|g" /etc/apt/sources.list.d/debian.sources \
+    && apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 update \
+    && apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 install -y --no-install-recommends \
+    ca-certificates libgmp10 libnuma1 libffi8 libtinfo6 zlib1g curl netcat-openbsd \
+    && rm -rf /var/lib/apt/lists/* \
+    && groupadd --gid 10001 chusql \
+    && useradd --uid 10001 --gid chusql --create-home chusql \
+    && install -d -o chusql -g chusql /var/lib/chusql /var/log/chusql /opt/chusql/resources
+WORKDIR /opt/chusql
+COPY --from=haskell /out/bin/ ./bin/
+COPY --from=storage /build/chusql-core/storage/target/release/libchusql_core_storage.so ./bin/
+COPY chusql-web/static ./static
+COPY docker/server.toml docker/web.toml /etc/chusql/
+COPY --chmod=755 docker/entrypoint.sh docker/healthcheck.sh /usr/local/bin/
+ENV PATH=/opt/chusql/bin:${PATH} \
+    LD_LIBRARY_PATH=/opt/chusql/bin \
+    LANG=C.UTF-8 \
+    CHUSQL_ADMIN_USER=root
+USER 10001:10001
+EXPOSE 7777 7778
+HEALTHCHECK --interval=15s --timeout=5s --start-period=30s --retries=5 \
+    CMD ["healthcheck.sh", "server"]
+ENTRYPOINT ["entrypoint.sh"]
+CMD ["server"]

README.md

@@ -9,12 +9,16 @@
   <br>
 </p>
 
-ChuSQL 是采用 Haskell SQL 引擎与 Rust 存储层的数据库项目，提供 TCP 服务、CLI 和 Web 管理端。支持查询优化、快照事务、WAL 崩溃恢复、DOMAIN 自定义类型及用户与角色管理。
+ChuSQL 是一个用 Haskell 和 Rust 编写的数据库，提供命令行客户端和 Web 管理界面。本页帮助你安装并启动客户端；SQL 写法和内部设计见文末的文档导航。
+
+你可以用 SQL 查询和修改数据、通过事务提交或回滚修改，以及管理用户与角色。数据库还支持自定义类型（DOMAIN），并通过预写日志（WAL）在崩溃后恢复已提交的数据。
 
 项目仓库：[GitHub](https://github.com/TheBadRoger/ChuSQL) · [ChuRepo](https://repo.chunana.cn/ChuNa7a/ChuSQL)。两处均可获取源码，按网络情况选择。
 
 ## 快速开始
 
+按操作系统选择安装命令，再启动命令行客户端或 Web 界面。
+
 ### 安装
 
 Linux / macOS：
@@ -36,7 +40,7 @@ curl -fsSL \
 sh install.sh --component web
 ```
 
-Windows（PowerShell 里下下来再跑；也有下载 zip 解压的包内安装）：
+Windows：在 PowerShell 中下载并执行安装脚本。
 
 ```powershell
 try {
@@ -54,30 +58,45 @@ irm https://repo.chunana.cn/ChuNa7a/ChuSQL/raw/branch/main/scripts/install.ps1 -
 & "$env:TEMP\install.ps1" -Component web
 ```
 
-上述命令下载脚本时优先 GitHub，失败后尝试 ChuRepo。脚本安装和更新时也会自动回退：版本查询或发行包下载失败时尝试 ChuRepo；已选定的版本保持不变，校验失败直接报错。两站均无对应发行包时需使用包内安装或源码安装。显式指定其他仓库或归档 URL 时不会回退到官方仓库。
+首组命令优先从 GitHub 下载脚本，失败后尝试 ChuRepo。安装脚本在查询版本或下载发行包失败时，也会尝试 ChuRepo，并保持已选定的版本。校验失败时直接报错。
+
+两站均无对应发行包时，使用包内安装或源码安装。显式指定其他仓库或归档 URL 时，不会回退到官方仓库。详细步骤见[安装与卸载](docs/install.md)。
+
+### Docker 部署
+
+已提供 Dockerfile 和 Compose 配置，可启动数据库并按需启用 Web。首次运行先创建管理员口令文件，再构建和启动；步骤与资源限制见 [Docker 部署](docs/docker.md)。
+
+博客接入的数据模型、事务、迁移与验收步骤见[博客业务数据库接入](docs/blog-database.md)。
 
 ### 启动
 
+已安装 CLI 时，运行以下命令打开命令行界面：
+
 ```sh
 csql
 ```
 
-启动CLI界面，或
+已安装 Web 组件时，运行以下命令启动 Web 界面：
 
 ```sh
 csql-web
 ```
 
-启动web界面，默认通过7778端口访问
+启动后，在浏览器中打开 <http://127.0.0.1:7778>。监听地址和端口的修改方法见[配置选项](docs/config.md)。
 
-## 更多参考文档
+## 文档导航
 
-- [安装与卸载](docs/install.md)
-- [配置选项](docs/config.md)
-- [命令与选项](docs/commands.md)
-- [SQL 语法](docs/syntax.md)
-- [类型与类型目录](docs/types.md)
-- [用户、角色与属性](docs/users-and-roles.md)
-- [系统引导与恢复](docs/bootstrap.md)
-- [架构与组件](docs/architecture.md)
-- [性能基准与瓶颈分析](docs/performance.md)
+按你要完成的任务选择文档：
+
+| 任务 | 文档 |
+| --- | --- |
+| 用容器部署和备份 | [Docker 部署](docs/docker.md) |
+| 安装、更新或卸载 | [安装与卸载](docs/install.md) |
+| 修改端口、路径等设置 | [配置选项](docs/config.md) |
+| 查找客户端命令和启动参数 | [命令与选项](docs/commands.md) |
+| 编写查询和修改数据 | [SQL 语法](docs/syntax.md) |
+| 选择数据类型或定义 DOMAIN | [类型与类型目录](docs/types.md) |
+| 管理账号和访问权限 | [用户、角色与属性](docs/users-and-roles.md) |
+| 初始化或离线修复数据库 | [系统引导与恢复](docs/bootstrap.md) |
+| 理解组件、查询执行和存储机制 | [架构与组件](docs/architecture.md) |
+| 查看性能测量及瓶颈 | [性能基准与瓶颈分析](docs/performance.md) |

benchmark/src/Main.hs

@@ -2,7 +2,7 @@
 
 module Main where
 
-import Data.Either (lefts)
+import ChuSQL.Core.Model (Value (..))
 import ChuSQL.Core.Protocol (QueryResult (..), TableInfo (..))
 import ChuSQL.Interface.Link (Client, clientPing, closeClient, connectClient)
 import ChuSQL.Interface.Session (
@@ -13,12 +13,12 @@ import ChuSQL.Interface.Session (
     runStatement,
     switchDatabase,
  )
-import Control.Concurrent (forkIO, forkFinally, threadDelay)
+import Control.Concurrent (forkFinally, forkIO, threadDelay)
 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (IOException, bracket, evaluate, throwIO, try)
-import Control.Monad (forM_, replicateM, unless, when, void)
+import Control.Monad (forM_, replicateM, unless, void, when)
+import Data.Either (lefts)
 import Data.List (intercalate, sort)
-import ChuSQL.Core.Model (Value (..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import GHC.Clock (getMonotonicTime)
@@ -32,8 +32,8 @@ import System.Directory (
 import System.Environment (getArgs)
 import System.Exit (ExitCode (..), exitFailure)
 import System.FilePath ((</>))
+import System.IO (BufferMode (LineBuffering), Handle, hGetLine, hSetBuffering, stdout)
 import System.Info (os)
-import System.IO (Handle, hGetLine, hSetBuffering, BufferMode (LineBuffering), stdout)
 import System.Process (
     CreateProcess (std_err, std_out),
     ProcessHandle,
@@ -188,7 +188,7 @@ runBatch bench sqls = do
 chunked :: Int -> Int -> [[Int]]
 chunked size n = go [1 .. n]
   where
-    -- | 递归切分
+    -- \| 递归切分
     go [] = []
     go xs = let (a, b) = splitAt size xs in a : go b
 
@@ -337,7 +337,7 @@ prepareDatabase session = do
                 Left e -> die ("cannot select the benchmark database: " ++ T.unpack e)
                 Right () -> pure ()
   where
-    -- | 报错退出
+    -- \| 报错退出
     die message = do
         putStrLn message
         exitFailure
@@ -386,11 +386,11 @@ portFromBanner line
 isInfixOf :: String -> String -> Bool
 isInfixOf needle haystack = any (prefix needle) (tails haystack)
   where
-    -- | 前缀匹配
+    -- \| 前缀匹配
     prefix [] _ = True
     prefix _ [] = False
     prefix (x : xs) (y : ys) = x == y && prefix xs ys
-    -- | 所有后缀
+    -- \| 所有后缀
     tails [] = [[]]
     tails s@(_ : rest) = s : tails rest
 
@@ -498,7 +498,7 @@ main = do
     printf "timing   : wall clock (monotonic); every statement runs the full chain over TCP\n"
     printf "note     : the client no longer links the engine or the storage library\n"
     bracket
-        (do
+        ( do
             t1 <- getMonotonicTime
             bench <- startBench
             t2 <- getMonotonicTime
@@ -545,14 +545,14 @@ latencies label rows times = do
     let ordered = sort times
         count = length times
         total = sum times
-        -- | 按最近秩取分位数
+        -- \| 按最近秩取分位数
         percentile fraction = ordered !! (ceiling (fraction * fromIntegral count) - 1)
     printf "CASE %-24s n=%d rows=%d mean_ms=%.3f p50_ms=%.3f p95_ms=%.3f max_ms=%.3f ops_s=%.2f\n" label count rows (total / fromIntegral count) (percentile (0.5 :: Double)) (percentile (0.95 :: Double)) (last ordered) (fromIntegral count * 1000 / total)
 
 -- | 预热后反复测量并校验结果行数
 sampleQuery :: Bench -> String -> String -> Int -> IO ()
 sampleQuery bench label statement expected = do
-    -- | 执行一次并校验结果数量
+    -- \| 执行一次并校验结果数量
     let action = do
             result <- runSql bench statement
             case result of
@@ -610,33 +610,44 @@ pressureScenarios bench u o = do
 -- | 用多条独立会话同步开始点查
 concurrentLookup :: Bench -> Int -> IO ()
 concurrentLookup bench workers = do
-    completions <- replicateM
+    completions <-
+        replicateM
             workers
-                     (do start <- newEmptyMVar
+            ( do
+                start <- newEmptyMVar
                 done <- newEmptyMVar
-                         client <- connectClient "127.0.0.1" (bPort bench)
+                client <-
+                    connectClient "127.0.0.1" (bPort bench)
                         >>= either (ioError . userError . T.unpack) pure
                 session <- newSession client
                 authenticateSession session "admin" ""
                     >>= either (ioError . userError . T.unpack) pure
                 switchDatabase session "bench"
                     >>= either (ioError . userError . T.unpack) pure
-                         _ <- forkFinally
-                                (takeMVar start
-                                   >>
-                                     bracket
-                                       (pure client) closeClient
-                                       (\ _
-                                          -> replicateM
+                _ <-
+                    forkFinally
+                        ( takeMVar start
+                            >> bracket
+                                (pure client)
+                                closeClient
+                                ( \_ ->
+                                    replicateM
                                         100
-                                               (fst
-                                                  <$>
-                                                    measure
-                                                      (do result <- runStatement
-                                                                      session "SELECT id FROM users WHERE id = 1"
-                                                          unless (fmap qrRows result == Right [[VInt 1]]) (ioError (userError "concurrent lookup mismatch"))))))
+                                        ( fst
+                                            <$> measure
+                                                ( do
+                                                    result <-
+                                                        runStatement
+                                                            session
+                                                            "SELECT id FROM users WHERE id = 1"
+                                                    unless (fmap qrRows result == Right [[VInt 1]]) (ioError (userError "concurrent lookup mismatch"))
+                                                )
+                                        )
+                                )
+                        )
                         (putMVar done)
-                         pure (start, done))
+                pure (start, done)
+            )
     (milliseconds, results) <- measure $ do
         mapM_ (\(start, _) -> putMVar start ()) completions
         mapM (takeMVar . snd) completions

chusql-bootstrap/app/Main.hs

@@ -2,19 +2,19 @@
 
 module Main (main) where
 
-import Data.Maybe (fromMaybe)
-import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
 import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
 import ChuSQL.Core.Engine.Storage.FFI (maintainStorage)
+import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
 import ChuSQL.Interface.Auth (hashPassword)
 import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName)
 import ChuSQL.Interface.TOML (resolveConfigPath)
+import Control.Exception (finally)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
-import Control.Exception (finally)
 import System.Environment (getArgs)
 import System.Exit (exitFailure)
 import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
@@ -46,7 +46,7 @@ emptyOptions =
 parseArgs :: [String] -> Either String Options
 parseArgs = go emptyOptions
   where
-    -- | 逐条消费参数列表
+    -- \| 逐条消费参数列表
     go opts [] = Right opts
     go opts (command : rest)
         | command `elem` ["repair", "recover", "recovery", "reset"] = case optMode opts of
@@ -156,7 +156,8 @@ send request = do
 readPassword :: Options -> IO (Either String Text)
 readPassword opts
     | optPasswordless opts = pure (Right "")
-    | optPasswordStdin opts = do Right . T.dropWhileEnd (\ c -> c == '\r' || c == '\n')
+    | optPasswordStdin opts = do
+        Right . T.dropWhileEnd (\c -> c == '\r' || c == '\n')
             <$> TIO.getLine
     | otherwise = pure (Left "pass --password-stdin or --passwordless")
 

chusql-bootstrap/src/ChuSQL/Bootstrap.hs

@@ -14,20 +14,33 @@ import qualified Data.Text as T
 
 -- | 现有内置类型及其默认参数
 preinstalledTypes :: [A.Value]
-preinstalledTypes = map definition
-    [ ("int", CInt, False), ("integer", CInt, False)
-    , ("bigint", CBigInt, False), ("smallint", CSmallInt, False)
-    , ("varchar", CStr, True), ("char", CChar 1, True)
-    , ("text", CStr, False), ("str", CStr, False)
-    , ("boolean", CBool, False), ("bool", CBool, False)
-    , ("float", CFloat, False), ("real", CFloat, False), ("double", CDouble, False)
-    , ("decimal", CDecimal 10 0, True), ("numeric", CDecimal 10 0, True)
-    , ("date", CDate, False), ("timestamp", CTimestamp, False), ("blob", CBlob, False)
+preinstalledTypes =
+    map
+        definition
+        [ ("int", CInt, False)
+        , ("integer", CInt, False)
+        , ("bigint", CBigInt, False)
+        , ("smallint", CSmallInt, False)
+        , ("varchar", CStr, True)
+        , ("char", CChar 1, True)
+        , ("text", CStr, False)
+        , ("str", CStr, False)
+        , ("boolean", CBool, False)
+        , ("bool", CBool, False)
+        , ("float", CFloat, False)
+        , ("real", CFloat, False)
+        , ("double", CDouble, False)
+        , ("decimal", CDecimal 10 0, True)
+        , ("numeric", CDecimal 10 0, True)
+        , ("date", CDate, False)
+        , ("timestamp", CTimestamp, False)
+        , ("blob", CBlob, False)
         ]
   where
-    -- | 编码类型的名称与基础表示
+    -- \| 编码类型的名称与基础表示
     definition :: (Text, ColumnType, Bool) -> A.Value
-    definition (name, base, parameterized) = A.object
+    definition (name, base, parameterized) =
+        A.object
             ["name" A..= name, "base_type" A..= typeName base, "parameterized" A..= parameterized]
 
 -- | 依次引导身份、迁移目录并预装类型
@@ -44,11 +57,11 @@ runBootstrap send name encoded = do
                     installed <- send (A.object ["method" A..= ("bootstrap_types" :: Text), "types" A..= preinstalledTypes])
                     pure (expect "rows" installed >>= installedTypes)
   where
-    -- | 确认系统目录已初始化
+    -- \| 确认系统目录已初始化
     initializedCatalog fields
         | KM.lookup "initialized" fields == Just (A.Bool True) = Right ()
         | otherwise = Left "system catalog is not initialized"
-    -- | 确认所选引导身份可以管理系统
+    -- \| 确认所选引导身份可以管理系统
     administrator fields = case KM.lookup "accounts" fields of
         Nothing -> Left "missing identity directory"
         Just value -> case A.fromJSON value :: A.Result [Account] of
@@ -56,14 +69,15 @@ runBootstrap send name encoded = do
             A.Success accounts
                 | any (\a -> accountUser a == T.toLower name && accountCanLogin a && accountEnabled a && accountIsSuperuser a) accounts -> Right ()
                 | otherwise -> Left "bootstrap identity is not an enabled login superuser; existing identities were preserved"
-    -- | 确认全部预装类型存在且定义一致
+    -- \| 确认全部预装类型存在且定义一致
     installedTypes fields = case KM.lookup "rows" fields of
         Just (A.Array rows)
             | all (\definition -> any (matches definition) (toList rows)) preinstalledTypes -> Right (length rows)
             | otherwise -> Left "preinstalled type verification failed"
         _ -> Left "missing preinstalled type directory"
-    -- | 比对类型定义并检查持久化编号
-    matches (A.Object definition) (A.Object saved) = all (\(key, value) -> KM.lookup key saved == Just value) (KM.toList definition)
+    -- \| 比对类型定义并检查持久化编号
+    matches (A.Object definition) (A.Object saved) =
+        all (\(key, value) -> KM.lookup key saved == Just value) (KM.toList definition)
             && case KM.lookup "id" saved of Just (A.Number n) -> n > 0; _ -> False
     matches _ _ = False
 

chusql-bootstrap/test/Spec.hs

@@ -2,18 +2,18 @@
 
 module Main (main) where
 
-import Data.Maybe (fromMaybe)
 import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
-import ChuSQL.Core.Protocol (Account (..))
-import ChuSQL.Core.Model (columnType, typeName)
+import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
 import ChuSQL.Core.Engine.Syntax.AST (Statement (CreateTable))
 import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
-import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
+import ChuSQL.Core.Model (columnType, typeName)
+import ChuSQL.Core.Protocol (Account (..))
 import Control.Exception (finally)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy as BL
-import Data.IORef (newIORef, readIORef, modifyIORef')
+import Data.IORef (modifyIORef', newIORef, readIORef)
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Unique (hashUnique, newUnique)
@@ -33,7 +33,8 @@ main = hspec $ do
             runBootstrap send "root" "new-hash" `shouldReturn` Right 18
             calls <- requests
             map (field "method") calls `shouldBe` map A.String ["bootstrap_system", "identity_initialize", "bootstrap_types"]
-        mapM_ (\(title, replies, err) -> it title (expectBootstrapFailure replies err))
+        mapM_
+            (\(title, replies, err) -> it title (expectBootstrapFailure replies err))
             [ ("stops on storage errors", [Left "storage unavailable"], "storage unavailable")
             , ("rejects an uninitialized system response", [Right (A.object ["status" A..= ("system" :: Text), "initialized" A..= False])], "system catalog is not initialized")
             , ("preserves a demoted identity and stops before type installation", [Right ready, Right (identity False)], "bootstrap identity is not an enabled login superuser; existing identities were preserved")
@@ -86,9 +87,9 @@ identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [
 
 -- | 已写入编号的类型响应
 installed :: A.Value
-installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= zipWith (curry numbered) [1 :: Int .. ] preinstalledTypes]
+installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= zipWith (curry numbered) [1 :: Int ..] preinstalledTypes]
   where
-    -- | 给预装定义添加持久化编号
+    -- \| 给预装定义添加持久化编号
     numbered (n, A.Object fields) = A.Object (KM.insert "id" (A.toJSON n) fields)
     numbered (_, value) = value
 
@@ -103,7 +104,7 @@ mock replies = do
     calls <- newIORef []
     queuedReplies <- newIORef replies
     let
-        -- | 消费一条模拟响应
+        -- \| 消费一条模拟响应
         send request = do
             modifyIORef' calls (++ [request])
             remaining <- readIORef queuedReplies

chusql-cli/app/Main.hs

@@ -2,10 +2,12 @@
 
 module Main (main) where
 
-import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
+import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Password (readPasswordInput)
 import ChuSQL.CLI.Script (stripTerminator)
+import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
+import ChuSQL.Interface.Link (Client, closeClient, connectClient)
 import ChuSQL.Interface.Session (
     Session,
     authenticateSession,
@@ -14,8 +16,6 @@ import ChuSQL.Interface.Session (
     newSession,
     switchDatabase,
  )
-import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
-import ChuSQL.Interface.Link (Client, closeClient, connectClient)
 import ChuSQL.Interface.Sudo (SudoCredential, readSudoCredential)
 import ChuSQL.Interface.TOML (resolveConfigPath)
 import Control.Exception (finally)
@@ -106,9 +106,11 @@ main = do
     config <- loadServerConfigAt configPath
     let rootName = rootUserName base
         userName = fromMaybe (if optSudo options then scSudoUser config else rootName) (optUser options)
-    credential <- if optSudo options then do
-        when (T.null userName)
-          $ reportError "sudo_auth_user is not configured" >> exitFailure
+    credential <-
+        if optSudo options
+            then do
+                when (T.null userName) $
+                    reportError "sudo_auth_user is not configured" >> exitFailure
                 local <- readSudoCredential (scPort config)
                 case local of
                     Left message -> reportError message >> exitFailure

chusql-cli/app/Repl.hs

@@ -1,19 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Repl
-    ( runRepl
-    , runStatementOnce
-    , reportError
-    ) where
+module Repl (
+    runRepl,
+    runStatementOnce,
+    reportError,
+) where
 
-import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
 import ChuSQL.CLI.History (historySettings, rememberStatement)
+import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
-import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
 import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
 import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
-import Control.Monad (forM_, when, unless)
+import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
+import Control.Monad (forM_, unless, when)
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (IORef, readIORef, writeIORef)
 import Data.Text (Text)
@@ -138,7 +138,7 @@ listTables session = do
         Right tables -> outputStrLn (T.unpack (renderRows headers (map tableRow tables)))
   where
     headers = ["table", "columns", "rows", "indexes"]
-    -- | 把表信息排成一行
+    -- \| 把表信息排成一行
     tableRow info =
         [ T.pack (tiTable info)
         , tshow (length (tiColumns info))
@@ -158,9 +158,9 @@ describeTable session name = do
                 (info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
   where
     headers = ["column", "type", "primary", "unique", "nullable", "auto"]
-    -- | 表名忽略大小写比较
+    -- \| 表名忽略大小写比较
     matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
-    -- | 把列信息排成一行
+    -- \| 把列信息排成一行
     columnRow column =
         [ T.pack (scName column)
         , T.pack (scType column)
@@ -169,7 +169,7 @@ describeTable session name = do
         , yesNo (scNullable column)
         , yesNo (scAutoIncrement column)
         ]
-    -- | 布尔值转成 yes/no
+    -- \| 布尔值转成 yes/no
     yesNo True = "yes"
     yesNo False = "no"
 
@@ -181,17 +181,17 @@ listRoles session = do
         Left message -> liftIO (reportError message)
         Right roles -> outputStrLn (T.unpack (renderRows ["role", "grants", "members"] (map roleRow roles)))
   where
-    -- | 把角色信息排成一行
+    -- \| 把角色信息排成一行
     roleRow view =
         [ roleName view
         , if null (roleGrants view) then "-" else T.intercalate ", " (map grantText (roleGrants view))
         , if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view)
         ]
-    -- | 拼一条授权说明
+    -- \| 拼一条授权说明
     grantText grant = grantPrivilege grant <> " on " <> grantObject grant <> optionText grant
-    -- | 带转授权时补一段说明
+    -- \| 带转授权时补一段说明
     optionText grant = if grantable grant then " with grant option" else ""
 
 -- | 用 show 转成 Text
-tshow :: Show a => a -> Text
+tshow :: (Show a) => a -> Text
 tshow = T.pack . show

chusql-cli/src/ChuSQL/CLI/Format.hs

@@ -1,16 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.CLI.Format
-    ( OutputFormat (..)
-    , parseFormat
-    , formatName
-    , renderResult
-    , renderTable
-    , renderRows
-    , renderCsv
-    , renderJson
-    , displayValue
-    ) where
+module ChuSQL.CLI.Format (
+    OutputFormat (..),
+    parseFormat,
+    formatName,
+    renderResult,
+    renderTable,
+    renderRows,
+    renderCsv,
+    renderJson,
+    displayValue,
+) where
 
 import ChuSQL.Core.Model (Value (..))
 import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
@@ -55,7 +55,7 @@ renderCsv :: QueryResult -> Text
 renderCsv result = T.unlines (header : map rowLine (qrRows result))
   where
     header = T.intercalate "," (map csvField (qrColumns result))
-    -- | 拼一行 CSV
+    -- \| 拼一行 CSV
     rowLine row = T.intercalate "," (map (csvField . csvCell) row)
 
 -- | CSV 里的空值就是空字段
@@ -80,13 +80,13 @@ renderRows :: [Text] -> [[Text]] -> Text
 renderRows columns rawRows = T.unlines (border : headerLine : border : body ++ [border, summary])
   where
     widths = [columnWidth index | index <- [0 .. length columns - 1]]
-    -- | 一列的显示宽度，有上限
+    -- \| 一列的显示宽度，有上限
     columnWidth index =
         min maxColumnWidth (maximum (T.length (columns !! index) : [T.length (cellAt row index) | row <- rawRows]))
     maxColumnWidth = 64
-    -- | 取某行某列，缺的当空
+    -- \| 取某行某列，缺的当空
     cellAt row index = if index < length row then row !! index else ""
-    -- | 拼一行带竖线的表行
+    -- \| 拼一行带竖线的表行
     cellLine cells = "| " <> T.intercalate " | " (zipWith pad widths (cells ++ repeat "")) <> " |"
     headerLine = cellLine columns
     body = map cellLine rawRows

chusql-cli/src/ChuSQL/CLI/History.hs

@@ -11,11 +11,12 @@ import System.Console.Haskeline.History (addHistory)
 -- 关闭逐行历史，筛选完整语句后记录安全输入。
 
 -- | 配置仅手动追加的输入历史
-historySettings :: MonadIO m => Maybe FilePath -> Settings m
-historySettings path = defaultSettings {historyFile = path, autoAddHistory = False}
+historySettings :: (MonadIO m) => Maybe FilePath -> Settings m
+historySettings path = defaultSettings{historyFile = path, autoAddHistory = False}
 
 -- | 排除含口令标记的完整语句
-rememberStatement :: MonadIO m => T.Text -> InputT m ()
+rememberStatement :: (MonadIO m) => T.Text -> InputT m ()
 rememberStatement statement =
-    unless (T.null (T.strip statement) || any (`T.isInfixOf` T.toCaseFold statement) ["password", "identified"])
+    unless
+        (T.null (T.strip statement) || any (`T.isInfixOf` T.toCaseFold statement) ["password", "identified"])
         (modifyHistory (addHistory (T.unpack statement)))

chusql-cli/src/ChuSQL/CLI/Normalization.hs

@@ -3,7 +3,7 @@
 module ChuSQL.CLI.Normalization (normalizationArguments, loadNormalizationDeclaration, renderNormalization, runNormalizationOnce) where
 
 import ChuSQL.Interface.Normalization
-import ChuSQL.Interface.Session (Session, sessionDatabase, analyzeNormalization)
+import ChuSQL.Interface.Session (Session, analyzeNormalization, sessionDatabase)
 import Control.Exception (IOException, try)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as K
@@ -59,7 +59,8 @@ jsonText = TE.decodeUtf8 . BL.toStrict . A.encode
 -- 缩进展示完整报告且保留所有证据。
 pretty :: Int -> A.Value -> Text
 pretty depth (A.Object fields) = T.intercalate "\n" [indent <> K.toText key <> ":\n" <> pretty (depth + 1) value | (key, value) <- KM.toList fields]
-  where indent = T.replicate depth "  "
+  where
+    indent = T.replicate depth "  "
 pretty depth value = T.replicate depth "  " <> jsonText value
 
 -- 发送声明并让失败决定 CLI 退出码。

chusql-cli/src/ChuSQL/CLI/Script.hs

@@ -1,19 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.CLI.Script
-    ( Meta (..)
-    , parseMeta
-    , takeStatement
-    , statementComplete
-    , stripTerminator
-    , errorHint
-    , metaHelp
-    ) where
+module ChuSQL.CLI.Script (
+    Meta (..),
+    parseMeta,
+    takeStatement,
+    statementComplete,
+    stripTerminator,
+    errorHint,
+    metaHelp,
+) where
 
-import Data.Maybe (isJust)
-import ChuSQL.CLI.Normalization (normalizationArguments)
 import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
+import ChuSQL.CLI.Normalization (normalizationArguments)
 import Data.Char (isSpace)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 
@@ -49,7 +49,8 @@ parseMeta raw = do
         "list" -> MetaDatabases
         "dt" -> MetaTables
         "tables" -> MetaTables
-        "d" | T.null argument -> MetaTables
+        "d"
+            | T.null argument -> MetaTables
             | otherwise -> MetaDescribe argument
         "dr" -> MetaRoles
         "roles" -> MetaRoles
@@ -61,18 +62,18 @@ parseMeta raw = do
         "format" -> selectFormat argument
         other -> MetaUnknown other
   where
-    -- | 拼出切库命令
+    -- \| 拼出切库命令
     connectTo argument
         | T.null argument = MetaUnknown "c"
         | otherwise = MetaConnect argument
-    -- | 解析格式参数
+    -- \| 解析格式参数
     selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
 
 -- | 取出第一条语句，忽略引号与注释里的分号
 takeStatement :: Text -> Maybe (Text, Text)
 takeStatement = go ScanNormal [] . T.unpack
   where
-    -- | 逐字符扫描语句边界
+    -- \| 逐字符扫描语句边界
     go _ _ [] = Nothing
     go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
     go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest

chusql-cli/test/Spec.hs

@@ -2,27 +2,27 @@
 
 module Main (main) where
 
-import ChuSQL.CLI.Normalization
-import ChuSQL.Interface.Normalization
-import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable, displayValue)
+import ChuSQL.CLI.Format (OutputFormat (..), displayValue, parseFormat, renderCsv, renderJson, renderTable)
 import ChuSQL.CLI.History (historySettings, rememberStatement)
+import ChuSQL.CLI.Normalization
 import ChuSQL.CLI.Password (readPasswordInput)
 import ChuSQL.CLI.Script (Meta (..), errorHint, parseMeta, statementComplete, stripTerminator, takeStatement)
 import ChuSQL.Core.Model (Value (..))
 import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
 import ChuSQL.Core.Runtime
+import ChuSQL.Interface.Normalization
+import Control.Exception (bracket, finally)
+import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (decode)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import Control.Exception (bracket, finally)
-import Control.Monad.IO.Class (liftIO)
+import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
+import System.Console.Haskeline.History (historyLines)
 import System.Directory (getTemporaryDirectory, removeFile)
 import System.IO (Handle, SeekMode (AbsoluteSeek), hClose, hPutStr, hSeek, hSetNewlineMode, noNewlineTranslation, openTempFile)
 import Test.Hspec
-import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
-import System.Console.Haskeline.History (historyLines)
 
 -- chusql-cli 测试：输出格式、语句缓冲、元命令与口令输入。
 
@@ -47,12 +47,15 @@ spec = do
 historySpec :: Spec
 historySpec = describe "CLI: SQL history" $ do
     it "does not automatically record unfinished input lines" $
-        withPasswordInput "CREATE USER alice IDENTIFIED BY\n'secret'\n" (\handle -> do
+        withPasswordInput
+            "CREATE USER alice IDENTIFIED BY\n'secret'\n"
+            ( \handle -> do
                 entries <- runInputTBehavior (useFileHandle handle) (historySettings Nothing) $ do
                     getInputLine "" >>= liftExpectation "CREATE USER alice IDENTIFIED BY"
                     getInputLine "" >>= liftExpectation "'secret'"
                     historyLines <$> getHistory
-            entries `shouldBe` [])
+                entries `shouldBe` []
+            )
     it "keeps ordinary statements and excludes multiline or mixed-case passwords" $ do
         entries <- runInputT (historySettings Nothing) $ do
             rememberStatement "SELECT 1;"
@@ -66,18 +69,20 @@ historySpec = describe "CLI: SQL history" $ do
         entries `shouldBe` ["SELECT 1;"]
     it "persists only safe statements from a batch" $ do
         directory <- getTemporaryDirectory
-        bracket (openTempFile directory "csql-history-test")
+        bracket
+            (openTempFile directory "csql-history-test")
             (\(path, _) -> removeFile path)
-            (\(path, handle) -> do
+            ( \(path, handle) -> do
                 hClose handle
                 runInputT (historySettings (Just path)) $
                     rememberBatch "SELECT 1; CREATE USER alice IDENTIFIED BY 'secret'; SELECT 2;"
                 entries <- runInputT (historySettings (Just path)) (historyLines <$> getHistory)
-                entries `shouldBe` ["SELECT 2;", "SELECT 1;"])
+                entries `shouldBe` ["SELECT 2;", "SELECT 1;"]
+            )
   where
-    -- | 核对实际读取的输入行
+    -- \| 核对实际读取的输入行
     liftExpectation expected actual = liftIO (actual `shouldBe` Just expected)
-    -- | 按完整语句筛选批量输入
+    -- \| 按完整语句筛选批量输入
     rememberBatch input = case takeStatement input of
         Nothing -> pure ()
         Just (statement, rest) -> do
@@ -88,27 +93,33 @@ historySpec = describe "CLI: SQL history" $ do
 withPasswordInput :: String -> (Handle -> IO a) -> IO a
 withPasswordInput input action = do
     directory <- getTemporaryDirectory
-    bracket (openTempFile directory "csql-password-test")
+    bracket
+        (openTempFile directory "csql-password-test")
         (\(path, handle) -> hClose handle `finally` removeFile path)
-        (\(_, handle) -> do
+        ( \(_, handle) -> do
             hSetNewlineMode handle noNewlineTranslation
             hPutStr handle input
             hSeek handle AbsoluteSeek 0
-            action handle)
+            action handle
+        )
 
 -- | 管道口令的行尾与内容用例
 passwordSpec :: Spec
 passwordSpec = describe "CLI: password input" $ do
     it "reads LF, CRLF and unterminated passwords identically" $ do
-        mapM_ (\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
+        mapM_
+            (\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
             ["secret\n", "secret\r\n", "secret"]
     it "preserves password spaces and internal carriage returns" $
         withPasswordInput " a\rb \r\n" (\handle -> readPasswordInput handle `shouldReturn` " a\rb ")
     it "accepts an empty password and consumes only one line" $
-        withPasswordInput "\r\nsecond\n" (\handle -> do
+        withPasswordInput
+            "\r\nsecond\n"
+            ( \handle -> do
                 readPasswordInput handle `shouldReturn` ""
                 readPasswordInput handle `shouldReturn` "second"
-            readPasswordInput handle `shouldReturn` "")
+                readPasswordInput handle `shouldReturn` ""
+            )
 
 -- | 输出格式的用例
 formatSpec :: Spec
@@ -192,7 +203,6 @@ sampleResult =
         , qrDatabase = Nothing
         }
 
-
 -- 范式元命令、严格文件与显示格式回归。
 normalizationSpec :: Spec
 normalizationSpec = describe "CLI: normalization" $ do

chusql-core/engine/chusql-core-engine.cabal

@@ -10,7 +10,8 @@ build-type:     Simple
 
 library
     hs-source-dirs:   src
-    exposed-modules:  ChuSQL.Core.Engine.Algebra.Cost
+    exposed-modules:  ChuSQL.Core.Engine.Domain
+                      ChuSQL.Core.Engine.Algebra.Cost
                       ChuSQL.Core.Engine.Algebra.Eval
                       ChuSQL.Core.Engine.Algebra.Expr
                       ChuSQL.Core.Engine.Algebra.JoinOrder

chusql-core/engine/src/ChuSQL/Core/Engine.hs

@@ -1,18 +1,19 @@
-module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf, BoundWrite, bindWrite, executeWriteM) where
+module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf, BoundWrite, bindWrite, executeWriteM, validateTableRows) where
 
 import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM)
 import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
+import ChuSQL.Core.Engine.Domain
+import ChuSQL.Core.Engine.Runtime.Dependencies (domainDependencies, queryTables, typeDependencies, validateDependencies)
 import ChuSQL.Core.Engine.Runtime.Query (bindQuery, executeQueryM)
 import ChuSQL.Core.Engine.Runtime.Relation (bindWriteColumns, orderRow)
-import ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, typeDependencies, validateDependencies)
 import ChuSQL.Core.Engine.Semantic (prepare, prepareCheckExpression)
 import ChuSQL.Core.Engine.Storage (MonadStorage (..))
 import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage))
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
 import ChuSQL.Core.Model
-import Data.HashSet qualified as HS
 import Data.HashMap.Strict qualified as HM
+import Data.HashSet qualified as HS
 import Data.Maybe (mapMaybe)
 
 -- 引擎入口：检查语义、按语句分发执行，另有内存实现与泛型版本。
@@ -69,7 +70,8 @@ bindWrite :: Database -> Statement -> Either String BoundWrite
 bindWrite db statement = case statement of
     Select{} -> unsupported
     SelectDistinct{} -> unsupported
-    _ | null (queryTables statement) -> unsupported
+    _
+        | null (queryTables statement) -> unsupported
         | otherwise -> do
             resolved <- prepare catalog statement >>= bindWriteColumns catalog
             let sources = queryTables resolved
@@ -81,14 +83,14 @@ bindWrite db statement = case statement of
   where
     catalog = [(name, table{tableRows = []}) | (name, table) <- db]
     unsupported = Left "bound writes require an existing table target"
-    -- | 新声明类型也须保留领域依赖
+    -- \| 新声明类型也须保留领域依赖
     declaredTypes resolved = case resolved of
         AddColumn _ (_, column) -> [columnType column]
         AlterColumnType _ _ ty -> [ty]
         _ -> []
 
 -- | 复查结构后执行可复用的绑定写计划
-executeWriteM :: MonadStorage m => BoundWrite -> m (Either String [Row])
+executeWriteM :: (MonadStorage m) => BoundWrite -> m (Either String [Row])
 executeWriteM (BoundWrite catalog dependencies action) = do
     current <- schema
     case current >>= validateDependencies dependencies of
@@ -99,15 +101,24 @@ executeWriteM (BoundWrite catalog dependencies action) = do
 bindWriteAction :: Database -> Statement -> Either String WriteAction
 bindWriteAction catalog statement = case statement of
     Insert target columns rows -> do
-        table <- lookupTable catalog target
-        checks <- checkPlan table
-        let plan = InsertPlan (bindInsertTargets (tableCols table) columns) (length columns)
-                (autoColumn table) checks (constraintPlan (tableCols table))
+        declared <- lookupTable catalog target
+        columnsEffective <- effectiveColumns catalog (tableCols declared)
+        let table = declared{tableCols = columnsEffective}
+        checks <- checkPlan catalog table
+        let plan =
+                InsertPlan
+                    (bindInsertTargets (tableCols table) columns)
+                    (length columns)
+                    (autoColumn table)
+                    checks
+                    (constraintPlan (tableCols table))
         Right (InsertAction target plan rows)
     Update target assignments condition -> do
-        table <- lookupTable catalog target
+        declared <- lookupTable catalog target
+        columnsEffective <- effectiveColumns catalog (tableCols declared)
+        let table = declared{tableCols = columnsEffective}
         bound <- bindUpdateTargets (tableCols table) assignments
-        checks <- checkPlan table
+        checks <- checkPlan catalog table
         let plan = UpdatePlan (map fst (tableCols table)) bound condition checks (constraintPlan (tableCols table))
         Right (UpdateAction target plan)
     Delete target condition -> do
@@ -116,7 +127,7 @@ bindWriteAction catalog statement = case statement of
     _ -> Right (StructureAction statement)
 
 -- | 直接执行已绑定的数据修改或结构动作
-executeWriteActionM :: MonadStorage m => Database -> WriteAction -> m (Either String [Row])
+executeWriteActionM :: (MonadStorage m) => Database -> WriteAction -> m (Either String [Row])
 executeWriteActionM _ (InsertAction target plan rows) = do
     current <- existingRows target plan
     case current >>= \current' -> buildRows plan current' rows of
@@ -151,14 +162,14 @@ executeWriteActionM catalog (DeleteAction target columns condition) = do
                         result <- replaceAll target kept
                         pure (result >> Right [])
   where
-    -- | 取整数主键，否则使用原有整表删除路径
+    -- \| 取整数主键，否则使用原有整表删除路径
     rowId row = case lookup "id" row of
         Just (VInt key) -> Right key
         _ -> Left "row has no integer id"
 executeWriteActionM catalog (StructureAction statement) = runStatementUncheckedM catalog statement
 
 -- | 绑定并执行查询语句
-runQueryM :: MonadStorage m => Database -> Statement -> m (Either String [Row])
+runQueryM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
 runQueryM db q = case bindQuery db q of
     Left e -> pure (Left e)
     Right bound -> executeQueryM bound
@@ -170,11 +181,19 @@ runStatementUncheckedM db q@Select{} = runQueryM db q
 runStatementUncheckedM _ Insert{} = pure (Left "INSERT requires a bound write plan")
 runStatementUncheckedM _ Update{} = pure (Left "UPDATE requires a bound write plan")
 runStatementUncheckedM _ Delete{} = pure (Left "DELETE requires a bound write plan")
-runStatementUncheckedM _ (CreateTable name cols) = do
-    result <- createTable name cols
+runStatementUncheckedM db (CreateTable name cols) = case validateDomainDefaults db cols of
+    Left err -> pure (Left err)
+    Right () -> do
+        result <- guardDomainCreation db (map (columnType . snd) cols) (createTable name cols)
         pure (result >> Right [])
-runStatementUncheckedM _ (CreateDomain name base) = do
-    result <- createTable (domainTableName name) [("base", plainColumn base)]
+runStatementUncheckedM db (CreateDomain name definition) = case canonicalDomain db name definition of
+    Left err -> pure (Left err)
+    Right normalized -> do
+        let DomainDefinition column _ = normalized
+        result <- guardDomainCreation db [columnType column] (createTable (domainTableName name) (domainColumns normalized))
+        pure (result >> Right [])
+runStatementUncheckedM _ (AlterDomain name action) = do
+    result <- alterDomain (domainTableName name) (prepareDomainAlter name action)
     pure (result >> Right [])
 runStatementUncheckedM _ (DropDomain name) = do
     result <- dropTable (domainTableName name)
@@ -201,7 +220,7 @@ runStatementUncheckedM _ (DropColumn tbl col) = do
     result <- dropColumn tbl col
     pure (result >> Right [])
 runStatementUncheckedM db (AddColumn tbl def) =
-    alterTable db tbl (\table -> addColumnTo def (tableCols table) (tableRows table))
+    alterTable db tbl (\table -> addColumnTo db def (tableCols table) (tableRows table))
 runStatementUncheckedM db (RenameColumn tbl old new) =
     alterTable db tbl (\table -> renameColumnIn old new (tableCols table) (tableRows table))
 runStatementUncheckedM db (AlterColumnType tbl col ty) =
@@ -228,12 +247,22 @@ runStatementUncheckedM _ q@DropDatabase{} = runStatementM q
 runStatementUncheckedM _ q@UseDatabase{} = runStatementM q
 runStatementUncheckedM _ ShowDatabases = runStatementM ShowDatabases
 runStatementUncheckedM _ BeginTransaction = pure (Left "BEGIN is executed by the session")
+runStatementUncheckedM _ BeginSerializableTransaction = pure (Left "BEGIN is executed by the session")
 runStatementUncheckedM _ CommitTransaction = pure (Left "COMMIT is executed by the session")
 runStatementUncheckedM _ RollbackTransaction = pure (Left "ROLLBACK is executed by the session")
 runStatementUncheckedM _ Savepoint{} = pure (Left "SAVEPOINT is executed by the session")
 runStatementUncheckedM _ RollbackToSavepoint{} = pure (Left "ROLLBACK TO is executed by the session")
 runStatementUncheckedM _ ReleaseSavepoint{} = pure (Left "RELEASE is executed by the session")
 
+-- | 建表时在实际发布点复查领域定义
+guardDomainCreation :: (MonadStorage m) => Database -> [ColumnType] -> m (Either String a) -> m (Either String a)
+guardDomainCreation db types action
+    | null dependencies = action
+    | otherwise = withWriteSchemaGuard dependencies action
+  where
+    names = typeDependencies db types
+    dependencies = [(name, table) | (name, table) <- db, name `elem` names]
+
 -- | 只有需要读全表才能判断约束时才扫表
 existingRows :: (MonadStorage m) => String -> InsertPlan -> m (Either String [Row])
 existingRows tbl (InsertPlan _ _ auto _ (ConstraintPlan _ _ unique))
@@ -317,11 +346,14 @@ autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup
     ns -> maximum ns + 1
 
 -- | 一次解析出来的 CHECK 条件
-data CheckPlan = CheckPlan [String] [(String, Expr)]
+data CheckPlan = CheckPlan [String] [(String, Expr)] [(String, Int, Expr)]
 
 -- | 按 schema 解析并绑定表上全部 CHECK
-checkPlan :: Table -> Either String CheckPlan
-checkPlan table = CheckPlan (map fst (tableCols table)) <$> mapM parse (mapMaybe checked (tableCols table))
+checkPlan :: Database -> Table -> Either String CheckPlan
+checkPlan db table = do
+    local <- mapM parse (mapMaybe checked (tableCols table))
+    domains <- domainCheckPlan db (tableCols table)
+    Right (CheckPlan (map fst (tableCols table)) local domains)
   where
     -- \| 只挑出带 CHECK 文本的列
     checked (name, col) = (,) name <$> columnCheck col
@@ -334,9 +366,10 @@ checkPlan table = CheckPlan (map fst (tableCols table)) <$> mapM parse (mapMaybe
 
 -- | 执行解析好的 CHECK 条件
 runChecks :: CheckPlan -> Row -> Either String ()
-runChecks (CheckPlan columns plan) row = do
+runChecks (CheckPlan columns plan domains) row = do
     ordered <- orderRow columns row
     mapM_ (check ordered) plan
+    runDomainChecks domains ordered
   where
     -- \| 跑一条 CHECK
     check ordered (name, e) = case evalCondForRow e ordered of
@@ -344,6 +377,16 @@ runChecks (CheckPlan columns plan) row = do
         Right True -> Right ()
         Right False -> Left ("CHECK on " ++ name ++ " failed")
 
+-- 校验最终行集的领域、检查与唯一约束。
+validateTableRows :: Database -> Table -> Either String ()
+validateTableRows db table = do
+    effective <- effectiveColumns db (tableCols table)
+    plan <- checkPlan db table
+    let rows = tableRows table
+    mapM_ (runChecks plan) rows
+    ordered <- mapM (orderRow (map fst effective)) rows
+    enforceConstraints (constraintPlan effective) [] ordered
+
 -- | 只取第一行（报错提示用）
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
@@ -370,7 +413,7 @@ enforceConstraints (ConstraintPlan columns required unique) current rows = do
 enforceNotNull :: [(String, Expr)] -> [Row] -> Either String ()
 enforceNotNull targets rows = mapM_ check targets
   where
-    -- | 按 schema 槽位检查 NOT NULL
+    -- \| 按 schema 槽位检查 NOT NULL
     check (name, reference) = do
         values <- mapM (evalExpr reference) rows
         if VNull `elem` values
@@ -411,7 +454,7 @@ data BoundAssignment = BoundAssignment Int String Column Expr
 bindUpdateTargets :: [(String, Column)] -> [(String, Expr)] -> Either String [BoundAssignment]
 bindUpdateTargets columns = mapM bindTarget
   where
-    -- | 只接受唯一目标并保留列定义
+    -- \| 只接受唯一目标并保留列定义
     bindTarget (name, expression) = case [(slot, column) | (slot, (key, column)) <- zip [0 ..] columns, key == name] of
         [(slot, column)] -> Right (BoundAssignment slot name column expression)
         [] -> Left ("UPDATE: unknown target column: " ++ name)
@@ -429,7 +472,9 @@ applyUpdatesM db (assignment@(BoundAssignment _ _ _ e) : rest) row = do
 -- | 校验目标位置并只覆盖该槽位的值
 writeAssignment :: BoundAssignment -> Row -> Value -> Either String Row
 writeAssignment (BoundAssignment slot name column _) row value = case splitAt slot row of
-    (before, (key, _) : after) | slot >= 0, key == name -> do
+    (before, (key, _) : after)
+        | slot >= 0
+        , key == name -> do
             coerced <- coerceValue (columnType column) value
             Right (before ++ ((name, coerced) : after))
     (_, []) -> Left ("missing bound column: " ++ name)
@@ -471,20 +516,23 @@ alterTable db tbl change = case lookupTable db tbl of
     -- \| 改完再统一查一遍约束
     checkAltered (cols, rows) = do
         let table = Table tbl cols rows Nothing Nothing Nothing
-        plan <- checkPlan table
-        mapM_ (runChecks plan) rows
-        enforceConstraints (constraintPlan cols) [] rows
+        validateDomainDefaults db cols
+        validateTableRows db table
         Right (cols, rows)
 
 -- | ADD COLUMN：老行补默认值或 NULL
-addColumnTo :: (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
-addColumnTo (name, col) cols rows
+addColumnTo :: Database -> (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
+addColumnTo db (name, declared) cols rows
     | name `elem` map fst cols = Left ("ADD COLUMN: column already exists: " ++ name)
     | otherwise = do
-        values <- fill
-        Right (cols ++ [(name, col)], [r ++ [(name, v)] | (r, v) <- zip rows values])
+        effective <- effectiveColumns db [(name, declared)]
+        values <- case effective of
+            [(_, column)] -> fill column
+            _ -> Left "invalid added column layout"
+        Right (cols ++ [(name, declared)], [r ++ [(name, v)] | (r, v) <- zip rows values])
   where
-    fill
+    -- \| 使用领域继承属性填充已有行
+    fill col
         | columnAutoIncrement col = mapM (coerceValue (columnType col) . VInt) [1 .. length rows]
         | Just d <- columnDefault col = mapM (\_ -> coerceValue (columnType col) d) rows
         | columnNullable col = mapM (\_ -> coerceValue (columnType col) VNull) rows

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Cost.hs

@@ -1,7 +1,7 @@
 module ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf, probeCost, pointRows, rangeRows, selectivityOf, indexCheaper) where
 
-import Data.Maybe (fromMaybe)
 import ChuSQL.Core.Model
+import Data.Maybe (fromMaybe)
 
 -- 统计与成本估算：行数、不同值数、列直方图与索引探路页数。
 
@@ -33,9 +33,9 @@ estimateRows h lo hi = max 0 (min total (round (sum (zipWith overlap [0 ..] (his
   where
     total = sum (histBuckets h)
     width = if histHigh h > histLow h then (histHigh h - histLow h) / fromIntegral (length (histBuckets h)) else 0
-    lower = fromMaybe (- (1 / 0)) (boundOf lo)
+    lower = fromMaybe (-(1 / 0)) (boundOf lo)
     upper = fromMaybe (1 / 0) (boundOf hi)
-    -- | 第 i 个桶与区间重叠的行数
+    -- \| 第 i 个桶与区间重叠的行数
     overlap :: Int -> Int -> Double
     overlap i count
         | width <= 0 = if lower <= histLow h && histLow h <= upper then fromIntegral count else 0

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Eval.hs

@@ -1,24 +1,26 @@
 {-# LANGUAGE TupleSections #-}
+
 module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
 
 import ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf)
-import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, hasSubquery, quantifiedCompare, subquerySlotsIn, subqueryColumns)
-import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
+import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, hasSubquery, quantifiedCompare, subqueryColumns, subquerySlotsIn)
 import ChuSQL.Core.Engine.Algebra.Op
+import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
 import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Core.Engine.Algebra.Sort (sortRows, sortBoundRows)
+import ChuSQL.Core.Engine.Algebra.Sort (sortBoundRows, sortRows)
+import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, inValues, invokeBuiltin, unsupportedAggregate)
 import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns, orderRow)
-import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, invokeBuiltin, unsupportedAggregate, inValues)
-import ChuSQL.Core.Model
 import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
 import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage)
 import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Subquery (..))
+import ChuSQL.Core.Model
 import Control.Monad (filterM)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.State.Strict (StateT, evalStateT, gets, modify')
+import Data.Bifunctor (first)
+import Data.HashMap.Strict qualified as HM
+import Data.HashSet qualified as HS
 import Data.List (nub)
-import qualified Data.HashMap.Strict as HM
-import qualified Data.HashSet as HS
 
 -- 执行：按算子树算出结果行，外层行供相关子查询引用。
 
@@ -26,7 +28,7 @@ import qualified Data.HashSet as HS
 type Execution m a = StateT (HM.HashMap String [Row]) m a
 
 -- | 首次使用时执行，成功结果供后续引用复用
-materialize :: Monad m => String -> Execution m (Either String [Row]) -> Execution m (Either String [Row])
+materialize :: (Monad m) => String -> Execution m (Either String [Row]) -> Execution m (Either String [Row])
 materialize key action = do
     cached <- gets (HM.lookup key)
     case cached of
@@ -46,7 +48,7 @@ project cs row = [(c, v) | c <- cs, Just v <- [lookup c row]]
 
 -- | 给列名加别名前缀
 addPrefix :: Maybe String -> Row -> Row
-addPrefix mAlias = map (\(k, v) -> (qualify mAlias k, v))
+addPrefix mAlias = map (first (qualify mAlias))
 
 -- | 给一批行加别名前缀
 prefixRows :: Maybe String -> [Row] -> [Row]
@@ -74,7 +76,7 @@ rangeCondition mAlias col lo hi = case (lo, hi) of
     (Nothing, Nothing) -> LitBool True
   where
     c = Col (qualify mAlias col)
-    -- | 一个端点的比较，闭端再加上等号
+    -- \| 一个端点的比较，闭端再加上等号
     bound rel (v, inclusive)
         | inclusive = Or (rel c (valueLiteral v)) (Eq c (valueLiteral v))
         | otherwise = rel c (valueLiteral v)
@@ -102,10 +104,18 @@ data EquiKeys = EquiKeys
 -- | 认出 a = b 这种两列等值条件，并且能分清谁在左谁在右
 equiKeys :: [String] -> [String] -> Expr -> Maybe EquiKeys
 equiKeys lcols rcols (Eq left right)
-    | Just a <- columnName left, Just b <- columnName right
-    , a /= b, a `elem` lcols, b `elem` rcols = Just (EquiKeys a b)
-    | Just a <- columnName left, Just b <- columnName right
-    , a /= b, b `elem` lcols, a `elem` rcols = Just (EquiKeys b a)
+    | Just a <- columnName left
+    , Just b <- columnName right
+    , a /= b
+    , a `elem` lcols
+    , b `elem` rcols =
+        Just (EquiKeys a b)
+    | Just a <- columnName left
+    , Just b <- columnName right
+    , a /= b
+    , b `elem` lcols
+    , a `elem` rcols =
+        Just (EquiKeys b a)
 equiKeys _ _ _ = Nothing
 
 -- | 提取执行列的诊断名称
@@ -144,26 +154,32 @@ semiRows kind left right outer leftRows rightRows = do
     let keys = HS.fromList [canonicalValue value | value <- values, value /= VNull]
         hasNull = VNull `elem` values
         hashSafe = all safeNumber values
-        -- | NULL 与数值边界沿用表达式比较规则
+        -- \| NULL 与数值边界沿用表达式比较规则
         keep row = do
             value <- evalExpr left (row ++ outer)
             if value == VNull
                 then Right (kind == NonMatching || kind == NotIn && null values)
-                else if hashSafe && safeNumber value
-                    then let found = HS.member (canonicalValue value) keys
-                         in Right (case kind of
+                else
+                    if hashSafe && safeNumber value
+                        then
+                            let found = HS.member (canonicalValue value) keys
+                             in Right
+                                    ( case kind of
                                         Matching -> found
                                         NonMatching -> not found
-                             NotIn -> not found && not hasNull)
+                                        NotIn -> not found && not hasNull
+                                    )
                         else do
                             result <- inValues value values
-                        Right (case kind of
+                            Right
+                                ( case kind of
                                     Matching -> result == VBool True
                                     NonMatching -> result /= VBool True
-                            NotIn -> result == VBool False)
+                                    NotIn -> result == VBool False
+                                )
     filterM keep leftRows
   where
-    -- | 大数混合比较退回既有逐值语义
+    -- \| 大数混合比较退回既有逐值语义
     safeNumber (VInt value) = abs (toInteger value) <= 9007199254740992
     safeNumber (VFloat value) = abs value <= 9007199254740992
     safeNumber _ = True
@@ -178,7 +194,7 @@ hashJoin :: JoinKind -> EquiKeys -> [String] -> [Row] -> [Row] -> [Row]
 hashJoin kind ks ncols lrows rrows = concatMap probe lrows
   where
     buckets = HM.fromListWith (flip (++)) [(v, [r]) | r <- rrows, Just v <- [joinKeyOf (ekRight ks) r]]
-    -- | 拿左行的键去桶里找
+    -- \| 拿左行的键去桶里找
     probe l =
         let miss = case kind of
                 InnerJoin -> []
@@ -204,7 +220,7 @@ filterPairsM ::
 filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
   where
     refs = subquerySlotsIn cond
-    -- | 逐左行配对，左连接没配上就补 NULL
+    -- \| 逐左行配对，左连接没配上就补 NULL
     go [] acc _ = pure (Right (reverse acc))
     go (l : ls) acc cache = do
         hits <- keep l rrows [] cache
@@ -215,7 +231,7 @@ filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
                         (LeftJoin, []) -> [l ++ nullRow]
                         _ -> hs
                 go ls (reverse hs' ++ acc) nextCache
-    -- | 拿一行右行去比条件
+    -- \| 拿一行右行去比条件
     keep _ [] acc cache = pure (Right (reverse acc, cache))
     keep l (r : rs) acc cache = do
         let env = l ++ r ++ outer
@@ -259,13 +275,18 @@ probeIndexJoin db outer kind mAlias t ks rcols cond l = case lookup (ekLeft ks)
                         Left err -> pure (Left err)
                         Right ordered -> fmap (fmap Just) (joinRowsIn db outer kind rcols cond [l] ordered)
 
--- | 列与键都不是浮点时才敢用索引
+-- | 仅用已支持且无浮点歧义的索引键
 indexSafe :: Database -> String -> String -> Value -> Bool
 indexSafe db t col k = case lookupTable db t of
     Left _ -> False
     Right tbl -> case lookup col (tableCols tbl) of
         Nothing -> False
-        Just c -> not (floatType (columnType c)) && not (floatValue k)
+        Just c -> scalarKey k && not (floatType (columnType c)) && not (floatValue k)
+  where
+    -- \| 只有已实现编码的键可以点查
+    scalarKey VInt{} = True
+    scalarKey VStr{} = True
+    scalarKey _ = False
 
 -- | 是不是浮点列类型
 floatType :: ColumnType -> Bool
@@ -288,7 +309,7 @@ groupKey outer keys row = mapM (\key -> evalExpr key (row ++ outer)) keys
 groupRows :: Row -> [Expr] -> [Row] -> Either String [([Value], [Row])]
 groupRows outer keys rows = go rows (HM.empty, [])
   where
-    -- | 逐行塞进对应分组，并记住分组首次出现的顺序
+    -- \| 逐行塞进对应分组，并记住分组首次出现的顺序
     go [] (acc, order) = Right [(k, reverse (HM.lookupDefault [] k acc)) | k <- reverse order]
     go (r : rs) (acc, order) = do
         k <- groupKey outer keys r
@@ -342,7 +363,7 @@ bindingValue column env = case lookup column env of
 bindingSamples :: [Expr] -> Row -> [Row] -> Either String [(String, Row)]
 bindingSamples refs outer rows = go rows HM.empty []
   where
-    -- | 逐行按绑定键去重
+    -- \| 逐行按绑定键去重
     go [] _ acc = Right (reverse acc)
     go (r : rs) seen acc = do
         let env = r ++ outer
@@ -366,7 +387,7 @@ bindingsTableM db outer exprs rows = case bindingSamples refs outer rows of
         pure (fmap HM.fromList (sequence built))
   where
     refs = nub (concatMap subquerySlotsIn exprs)
-    -- | 一个绑定样本上把子查询全换成字面量
+    -- \| 一个绑定样本上把子查询全换成字面量
     swap (key, env) = do
         es <- mapM (\e -> substSubqueries db e env) exprs
         pure (fmap (key,) (sequence es))
@@ -391,7 +412,7 @@ boundExpr refs env table = do
 filterRowsM :: (Monad m) => (Row -> m (Either String Bool)) -> [Row] -> m (Either String [Row])
 filterRowsM p = go []
   where
-    -- | 逐行留下通过条件的
+    -- \| 逐行留下通过条件的
     go acc [] = pure (Right (reverse acc))
     go acc (r : rs) = do
         keep <- p r
@@ -404,7 +425,7 @@ filterRowsM p = go []
 computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> Execution m (Either String Row)
 computeM db outer items row = go items []
   where
-    -- | 逐项求值并攒成一行
+    -- \| 逐项求值并攒成一行
     go [] acc = pure (Right (reverse acc))
     go ((label, e) : rest) acc = do
         v <- evalExprIn db e (row ++ outer)
@@ -417,7 +438,7 @@ evalExprM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Val
 evalExprM db e env = evalStateT (evalExprIn db e env) HM.empty
 
 -- | 在当前执行中求值并共享子查询物化
-evalExprIn :: MonadStorage m => Database -> Expr -> Row -> Execution m (Either String Value)
+evalExprIn :: (MonadStorage m) => Database -> Expr -> Row -> Execution m (Either String Value)
 evalExprIn db e env = do
     e' <- substSubqueries db e env
     pure (e' >>= \x -> evalExpr x env)
@@ -427,7 +448,7 @@ evalCondForRowM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either Stri
 evalCondForRowM db e env = evalStateT (evalCondIn db e env) HM.empty
 
 -- | 在当前执行中判定条件并共享物化
-evalCondIn :: MonadStorage m => Database -> Expr -> Row -> Execution m (Either String Bool)
+evalCondIn :: (MonadStorage m) => Database -> Expr -> Row -> Execution m (Either String Bool)
 evalCondIn db e env = do
     e' <- substSubqueries db e env
     pure (e' >>= \x -> evalCondForRow x env)
@@ -465,29 +486,35 @@ substSubqueries db e env = case e of
     InSub a sq negated -> do
         lhs <- substSubqueries db a env
         rows <- runSubqueryRows db sq env
-        pure (do
+        pure
+            ( do
                 a' <- lhs
                 rs <- rows
                 vs <- mapM rowValue rs
-            Right (InList a' (map valueLiteral vs) negated))
+                Right (InList a' (map valueLiteral vs) negated)
+            )
     ExistsSub sq negated -> do
         rows <- runSubqueryRows db sq env
         pure (fmap (\rs -> LitBool (if negated then null rs else not (null rs))) rows)
     QuantCmp op a sq q -> do
         lhs <- substSubqueries db a env
         rows <- runSubqueryRows db sq env
-        pure (do
+        pure
+            ( do
                 a' <- lhs
                 rs <- rows
                 vs <- mapM rowValue rs
-            Right (quantifiedCompare op a' (map valueLiteral vs) q))
+                Right (quantifiedCompare op a' (map valueLiteral vs) q)
+            )
     InList a es negated -> do
         lhs <- substSubqueries db a env
         es' <- mapM (\x -> substSubqueries db x env) es
-        pure (do
+        pure
+            ( do
                 a' <- lhs
                 items <- sequence es'
-            Right (InList a' items negated))
+                Right (InList a' items negated)
+            )
     Add a b -> bin Add a b
     Sub a b -> bin Sub a b
     Mul a b -> bin Mul a b
@@ -510,7 +537,7 @@ substSubqueries db e env = case e of
     MaxOf a -> un MaxOf a
     _ -> pure (Right e)
   where
-    -- | 递归处理两个子表达式
+    -- \| 递归处理两个子表达式
     bin ctor a b = do
         ra <- substSubqueries db a env
         case ra of
@@ -518,7 +545,7 @@ substSubqueries db e env = case e of
             Right a' -> do
                 rb <- substSubqueries db b env
                 pure (ctor a' <$> rb)
-    -- | 递归处理一个子表达式
+    -- \| 递归处理一个子表达式
     un ctor a = do
         ra <- substSubqueries db a env
         pure (ctor <$> ra)
@@ -531,14 +558,16 @@ runSubqueryRows db sq outer = case translate (subqueryStatement sq) of
         Left err -> pure (Left err)
         Right bindings -> case bindRelOpColumns db (map fst (bindings ++ outer)) (optimize db op) of
             Left err -> pure (Left err)
-            Right bound -> materialize (show ("subquery", subqueryStatement sq, bindings, fallback))
+            Right bound ->
+                materialize
+                    (show ("subquery", subqueryStatement sq, bindings, fallback))
                     (evalRelOpIn db (bindings ++ outer) bound)
   where
-    -- | 原始调用未证明依赖完整，保留整个外层行
+    -- \| 原始调用未证明依赖完整，保留整个外层行
     fallback = case sq of
         Subquery{} -> Just outer
         BoundSubquery{} -> Nothing
-    -- | 给外层物理列补回已解析的限定名
+    -- \| 给外层物理列补回已解析的限定名
     bind (column, expression) = (,) column <$> bindingReferenceValue expression outer
 
 -- | 单子求值：Scan/点查/范围查都问存储
@@ -567,7 +596,7 @@ evalRelOpIn db outer (Compute items op) = do
                 pure (table >>= \t -> traverse (computeBound t) rs)
   where
     refs = nub (concatMap (subquerySlotsIn . snd) items)
-    -- | 用这一行绑定换好的表达式算出一行
+    -- \| 用这一行绑定换好的表达式算出一行
     computeBound table r = do
         es <- boundExprs refs (r ++ outer) table
         mapM (\(label, e) -> (,) label <$> evalExpr e (r ++ outer)) (zip (map fst items) es)
@@ -603,7 +632,7 @@ evalRelOpIn db outer (Filter e op) = do
                 pure (table >>= \t -> filterM (keepBound t) rs)
   where
     refs = nub (subquerySlotsIn e)
-    -- | 用这一行绑定换好的条件判定
+    -- \| 用这一行绑定换好的条件判定
     keepBound table r = do
         e' <- boundExpr refs (r ++ outer) table
         evalCondForRow e' (r ++ outer)
@@ -631,7 +660,7 @@ evalRelOpIn db outer (SemiJoin kind left right l r query) = do
         Left err -> pure (Left err)
         Right [] -> pure (Right [])
         Right leftRows -> do
-            -- | 独立 IN 沿用子查询身份，跨算子复用结果
+            -- \| 独立 IN 沿用子查询身份，跨算子复用结果
             let key = case query of
                     Just statement -> show ("subquery", statement, [] :: Row, Nothing :: Maybe Row)
                     Nothing -> show ("derived", r, outer)
@@ -684,14 +713,14 @@ scanTable db tbl cols = do
         then lift (scanShards width tbl cols)
         else lift (maybe (scan tbl) (scanColumns tbl) cols)
   where
-    -- | 统计里的行数，没有统计算 0
+    -- \| 统计里的行数，没有统计算 0
     rows = maybe 0 metaRowCount (tableMetaOf db tbl)
 
 -- | 按输出值去重并保留首次行序
 distinctRows :: [Row] -> [Row]
 distinctRows = go HS.empty
   where
-    -- | 只输出尚未遇到的值组合
+    -- \| 只输出尚未遇到的值组合
     go _ [] = []
     go seen (row : rows)
         | HS.member key seen = go seen rows

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Expr.hs

@@ -1,9 +1,9 @@
 module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, subqueryRefsIn, subquerySlotsIn, subqueryColumns, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot, quantifiedCompare) where
 
-import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator, inValues, threeValuedNot)
-import ChuSQL.Core.Engine.Runtime.SQL (invokeSQLFunction, constructSQLValue)
+import ChuSQL.Core.Engine.Runtime.SQL (constructSQLValue, invokeSQLFunction)
+import ChuSQL.Core.Engine.Syntax.AST
+import ChuSQL.Core.Model
 
 -- 表达式求值：三值逻辑，NULL 参与运算结果仍是 NULL。
 
@@ -59,9 +59,9 @@ evalExpr (InList a es negated) row = do
     r <- inValues v vs
     Right (if negated then threeValuedNot r else r)
 evalExpr (ScalarSub _) _ = Left subqueryNeedsDatabase
-evalExpr (InSub {}) _ = Left subqueryNeedsDatabase
+evalExpr (InSub{}) _ = Left subqueryNeedsDatabase
 evalExpr (ExistsSub _ _) _ = Left subqueryNeedsDatabase
-evalExpr (QuantCmp {}) _ = Left subqueryNeedsDatabase
+evalExpr (QuantCmp{}) _ = Left subqueryNeedsDatabase
 evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
 
 -- | 子查询要连上存储才能跑
@@ -157,9 +157,9 @@ subqueryReferences references e = case e of
     MaxOf a -> collect a
     _ -> []
   where
-    -- | 递归收集当前提取器的引用
+    -- \| 递归收集当前提取器的引用
     collect = subqueryReferences references
-    -- | 两个子表达式的外层列拼起来
+    -- \| 两个子表达式的外层列拼起来
     both a b = collect a ++ collect b
 
 -- | 表达式里有没有除法（除法可能报错，不能提前或延后求值）
@@ -185,7 +185,7 @@ hasDivision e = case e of
     QuantCmp _ a _ _ -> hasDivision a
     _ -> False
   where
-    -- | 两个子表达式里任意一个有除法
+    -- \| 两个子表达式里任意一个有除法
     both a b = hasDivision a || hasDivision b
 
 -- | 表达式里有没有子查询
@@ -196,10 +196,10 @@ hasSubquery e = case e of
     FunctionCall _ arguments -> any hasSubquery arguments
     BoundFunction _ _ arguments -> any hasSubquery arguments
     ScalarSub _ -> True
-    InSub {} -> True
+    InSub{} -> True
     InList a es _ -> any hasSubquery (a : es)
     ExistsSub _ _ -> True
-    QuantCmp {} -> True
+    QuantCmp{} -> True
     Add a b -> both a b
     Sub a b -> both a b
     Mul a b -> both a b
@@ -222,7 +222,7 @@ hasSubquery e = case e of
     MaxOf a -> hasSubquery a
     _ -> False
   where
-    -- | 两个子表达式里任意一个有
+    -- \| 两个子表达式里任意一个有
     both a b = hasSubquery a || hasSubquery b
 
 -- | 表达式里出现的聚合调用（按出现顺序）
@@ -258,7 +258,7 @@ aggregatesIn e = case e of
     IsNotNull a -> aggregatesIn a
     _ -> []
   where
-    -- | 两个子表达式的聚合拼起来
+    -- \| 两个子表达式的聚合拼起来
     both a b = aggregatesIn a ++ aggregatesIn b
 
 -- | 表达式里有没有聚合调用
@@ -297,7 +297,7 @@ bareColumns e = case e of
     QuantCmp _ a sq _ -> bareColumns a ++ subqueryRefs sq
     _ -> []
   where
-    -- | 两个子表达式的裸列拼起来
+    -- \| 两个子表达式的裸列拼起来
     both a b = bareColumns a ++ bareColumns b
 
 -- | 判断条件真假：只有 TRUE 通过，NULL 当作不通过

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/JoinOrder.hs

@@ -1,12 +1,12 @@
 module ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins) where
 
-import Data.Maybe (fromMaybe)
 import ChuSQL.Core.Engine.Algebra.Cost (pointRows, rangeRows, selectivityOf, tableMetaOf)
 import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, hasDivision, hasSubquery)
 import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
 import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
 import ChuSQL.Core.Model
 import Data.List (partition)
+import Data.Maybe (fromMaybe)
 
 -- 内连接链顺序优化：按统计估算中间结果，只在行序不可观察处重排。
 
@@ -40,7 +40,7 @@ innerChain (Join InnerJoin l r c) = do
     (ls, lcs) <- innerChain l
     (rs, rcs) <- innerChain r
     pure (ls ++ rs, lcs ++ rcs ++ [c])
-innerChain (Join {}) = Nothing
+innerChain (Join{}) = Nothing
 innerChain op = Just ([op], [])
 
 -- | 叶子算子的估算行数，拿不到统计就是 Nothing
@@ -81,7 +81,7 @@ scaleRows db p x rows = case p of
     GtE _ _ -> quarter
     LtE _ _ -> quarter
     NotEq _ _ -> quarter
-    QuantCmp {} -> quarter
+    QuantCmp{} -> quarter
     And a b -> max 1 (min (scaleRows db a x rows) (scaleRows db b x rows))
     _ -> quarter
   where
@@ -89,7 +89,8 @@ scaleRows db p x rows = case p of
     pick k lo hi = case leafSource x of
         Just (alias, t)
             | Just m <- tableMetaOf db t
-            , Just s <- selectivityOf m (unqualify alias k) lo hi -> max 1 (round (fromIntegral rows * s))
+            , Just s <- selectivityOf m (unqualify alias k) lo hi ->
+                max 1 (round (fromIntegral rows * s))
         _ -> quarter
 
 -- | 叶子对应的别名与表名
@@ -103,7 +104,8 @@ leafSource _ = Nothing
 
 -- | 某列在叶子统计里的不同值数
 distinctOf :: Database -> RelOp -> String -> Maybe Int
-distinctOf db leaf col = do (alias, t) <- leafSource leaf
+distinctOf db leaf col = do
+    (alias, t) <- leafSource leaf
     m <- tableMetaOf db t
     lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
 
@@ -121,12 +123,12 @@ keyDistinct db have x conds = case [v | Eq (Col a) (Col b) <- conds, Just v <- [
   where
     haveCols = concatMap (relOpCols db) have
     xCols = relOpCols db x
-    -- | 这一对列是不是两侧之间的等值键
+    -- \| 这一对列是不是两侧之间的等值键
     pair a b
         | a `elem` haveCols, b `elem` xCols = bigger (distinctOn db have a) (distinctOf db x b)
         | b `elem` haveCols, a `elem` xCols = bigger (distinctOn db have b) (distinctOf db x a)
         | otherwise = Nothing
-    -- | 两个可选统计取大的那个
+    -- \| 两个可选统计取大的那个
     bigger (Just a) (Just b) = Just (max a b)
     bigger (Just a) Nothing = Just a
     bigger Nothing (Just b) = Just b
@@ -144,7 +146,7 @@ stepRows db have acc x conds = case keyDistinct db have x conds of
 chainCost :: Database -> [RelOp] -> [Expr] -> Int
 chainCost db (l : ls) conds = go [l] (fromMaybe 1 (leafRows db l)) ls
   where
-    -- | 逐步接上后面的叶子
+    -- \| 逐步接上后面的叶子
     go _ _ [] = 0
     go have acc (x : xs) =
         let card = stepRows db have acc x conds
@@ -159,11 +161,11 @@ growOrder db leaves conds have rest = case rest of
         let next = pick rest
          in growOrder db leaves conds (have ++ [next]) (filter (/= next) rest)
   where
-    -- | 候选里成本最低的那个，同价取序号小的
+    -- \| 候选里成本最低的那个，同价取序号小的
     pick (i : is) = foldl cheaper i is
     pick [] = 0
     cheaper i j = if costOf j < costOf i then j else i
-    -- | 这个前缀的估算成本
+    -- \| 这个前缀的估算成本
     costOf i = chainCost db [leaves !! k | k <- have ++ [i]] conds
 
 -- | 每个起点贪心一遍，取最便宜的顺序
@@ -171,13 +173,13 @@ bestOrder :: Database -> [RelOp] -> [Expr] -> [RelOp]
 bestOrder db leaves conds = pick (map start [0 .. n - 1])
   where
     n = length leaves
-    -- | 从第 i 张表开始的贪心顺序
+    -- \| 从第 i 张表开始的贪心顺序
     start i = [leaves !! k | k <- growOrder db leaves conds [i] (filter (/= i) [0 .. n - 1])]
-    -- | 成本最低的那个
+    -- \| 成本最低的那个
     pick (o : os) = foldl cheaper o os
     pick [] = []
     cheaper o o' = if cost o' < cost o then o' else o
-    -- | 一个顺序的估算成本
+    -- \| 一个顺序的估算成本
     cost o = chainCost db o conds
 
 -- | 统计齐全、没有除法且确实更省时给出新顺序
@@ -188,7 +190,7 @@ cheaperOrder db leaves conds
     | bestCost < textCost = Just best
     | otherwise = Nothing
   where
-    -- | 这个叶子是不是拿不到统计
+    -- \| 这个叶子是不是拿不到统计
     unknown x = case leafRows db x of
         Just _ -> False
         Nothing -> True
@@ -200,13 +202,13 @@ cheaperOrder db leaves conds
 rebuildChain :: Database -> [RelOp] -> [Expr] -> RelOp
 rebuildChain db (l : ls) conds = go (relOpCols db l) l ls conds
   where
-    -- | 逐个接上后面的叶子
+    -- \| 逐个接上后面的叶子
     go _ acc [] rest = applyConds rest acc
     go have acc (x : xs) rest =
         let have' = have ++ relOpCols db x
             (now, later) = partition (\c -> colsInExpr c `subsetOf` have') rest
          in go have' (Join InnerJoin acc x (conjOf now)) xs later
-    -- | 若干条件用 AND 串起来
+    -- \| 若干条件用 AND 串起来
     conjOf [] = LitBool True
     conjOf (c : cs) = foldl And c cs
 rebuildChain _ [] _ = Unit

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Op.hs

@@ -1,7 +1,7 @@
 module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols, renderPlan) where
 
+import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir, Statement)
 import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST (Expr, Statement, JoinKind (..), SortDir)
 
 -- 关系代数算子定义、输出列推导与算子树文本渲染。
 
@@ -23,8 +23,8 @@ data RelOp
     | BoundSort [(Expr, SortDir)] RelOp
     | Limit Int RelOp
     | Join JoinKind RelOp RelOp Expr
-    -- | 末项仅保存独立 IN 的物化身份
-    | SemiJoin SemiKind Expr Expr RelOp RelOp (Maybe Statement)
+    | -- | 末项仅保存独立 IN 的物化身份
+      SemiJoin SemiKind Expr Expr RelOp RelOp (Maybe Statement)
     | Derived (Maybe String) RelOp
     deriving (Show, Eq)
 
@@ -63,7 +63,7 @@ kindLabel LeftJoin = "LeftJoin"
 renderPlan :: RelOp -> String
 renderPlan = go 0
   where
-    -- | 按缩进渲染一个算子
+    -- \| 按缩进渲染一个算子
     go ind op = case op of
         Scan a t cols -> pad ++ "Scan " ++ show a ++ " " ++ show t ++ maybe "" ((" columns=" ++) . show) cols
         Lookup _ t c k -> pad ++ "Lookup " ++ show t ++ "." ++ show c ++ " = " ++ show k
@@ -80,15 +80,29 @@ renderPlan = go 0
                 ++ "\n"
                 ++ go (ind + 1) x
         Distinct x -> pad ++ "Distinct\n" ++ go (ind + 1) x
-        BoundAggregate keys aggs x -> pad ++ "BoundAggregate keys=" ++ show keys
-            ++ " aggs=" ++ show aggs ++ "\n" ++ go (ind + 1) x
+        BoundAggregate keys aggs x ->
+            pad
+                ++ "BoundAggregate keys="
+                ++ show keys
+                ++ " aggs="
+                ++ show aggs
+                ++ "\n"
+                ++ go (ind + 1) x
         Unit -> pad ++ "Unit"
         Sort s x -> pad ++ "Sort " ++ show s ++ "\n" ++ go (ind + 1) x
         BoundSort s x -> pad ++ "BoundSort " ++ show s ++ "\n" ++ go (ind + 1) x
         Limit n x -> pad ++ "Limit " ++ show n ++ "\n" ++ go (ind + 1) x
         Join k l r c -> pad ++ kindLabel k ++ " on " ++ show c ++ "\n" ++ go (ind + 1) l ++ "\n" ++ go (ind + 1) r
-        SemiJoin k left right l r _ -> pad ++ "SemiJoin " ++ show k ++ " keys=" ++ show (left, right)
-            ++ "\n" ++ go (ind + 1) l ++ "\n" ++ go (ind + 1) r
+        SemiJoin k left right l r _ ->
+            pad
+                ++ "SemiJoin "
+                ++ show k
+                ++ " keys="
+                ++ show (left, right)
+                ++ "\n"
+                ++ go (ind + 1) l
+                ++ "\n"
+                ++ go (ind + 1) r
         Derived a x -> pad ++ "Derived " ++ show a ++ "\n" ++ go (ind + 1) x
       where
         pad = replicate (ind * 2) ' '

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Optimize.hs

@@ -5,8 +5,8 @@ import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr, hasDivision)
 import ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins)
 import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols)
 import ChuSQL.Core.Engine.Algebra.Planner (translate)
+import ChuSQL.Core.Engine.Syntax.AST (Expr (..), FromClause (..), JoinKind (..), Statement (..), Subquery (..))
 import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Statement (..), FromClause (..), Subquery (..))
 import Data.List (nub)
 
 -- 查询优化：谓词下推、投影下推、常量折叠、扫描方式与连接顺序选择。
@@ -30,7 +30,7 @@ combineConj (e : es) = Just (foldl And e es)
 partitionPred :: [String] -> [Expr] -> ([Expr], [Expr])
 partitionPred have = foldr pick ([], [])
   where
-    -- | 按列归属收到左边或右边
+    -- \| 按列归属收到左边或右边
     pick e (yes, no)
         | colsInExpr e `isSubsetOf` have = (e : yes, no)
         | otherwise = (yes, e : no)
@@ -111,8 +111,13 @@ pushProject db _ (Distinct x) = Distinct (pushProject db (relOpCols db x) x)
 pushProject db need (Sort spec x) = Sort spec (pushProject db (need ++ map fst spec) x)
 pushProject db need (Limit n x) = Limit n (pushProject db need x)
 pushProject db need (SemiJoin kind left right l r query) =
-    SemiJoin kind left right (pushProject db (need ++ colsInExpr left) l)
-        (pushProject db (colsInExpr right) r) query
+    SemiJoin
+        kind
+        left
+        right
+        (pushProject db (need ++ colsInExpr left) l)
+        (pushProject db (colsInExpr right) r)
+        query
 pushProject db need (Join kind l r c)
     | needsAll need = Join kind (pushProject db need l) (pushProject db need r) c
     | otherwise =
@@ -128,15 +133,15 @@ pushProject db need leaf@(Scan a t _)
     | otherwise = Scan a t (Just (nub [column | requested <- need, let column = physicalColumn requested, column `elem` available]))
   where
     available = map (unqualify a) (relOpCols db (Scan a t Nothing))
-    -- | 把扫描限定列换成存储物理列名
+    -- \| 把扫描限定列换成存储物理列名
     physicalColumn column = unqualify (Just (deriveQualifier a t)) (unqualify a column)
 pushProject db need (Derived a x)
     | needsAll need || all (`elem` wanted) (relOpCols db x) = Derived a (pushProject db ["*"] x)
     | otherwise = Derived a (Project wanted (pushProject db wanted x))
   where
     wanted = nub (map (unqualify a) need)
-pushProject db need leaf@(Lookup {}) = pushProjectLeaf db need leaf
-pushProject db need leaf@(Range {}) = pushProjectLeaf db need leaf
+pushProject db need leaf@(Lookup{}) = pushProjectLeaf db need leaf
+pushProject db need leaf@(Range{}) = pushProjectLeaf db need leaf
 
 -- | 折一个表达式节点
 foldNode :: Expr -> Expr
@@ -186,9 +191,11 @@ worthRange db t col lo hi = case tableMetaOf db t of
 -- | 将独立 IN 或简单等值 EXISTS 变为半连接
 semiJoin :: Database -> Expr -> RelOp -> Maybe RelOp
 semiJoin db (InSub left query negated) source
-    | null (subqueryRefs query), safeKey left
+    | null (subqueryRefs query)
+    , safeKey left
     , Right right <- translate (subqueryStatement query)
-    , [column] <- relOpCols db right, column /= "*" =
+    , [column] <- relOpCols db right
+    , column /= "*" =
         Just (SemiJoin (if negated then NotIn else Matching) left (Col column) source right (Just (subqueryStatement query)))
 semiJoin db (ExistsSub query negated) source
     | [reference] <- subqueryRefs query
@@ -199,8 +206,15 @@ semiJoin db (ExistsSub query negated) source
     , Just column <- localKey columns reference a b
     , let physical = if reference `elem` relOpCols db source then reference else reverse (takeWhile (/= '.') (reverse reference))
     , physical `elem` relOpCols db source =
-        Just (SemiJoin (if negated then NonMatching else Matching) (Col physical) (Col "$semikey") source
-            (Compute (items ++ [("$semikey", Col column)]) scan) Nothing)
+        Just
+            ( SemiJoin
+                (if negated then NonMatching else Matching)
+                (Col physical)
+                (Col "$semikey")
+                source
+                (Compute (items ++ [("$semikey", Col column)]) scan)
+                Nothing
+            )
 semiJoin _ _ _ = Nothing
 
 -- | 只允许无求值错误的左键
@@ -297,7 +311,7 @@ rewriteNode db op = pushOne db op
 optimizeRelOp :: Database -> RelOp -> RelOp
 optimizeRelOp db = rewriteNode db . descend
   where
-    -- | 先递归处理子算子
+    -- \| 先递归处理子算子
     descend (Filter p x) = Filter p (optimizeRelOp db x)
     descend (Project cols x) = Project cols (optimizeRelOp db x)
     descend (Compute items x) = Compute items (optimizeRelOp db x)

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Planner.hs

@@ -27,7 +27,7 @@ source fromC mWhere = do
 nameAggs :: [(String, Expr)] -> [(String, Expr)]
 nameAggs items = go (1 :: Int) [] (concatMap (aggregatesIn . snd) items)
   where
-    -- | 逐个聚合起名，重复的不再起名
+    -- \| 逐个聚合起名，重复的不再起名
     go :: Int -> [(String, Expr)] -> [Expr] -> [(String, Expr)]
     go _ acc [] = reverse acc
     go n acc (e : es)
@@ -63,7 +63,7 @@ rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
         IsNotNull a -> IsNotNull (go a)
         other -> other
   where
-    -- | 递归替换当前查询层的聚合引用
+    -- \| 递归替换当前查询层的聚合引用
     go = rewriteAggs aggs
 
 -- | 排序 + 截断
@@ -82,10 +82,10 @@ translate q = case q of
     SelectDistinct inner -> do
         ordering <- distinctOrdering inner
         plan <- case inner of
-            s@Select{} -> translate s { selectOrderBy = [], selectLimit = Nothing }
+            s@Select{} -> translate s{selectOrderBy = [], selectLimit = Nothing}
             _ -> Left "DISTINCT requires SELECT"
         let labels = case inner of
-                Select { selectItems = items } -> map fst items
+                Select{selectItems = items} -> map fst items
                 _ -> []
         keys <- mapM (distinctKey labels) ordering
         namedOrdering <- mapM (columnKey labels) ordering
@@ -97,32 +97,38 @@ translate q = case q of
     Select items fromC mWhere groupBy having orderBy mLimit -> do
         plan0 <- source fromC mWhere
         expressions <- mapM (orderExpression items . fst) orderBy
-        let aggs = nameAggs (items ++ [("having", expression) | expression <- maybe [] pure having]
-                ++ map ("order",) expressions)
+        let aggs =
+                nameAggs
+                    ( items
+                        ++ [("having", expression) | expression <- maybe [] pure having]
+                        ++ map ("order",) expressions
+                    )
             aggregate = not (null groupBy && null aggs && null having)
             grouped = if aggregate then Aggregate groupBy aggs plan0 else plan0
             plan = maybe grouped (\condition -> Filter (rewriteAggs aggs condition) grouped) having
             items' = [(label, rewriteAggs aggs expression) | (label, expression) <- items]
             ordering = zip (map (rewriteAggs aggs) expressions) (map snd orderBy)
-            -- | 简单列排序保留可优化的名称算子
+            -- \| 简单列排序保留可优化的名称算子
             named (Col column, direction) = Just (column, direction)
             named _ = Nothing
-            -- | 保持普通投影在 LIMIT 之后求值
+            -- \| 保持普通投影在 LIMIT 之后求值
             projected child
                 | all (\(label, expression) -> expression == Col label) items' = Project (map fst items') child
                 | otherwise = Compute items' child
-        Right (case mapM named ordering of
+        Right
+            ( case mapM named ordering of
                 Just spec -> projected (limited spec mLimit plan)
-            Nothing -> orderedProjection items' ordering mLimit plan)
+                Nothing -> orderedProjection items' ordering mLimit plan
+            )
     _ -> Left "only SELECT is supported by translate"
   where
-    -- | 简单投影的序号映射到来源列
+    -- \| 简单投影的序号映射到来源列
     columnKey columns (column, direction) = do
         position <- orderPosition (length columns) column
         case position of
             Just slot -> Right (columns !! slot, direction)
             Nothing -> Left "DISTINCT: sorting requires an output position"
-    -- | 去重后按指定输出位置或唯一名称排序
+    -- \| 去重后按指定输出位置或唯一名称排序
     distinctKey columns (column, direction) = do
         position <- orderPosition (length columns) column
         case position of

chusql-core/engine/src/ChuSQL/Core/Engine/Algebra/Sort.hs

@@ -1,8 +1,8 @@
 module ChuSQL.Core.Engine.Algebra.Sort (sortRows, sortBoundRows, compareValue) where
 
-import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Algebra.Expr (evalExpr)
+import ChuSQL.Core.Engine.Syntax.AST
+import ChuSQL.Core.Model
 import Data.List (sortBy)
 
 -- 排序：按多列规格排出结果行，每列可升可降。
@@ -34,9 +34,9 @@ sortRows :: [(String, SortDir)] -> [Row] -> [Row]
 sortRows [] rows = rows
 sortRows spec rows = map snd (sortBy cmp (map decorate rows))
   where
-    -- | 取键并带上原行
+    -- \| 取键并带上原行
     decorate row = (sortKey spec row, row)
-    -- | 比较两个带键的行
+    -- \| 比较两个带键的行
     cmp (k1, _) (k2, _) = compareKeys (map snd spec) k1 k2
 
 -- | 用绑定槽位取键并稳定排序
@@ -47,9 +47,9 @@ sortBoundRows spec outer rows = do
     Right (map snd (sortBy compareRows decorated))
   where
     directions = map snd spec
-    -- | 每行只计算一次绑定排序键
+    -- \| 每行只计算一次绑定排序键
     decorate row = do
         keys <- mapM (\(expression, _) -> evalExpr expression (row ++ outer)) spec
         Right (map Just keys, row)
-    -- | 比较排序键并保留同键行序
+    -- \| 比较排序键并保留同键行序
     compareRows (left, _) (right, _) = compareKeys directions left right

chusql-core/engine/src/ChuSQL/Core/Engine/Builtin.hs

@@ -19,7 +19,8 @@ module ChuSQL.Core.Engine.Builtin (
 ) where
 
 import ChuSQL.Core.Engine.Syntax.AST (CompareOp (..), Expr (..))
-import ChuSQL.Core.Model (Value (..), compareValue)
+import ChuSQL.Core.Model (ColumnType (..), Value (..), compareValue, hasTypeCapability)
+import ChuSQL.Core.Runtime (TypeCapability (..), builtinTypes, validateValue)
 import Control.Monad (foldM)
 import Data.Char (toLower)
 
@@ -201,12 +202,12 @@ compareNode CmpLtE = LtE
 executeOperator :: Operator -> [Value] -> Either String Value
 executeOperator op vs = case (op, vs) of
     (OpNeg, [x]) -> evalNeg x
-    (OpGt, [x, y]) -> compareValues (== GT) x y
-    (OpLt, [x, y]) -> compareValues (< EQ) x y
-    (OpEq, [x, y]) -> compareValues (== EQ) x y
-    (OpGtE, [x, y]) -> compareValues (>= EQ) x y
-    (OpLtE, [x, y]) -> compareValues (<= EQ) x y
-    (OpNe, [x, y]) -> compareValues (/= EQ) x y
+    (OpGt, [x, y]) -> compareValues OrdCapability (== GT) x y
+    (OpLt, [x, y]) -> compareValues OrdCapability (< EQ) x y
+    (OpEq, [x, y]) -> compareValues EqCapability (== EQ) x y
+    (OpGtE, [x, y]) -> compareValues OrdCapability (>= EQ) x y
+    (OpLtE, [x, y]) -> compareValues OrdCapability (<= EQ) x y
+    (OpNe, [x, y]) -> compareValues EqCapability (/= EQ) x y
     (OpAnd, [x, y]) -> andValues x y
     (OpOr, [x, y]) -> orValues x y
     (_, [x, y]) | Just a <- arithOf op -> evalArith a x y
@@ -262,21 +263,26 @@ asDouble (VFloat d) = Just d
 asDouble _ = Nothing
 
 -- | 比较两个值：NULL 给 NULL，其余按全序比
-compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
-compareValues rel x y
+compareValues :: TypeCapability -> (Ordering -> Bool) -> Value -> Value -> Either String Value
+compareValues capability rel x y
     | x == VNull || y == VNull = Right VNull
-    | comparableValue x y = Right (VBool (rel (compareValue x y)))
+    | comparableValue capability x y = Right (VBool (rel (compareValue x y)))
     | otherwise = Left "type error: cannot compare these values"
 
 -- | 两个值是否落在可以用全序比较的同一族里
-comparableValue :: Value -> Value -> Bool
-comparableValue (VInt _) (VFloat _) = True
-comparableValue (VFloat _) (VInt _) = True
-comparableValue (VInt _) (VInt _) = True
-comparableValue (VFloat _) (VFloat _) = True
-comparableValue (VStr _) (VStr _) = True
-comparableValue (VBool _) (VBool _) = True
-comparableValue _ _ = False
+comparableValue :: TypeCapability -> Value -> Value -> Bool
+comparableValue _ (VInt _) (VFloat _) = True
+comparableValue _ (VFloat _) (VInt _) = True
+comparableValue _ (VInt _) (VInt _) = True
+comparableValue _ (VFloat _) (VFloat _) = True
+comparableValue _ (VStr _) (VStr _) = True
+comparableValue _ (VBool _) (VBool _) = True
+comparableValue capability (VRuntime left x) (VRuntime right y) =
+    left == right
+        && hasTypeCapability capability (CRuntime left)
+        && validateValue builtinTypes left x == Right ()
+        && validateValue builtinTypes right y == Right ()
+comparableValue _ _ _ = False
 
 -- | 逻辑与的三值真值表
 andValues :: Value -> Value -> Either String Value

chusql-core/engine/src/ChuSQL/Core/Engine/Domain.hs

@@ -0,0 +1,235 @@
+module ChuSQL.Core.Engine.Domain (
+    domainColumns,
+    domainDefinition,
+    canonicalDomain,
+    effectiveColumns,
+    domainCheckPlan,
+    runDomainChecks,
+    validateDomainDefaults,
+    prepareDomainAlter,
+) where
+
+import ChuSQL.Core.Engine.Algebra.Expr (evalExpr)
+import ChuSQL.Core.Engine.Runtime.Relation (orderRow)
+import ChuSQL.Core.Engine.Semantic (prepareDomainCheckExpression)
+import ChuSQL.Core.Engine.Syntax.AST
+import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
+import ChuSQL.Core.Model
+import Control.Applicative ((<|>))
+import Control.Monad (when)
+import Data.Char (isAlphaNum, isAscii, toLower)
+import Data.List (isPrefixOf, nub)
+import Data.Maybe (fromMaybe)
+
+-- 领域元数据、约束继承、默认值及结构变更的纯校验。
+
+-- | 将领域定义编码为目录列
+domainColumns :: DomainDefinition -> [(String, Column)]
+domainColumns (DomainDefinition base checks) =
+    ("base", base{columnCheck = Nothing})
+        : [("check_" ++ name, (plainColumn CBool){columnCheck = Just text}) | (name, text) <- checks]
+
+-- | 从新旧目录恢复领域定义
+domainDefinition :: Table -> Either String DomainDefinition
+domainDefinition table = do
+    base <- maybe (Left "invalid domain catalog: missing base") Right (lookup "base" (tableCols table))
+    checks <- mapM readCheck [(name, col) | (name, col) <- tableCols table, name /= "base"]
+    let legacy = maybe [] (\text -> [("domain_check_0", text)]) (columnCheck base)
+    Right (DomainDefinition base{columnCheck = Nothing} (legacy ++ checks))
+  where
+    -- \| 恢复一条具名检查条件
+    readCheck (name, col)
+        | "check_" `isPrefixOf` name, Just text <- columnCheck col = Right (drop 6 name, text)
+        | otherwise = Left "invalid domain constraint catalog"
+
+-- | 为匿名约束命名并验证完整定义
+canonicalDomain :: Database -> String -> DomainDefinition -> Either String DomainDefinition
+canonicalDomain db name definition = do
+    normalized <- normalize definition
+    let candidate = install name normalized db
+    validateOwn candidate name
+    Right normalized
+  where
+    -- \| 规范化约束名称并拒绝重复声明
+    normalize (DomainDefinition base checks) = do
+        when
+            (columnAutoIncrement base || columnUnique base || columnPrimaryKey base)
+            (Left "DOMAIN does not support row-set constraints")
+        let named = [map toLower key | (key, _) <- checks, not (null key)]
+        when (length named /= length (nub named)) (Left "duplicate domain constraint name")
+        mapM_ validName named
+        assigned <- assign named 1 checks
+        Right (DomainDefinition base assigned)
+    -- \| 验证约束标识符
+    validName key
+        | null key || length key > 48 || not (all (\c -> isAscii c && (isAlphaNum c || c == '_')) key) =
+            Left "invalid domain constraint name"
+        | otherwise = Right ()
+    -- \| 为未命名约束分配稳定名称
+    assign _ _ [] = Right []
+    assign used index ((key, text) : rest)
+        | null key =
+            let (chosen, next) = fresh used index
+             in ((chosen, text) :) <$> assign (chosen : used) next rest
+        | otherwise = ((map toLower key, text) :) <$> assign used index rest
+    -- \| 跳过已有的自动约束名称
+    fresh used index
+        | chosen `elem` used = fresh used (index + 1)
+        | otherwise = (chosen, index + 1)
+      where
+        chosen = "domain_check_" ++ show (index :: Int)
+
+-- | 在纯目录中安装候选领域定义
+install :: String -> DomainDefinition -> Database -> Database
+install name definition db = (key, table{tableCols = domainColumns definition}) : filter ((/= key) . fst) db
+  where
+    key = domainTableName name
+    table = fromMaybe (Table key [] [] Nothing Nothing Nothing) (lookup key db)
+
+-- | 沿目录解析领域链并拒绝循环
+chain :: Database -> ColumnType -> Either String [(String, DomainDefinition)]
+chain db = go []
+  where
+    -- \| 逐层读取当前定义而非缓存属性
+    go seen (CDomain name _)
+        | name `elem` seen = Left ("cyclic domain definition: " ++ name)
+        | otherwise = do
+            table <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
+            definition@(DomainDefinition base _) <- domainDefinition table
+            rest <- go (name : seen) (columnType base)
+            Right ((name, definition) : rest)
+    go _ _ = Right []
+
+-- | 合并列声明与继承的非空和默认值
+effectiveColumns :: Database -> [(String, Column)] -> Either String [(String, Column)]
+effectiveColumns db = mapM effective
+  where
+    -- \| 保留最近默认值并收紧可空属性
+    effective (name, column) = do
+        definitions <- chain db (columnType column)
+        let bases = [base | (_, DomainDefinition base _) <- definitions]
+        Right
+            ( name
+            , column
+                { columnNullable = columnNullable column && all columnNullable bases
+                , columnDefault = foldl (<|>) (columnDefault column) (map columnDefault bases)
+                }
+            )
+
+-- | 绑定领域 VALUE 到独立的单值布局
+domainCheckPlan :: Database -> [(String, Column)] -> Either String [(String, Int, Expr)]
+domainCheckPlan db columns = concat <$> mapM checks (zip [0 ..] columns)
+  where
+    -- \| 按基础领域到外层领域绑定条件
+    checks (slot, (_, column)) = do
+        definitions <- chain db (columnType column)
+        mapM
+            (bind slot column)
+            [ (name ++ "." ++ key, text)
+            | (name, DomainDefinition _ constraints) <- reverse definitions
+            , (key, text) <- constraints
+            ]
+    -- \| 拒绝聚合及子查询并固定类型槽位
+    bind slot column (name, text) = do
+        expression <- parseExpression text
+        bound <- prepareDomainCheckExpression (columnType column) expression
+        Right (name, slot, bound)
+
+-- | SQL CHECK 的 UNKNOWN 与 TRUE 都通过
+runDomainChecks :: [(String, Int, Expr)] -> Row -> Either String ()
+runDomainChecks plan row = mapM_ check plan
+  where
+    -- \| 在单值作用域执行一条领域约束
+    check (name, slot, expression) = case drop slot row of
+        (_, value) : _ -> do
+            result <- evalExpr expression [("value", value)]
+            case result of
+                VBool True -> Right ()
+                VNull -> Right ()
+                VBool False -> Left ("CHECK on DOMAIN " ++ name ++ " failed")
+                _ -> Left ("CHECK on DOMAIN " ++ name ++ " is not boolean")
+        [] -> Left "missing bound domain value"
+
+-- | 检查有效默认值是否满足领域约束
+validateDomainDefaults :: Database -> [(String, Column)] -> Either String ()
+validateDomainDefaults db columns = do
+    effective <- effectiveColumns db columns
+    mapM_ validate [entry | entry@(_, column) <- effective, CDomain{} <- [columnType column]]
+  where
+    -- \| 默认值不改变已有行但必须可赋值
+    validate entry@(name, column) = case columnDefault column of
+        Nothing -> Right ()
+        Just value -> do
+            coerced <- coerceValue (columnType column) value
+            checkNull name column coerced
+            plan <- domainCheckPlan db [entry]
+            runDomainChecks plan [(name, coerced)]
+
+-- | 拒绝领域或列要求非空时的 NULL
+checkNull :: String -> Column -> Value -> Either String ()
+checkNull name column value
+    | value == VNull && not (columnNullable column) = Left ("DOMAIN NOT NULL: " ++ name)
+    | otherwise = Right ()
+
+-- | 检查领域本身的定义及继承默认值
+validateOwn :: Database -> String -> Either String ()
+validateOwn db name = do
+    table <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
+    DomainDefinition base _ <- domainDefinition table
+    let columns = [("value", plainColumn (CDomain name (columnType base)))]
+    _ <- domainCheckPlan db columns
+    validateDomainDefaults db columns
+
+-- | 在完整快照上校验并生成领域替换定义
+prepareDomainAlter :: String -> DomainAlter -> Database -> Either String [(String, Column)]
+prepareDomainAlter rawName action db = do
+    table <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
+    definition <- domainDefinition table >>= change
+    normalized <- canonicalDomain db name definition
+    let candidate = install name normalized db
+    mapM_ (validateDependent candidate) [key | (key, _) <- candidate, isDomainTable key]
+    mapM_ (validateTable candidate) [(key, value) | (key, value) <- candidate, not (isDomainTable key)]
+    Right (domainColumns normalized)
+  where
+    name = map toLower rawName
+    -- \| 修改单个属性且保留其他约束
+    change (DomainDefinition base checks) = case action of
+        DomainDefault value -> Right (DomainDefinition base{columnDefault = value} checks)
+        DomainNullable nullable -> Right (DomainDefinition base{columnNullable = nullable} checks)
+        DomainAddCheck key text -> Right (DomainDefinition base (checks ++ [(fromMaybe "" key, text)]))
+        DomainDropCheck key
+            | map toLower key `elem` map fst checks -> Right (DomainDefinition base (filter ((/= map toLower key) . fst) checks))
+            | otherwise -> Left ("unknown domain constraint: " ++ key)
+    -- \| 判断传递引用是否包含目标领域
+    affected candidate ty = any ((== name) . fst) <$> chain candidate ty
+    -- \| 校验依赖领域的继承默认值
+    validateDependent candidate key = do
+        let domain = drop (length (domainTableName "")) key
+        applies <- affected candidate (CDomain domain CStr)
+        when applies (validateOwn candidate domain)
+    -- \| 只校验受领域变化影响的列与数据
+    validateTable candidate (_, table) = do
+        selected <-
+            mapM
+                ( \entry@(_, column) -> do
+                    applies <- affected candidate (columnType column)
+                    Right [entry | applies]
+                )
+                (tableCols table)
+        let columns = concat selected
+        effective <- effectiveColumns candidate columns
+        validateDomainDefaults candidate columns
+        plan <- domainCheckPlan candidate columns
+        mapM_ (validateRow effective plan) (tableRows table)
+    -- \| 按列布局检查非空与全部继承条件
+    validateRow columns plan row = do
+        selected <- orderRow (map fst columns) row
+        values <-
+            mapM
+                ( \((key, column), (_, value)) -> do
+                    coerced <- coerceValue (columnType column) value
+                    checkNull key column coerced
+                    Right (key, coerced)
+                )
+                (zip columns selected)
+        runDomainChecks plan values

chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs

@@ -33,8 +33,12 @@ data ErrorRule = ErrorRule
 -- | 唯一的错误识别表，顺序即优先级
 errorRules :: [ErrorRule]
 errorRules =
-    [ ErrorRule "no database selected" NoDatabaseError "no_database"
+    [ ErrorRule "deadlock_detected:" StorageError "deadlock_detected"
+    , ErrorRule "lock_timeout:" StorageError "lock_timeout"
+    , ErrorRule "serialization_failure:" CatalogError "serialization_failure"
+    , ErrorRule "no database selected" NoDatabaseError "no_database"
     , ErrorRule "administrator required" PermissionError "forbidden"
+    , ErrorRule "serialization_failure: domain snapshot changed" CatalogError "serialization_failure"
     , ErrorRule "bound query object changed" CatalogError "serialization_failure"
     , ErrorRule "bound query schema changed" CatalogError "serialization_failure"
     , ErrorRule "unknown table" CatalogError "not_found"

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Binding.hs

@@ -1,23 +1,43 @@
-module ChuSQL.Core.Engine.Runtime.Binding
-    ( Expression (..), TypedExpression, expressionType, bindExpression, evaluateExpression
-    , Plan (..), TypedPlan, planSchema, bindPlan, executePlan
-    ) where
+module ChuSQL.Core.Engine.Runtime.Binding (
+    Expression (..),
+    TypedExpression,
+    expressionType,
+    bindExpression,
+    evaluateExpression,
+    Plan (..),
+    TypedPlan,
+    planSchema,
+    bindPlan,
+    executePlan,
+) where
 
-import ChuSQL.Core.Engine.Runtime.Types
 import ChuSQL.Core.Engine.Runtime.Functions
+import ChuSQL.Core.Engine.Runtime.Types
 import Control.Monad (filterM)
 import Data.List (nub, sort)
 
 -- 仅依据 schema 绑定表达式与查询，执行已解析的类型和函数身份。
 
 -- | 表达未绑定的类型化语言
-data Expression = Literal TypeExpr RuntimeValue | Reference String | Apply String [Expression]
-    | ListLiteral TypeExpr [Expression] | NothingLiteral TypeExpr | JustLiteral Expression
-    | TupleLiteral [Expression] deriving (Show, Eq)
+data Expression
+    = Literal TypeExpr RuntimeValue
+    | Reference String
+    | Apply String [Expression]
+    | ListLiteral TypeExpr [Expression]
+    | NothingLiteral TypeExpr
+    | JustLiteral Expression
+    | TupleLiteral [Expression]
+    deriving (Show, Eq)
 
 -- | 保存绑定后的表达式节点
-data ExpressionNode = Constant RuntimeValue | BoundReference Int String | BoundApply FunctionId [TypedExpression]
-    | BoundList [TypedExpression] | BoundNothing | BoundJust TypedExpression | BoundTuple [TypedExpression]
+data ExpressionNode
+    = Constant RuntimeValue
+    | BoundReference Int String
+    | BoundApply FunctionId [TypedExpression]
+    | BoundList [TypedExpression]
+    | BoundNothing
+    | BoundJust TypedExpression
+    | BoundTuple [TypedExpression]
     deriving (Show, Eq)
 
 -- | 保存表达式的确定类型
@@ -56,9 +76,9 @@ bindExpression types functions env expression = case expression of
         bound <- mapM bind arguments
         compound (tupleType (map (typeExpression . expressionType) bound)) (BoundTuple bound)
   where
-    -- | 绑定当前作用域的子表达式
+    -- \| 绑定当前作用域的子表达式
     bind = bindExpression types functions env
-    -- | 校验并构造复合表达式
+    -- \| 校验并构造复合表达式
     compound ty node = do
         tid <- descriptorId <$> resolveType types ty
         Right (TypedExpression tid node)
@@ -80,16 +100,24 @@ evaluateExpression types functions row (TypedExpression tid node) = do
     validateValue types tid value
     Right value
   where
-    -- | 执行当前行的子表达式
+    -- \| 执行当前行的子表达式
     evaluate = evaluateExpression types functions row
 
 -- | 表达未绑定的关系计划
-data Plan = TableScan String | SingleRow | Projection [(String, Expression)] Plan
-    | Selection Expression Plan deriving (Show, Eq)
+data Plan
+    = TableScan String
+    | SingleRow
+    | Projection [(String, Expression)] Plan
+    | Selection Expression Plan
+    deriving (Show, Eq)
 
 -- | 保存绑定后的关系节点
-data PlanNode = BoundScan String | BoundSingleRow | BoundProjection [(String, TypedExpression)] TypedPlan
-    | BoundSelection TypedExpression TypedPlan deriving (Show, Eq)
+data PlanNode
+    = BoundScan String
+    | BoundSingleRow
+    | BoundProjection [(String, TypedExpression)] TypedPlan
+    | BoundSelection TypedExpression TypedPlan
+    deriving (Show, Eq)
 
 -- | 保存输出 schema 和关系节点
 data TypedPlan = TypedPlan [(String, TypeId)] PlanNode deriving (Show, Eq)
@@ -122,13 +150,13 @@ bindPlan types functions catalog plan = case plan of
             then Right (TypedPlan (planSchema child) (BoundSelection predicate child))
             else Left "selection predicate must be Bool"
   where
-    -- | 绑定子计划
+    -- \| 绑定子计划
     bind = bindPlan types functions catalog
-    -- | 解析 schema 列的类型身份
+    -- \| 解析 schema 列的类型身份
     bindColumn (name, ty) = do
         tid <- descriptorId <$> resolveType types ty
         Right (name, tid)
-    -- | 绑定投影项
+    -- \| 绑定投影项
     bindItem env (name, value) = do
         bound <- bindExpression types functions env value
         Right (name, bound)
@@ -140,8 +168,12 @@ uniqueNames names
     | otherwise = Left "duplicate schema column"
 
 -- | 执行绑定计划并校验存储返回值
-executePlan :: TypeRegistry -> FunctionRegistry -> (String -> Either String [[(String, RuntimeValue)]])
-    -> TypedPlan -> Either String [[(String, RuntimeValue)]]
+executePlan ::
+    TypeRegistry ->
+    FunctionRegistry ->
+    (String -> Either String [[(String, RuntimeValue)]]) ->
+    TypedPlan ->
+    Either String [[(String, RuntimeValue)]]
 executePlan types functions scan (TypedPlan output node) = do
     rows <- case node of
         BoundScan name -> scan name
@@ -155,23 +187,23 @@ executePlan types functions scan (TypedPlan output node) = do
     mapM_ (validateRow output) rows
     Right [[(name, value) | (name, _) <- output, Just value <- [lookup name row]] | row <- rows]
   where
-    -- | 计算一行的投影项
+    -- \| 计算一行的投影项
     project items row = mapM (projectItem row) items
-    -- | 计算命名输出项
+    -- \| 计算命名输出项
     projectItem row (name, expression) = do
         value <- evaluateExpression types functions row expression
         Right (name, value)
-    -- | 计算选择条件
+    -- \| 计算选择条件
     keep condition row = do
         value <- evaluateExpression types functions row condition
         case value of
             RBool result -> Right result
             _ -> Left "bound predicate returned a non-Bool value"
-    -- | 校验存储行的完整 schema
+    -- \| 校验存储行的完整 schema
     validateRow columns row
         | sort (map fst row) /= sort (map fst columns) = Left "storage row schema mismatch"
         | otherwise = mapM_ (validateColumn row) columns
-    -- | 按列名校验返回值的类型
+    -- \| 按列名校验返回值的类型
     validateColumn row (name, tid) = case lookup name row of
         Just value -> validateValue types tid value
         Nothing -> Left ("missing bound column: " ++ name)

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Dependencies.hs

@@ -1,7 +1,7 @@
 module ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, typeDependencies, validateDependencies) where
 
 import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Core.Model (Database, ColumnType (..), columnType, tableCols, tableIdentity, tableSchemaVersion, domainTableName, lastTablePart)
+import ChuSQL.Core.Model (ColumnType (..), Database, columnType, domainTableName, lastTablePart, tableCols, tableIdentity, tableSchemaVersion)
 import Data.List (nub)
 
 -- 收集读写语句及嵌套表达式的表依赖，供执行期校验目录。
@@ -10,7 +10,7 @@ import Data.List (nub)
 validateDependencies :: Database -> Database -> Either String ()
 validateDependencies expected current = mapM_ validate expected
   where
-    -- | 数据和统计变化不使结构绑定失效
+    -- \| 数据和统计变化不使结构绑定失效
     validate (name, table) = case lookup name current of
         Just actual | tableIdentity actual /= tableIdentity table -> Left ("bound query object changed: " ++ name)
         Just actual | tableSchemaVersion actual /= tableSchemaVersion table -> Left ("bound query schema changed: " ++ name)
@@ -19,14 +19,20 @@ validateDependencies expected current = mapM_ validate expected
 
 -- | 收集读写目标、来源及子查询依赖
 queryTables :: Statement -> [String]
-queryTables statement = nub (case statement of
+queryTables statement =
+    nub
+        ( case statement of
             SelectDistinct child -> queryTables child
-    Select items source condition _ having ordering _ -> sourceTables source
-        ++ concatMap (expressionTables . snd) items ++ concatMap expressionTables condition
+            Select items source condition _ having ordering _ ->
+                sourceTables source
+                    ++ concatMap (expressionTables . snd) items
+                    ++ concatMap expressionTables condition
                     ++ concatMap expressionTables having
                     ++ concatMap (maybe [] expressionTables . orderKeyExpression . fst) ordering
             Insert target _ rows -> target : concatMap (concatMap expressionTables) rows
-    Update target assignments condition -> target : concatMap (expressionTables . snd) assignments
+            Update target assignments condition ->
+                target
+                    : concatMap (expressionTables . snd) assignments
                     ++ concatMap expressionTables condition
             Delete target condition -> target : concatMap expressionTables condition
             DropTable target -> [target]
@@ -38,28 +44,42 @@ queryTables statement = nub (case statement of
             AlterColumnType target _ _ -> [target]
             AlterColumnDefault target _ _ -> [target]
             AlterColumnNull target _ _ -> [target]
-    _ -> [])
+            _ -> []
+        )
 
 -- | 收集来源列依赖的领域定义
 domainDependencies :: Database -> [String] -> [String]
-domainDependencies catalog sources = typeDependencies catalog
-    [columnType column | (name, table) <- catalog, name `elem` sources
-        , (_, column) <- tableCols table]
+domainDependencies catalog sources =
+    typeDependencies
+        catalog
+        [ columnType column
+        | (name, table) <- catalog
+        , name `elem` sources
+        , (_, column) <- tableCols table
+        ]
 
 -- | 收集声明类型依赖的领域目录
 typeDependencies :: Database -> [ColumnType] -> [String]
 typeDependencies catalog types = collect [] (concatMap typeDomains types)
   where
-    -- | 递归展开定义并防止重复访问
+    -- \| 递归展开定义并防止重复访问
     collect seen [] = seen
     collect seen (domain : remaining) =
-        let definitions = [(name, table) | (name, table) <- catalog
-                , lastTablePart name == domainTableName domain, name `notElem` seen]
+        let definitions =
+                [ (name, table)
+                | (name, table) <- catalog
+                , lastTablePart name == domainTableName domain
+                , name `notElem` seen
+                ]
             names = map fst definitions
-            nested = [child | (_, table) <- definitions, (_, column) <- tableCols table
-                , child <- typeDomains (columnType column)]
+            nested =
+                [ child
+                | (_, table) <- definitions
+                , (_, column) <- tableCols table
+                , child <- typeDomains (columnType column)
+                ]
          in collect (seen ++ names) (remaining ++ nested)
-    -- | 保留嵌套领域的每层依赖
+    -- \| 保留嵌套领域的每层依赖
     typeDomains (CDomain name base) = name : typeDomains base
     typeDomains _ = []
 

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Functions.hs

@@ -1,10 +1,16 @@
-module ChuSQL.Core.Engine.Runtime.Functions
-    ( FunctionId (..), FunctionSignature (..), FunctionRegistry
-    , builtinFunctions, resolveFunction, resolveNullableFunction, functionSignature, invokeFunction
-    ) where
+module ChuSQL.Core.Engine.Runtime.Functions (
+    FunctionId (..),
+    FunctionSignature (..),
+    FunctionRegistry,
+    builtinFunctions,
+    resolveFunction,
+    resolveNullableFunction,
+    functionSignature,
+    invokeFunction,
+) where
 
-import Control.Monad (zipWithM_)
 import ChuSQL.Core.Engine.Runtime.Types
+import Control.Monad (zipWithM_)
 import Data.Char (toLower)
 
 -- 内建函数的固定身份、签名解析和类型化调用。
@@ -14,9 +20,12 @@ newtype FunctionId = FunctionId Int deriving (Show, Eq, Ord)
 
 -- | 描述已解析的函数签名
 data FunctionSignature = FunctionSignature
-    { signatureId :: FunctionId, signatureName :: String
-    , signatureArguments :: [TypeId], signatureResult :: TypeId
-    } deriving (Show, Eq)
+    { signatureId :: FunctionId
+    , signatureName :: String
+    , signatureArguments :: [TypeId]
+    , signatureResult :: TypeId
+    }
+    deriving (Show, Eq)
 
 -- | 保存函数签名和实现
 newtype FunctionRegistry = FunctionRegistry [(FunctionSignature, [RuntimeValue] -> Either String RuntimeValue)]
@@ -27,9 +36,12 @@ builtinFunctions types = do
     int <- descriptorId <$> resolveType types intType
     bool <- descriptorId <$> resolveType types boolType
     string <- descriptorId <$> resolveType types stringType
-    Right (FunctionRegistry
-        [(FunctionSignature (FunctionId 1) "length" [string] int, stringLength)
-        ,(FunctionSignature (FunctionId 2) "not" [bool] bool, booleanNot)])
+    Right
+        ( FunctionRegistry
+            [ (FunctionSignature (FunctionId 1) "length" [string] int, stringLength)
+            , (FunctionSignature (FunctionId 2) "not" [bool] bool, booleanNot)
+            ]
+        )
 
 -- | 按名称和完整参数类型解析函数
 resolveFunction :: FunctionRegistry -> String -> [TypeId] -> Either String FunctionSignature
@@ -38,14 +50,17 @@ resolveFunction registry name arguments = resolveNullableFunction registry name
 -- | 按可空 SQL 参数解析确定签名
 resolveNullableFunction :: FunctionRegistry -> String -> [Maybe TypeId] -> Either String FunctionSignature
 resolveNullableFunction (FunctionRegistry functions) name arguments =
-    case [sig | (sig, _) <- functions, map toLower (signatureName sig) == map toLower name
+    case [ sig
+         | (sig, _) <- functions
+         , map toLower (signatureName sig) == map toLower name
          , length arguments == length (signatureArguments sig)
-              , and (zipWith matches arguments (signatureArguments sig))] of
+         , and (zipWith matches arguments (signatureArguments sig))
+         ] of
         [sig] -> Right sig
         [] -> Left ("no matching function signature: " ++ name)
         _ -> Left ("ambiguous function signature: " ++ name)
   where
-    -- | 匹配具体参数或未定型 NULL
+    -- \| 匹配具体参数或未定型 NULL
     matches Nothing _ = True
     matches (Just supplied) expected = supplied == expected
 
@@ -62,7 +77,9 @@ invokeFunction types (FunctionRegistry functions) fid values =
         [(sig, implementation)]
             | length values == length (signatureArguments sig) -> do
                 zipWithM_
-                  (validateValue types) (signatureArguments sig) values
+                    (validateValue types)
+                    (signatureArguments sig)
+                    values
                 result <- implementation values
                 validateValue types (signatureResult sig) result
                 Right result

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Query.hs

@@ -1,25 +1,33 @@
-module ChuSQL.Core.Engine.Runtime.Query
-    ( BoundQuery, QueryType (..), queryTypes, bindQuery, executeQueryM
-    ) where
+module ChuSQL.Core.Engine.Runtime.Query (
+    BoundQuery,
+    QueryType (..),
+    queryTypes,
+    bindQuery,
+    executeQueryM,
+) where
 
 import ChuSQL.Core.Engine.Algebra.Eval (evalRelOpM)
 import ChuSQL.Core.Engine.Algebra.Op (RelOp)
 import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
 import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Core.Engine.Semantic (prepare, querySchema)
-import ChuSQL.Core.Engine.Syntax.AST (Statement)
-import ChuSQL.Core.Engine.Storage (MonadStorage (schema, withSchemaGuard))
+import ChuSQL.Core.Engine.Runtime.Dependencies (domainDependencies, queryTables, validateDependencies)
+import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns)
 import ChuSQL.Core.Engine.Runtime.SQL (sqlType)
 import ChuSQL.Core.Engine.Runtime.Types (TypeId)
-import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns)
-import ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, validateDependencies)
+import ChuSQL.Core.Engine.Semantic (prepare, querySchema)
+import ChuSQL.Core.Engine.Storage (MonadStorage (schema, withSchemaGuard))
+import ChuSQL.Core.Engine.Syntax.AST (Statement)
 import ChuSQL.Core.Model
 
 -- SQL 查询绑定边界：保存解析后的类型、函数身份及输出 schema。
 
 -- | 保存运行时或兼容列类型
-data QueryType = RuntimeType TypeId | CompatibilityType ColumnType
-    | DomainType String QueryType | NullType deriving (Show, Eq)
+data QueryType
+    = RuntimeType TypeId
+    | CompatibilityType ColumnType
+    | DomainType String QueryType
+    | NullType
+    deriving (Show, Eq)
 
 -- | 保存仅由 schema 绑定的执行计划
 data BoundQuery = BoundQuery Database [String] [(String, Column)] [(String, QueryType)] RelOp
@@ -31,7 +39,7 @@ queryTypes (BoundQuery _ _ _ types _) = types
 -- | 绑定 SQL 查询并优化确定的计划
 bindQuery :: Database -> Statement -> Either String BoundQuery
 bindQuery catalog statement = do
-    let schemaOnly = [(name, table {tableRows = []}) | (name, table) <- catalog]
+    let schemaOnly = [(name, table{tableRows = []}) | (name, table) <- catalog]
     resolved <- prepare schemaOnly statement
     columns <- querySchema schemaOnly resolved
     plan <- translate resolved
@@ -41,11 +49,11 @@ bindQuery catalog statement = do
         dependencies = sources ++ domainDependencies schemaOnly sources
     Right (BoundQuery schemaOnly dependencies columns types bound)
   where
-    -- | 解析输出列的运行时身份
+    -- \| 解析输出列的运行时身份
     typeOf (name, column) = do
         ty <- bindingType (columnType column)
         Right (name, ty)
-    -- | 保留阶段外类型的兼容表示
+    -- \| 保留阶段外类型的兼容表示
     bindingType CNull = Right NullType
     bindingType (CDomain name base) = DomainType name <$> bindingType base
     bindingType CDate = Right (CompatibilityType CDate)
@@ -54,22 +62,24 @@ bindQuery catalog statement = do
     bindingType ty = RuntimeType <$> sqlType ty
 
 -- | 执行绑定查询并校验输出类型
-executeQueryM :: MonadStorage m => BoundQuery -> m (Either String [Row])
+executeQueryM :: (MonadStorage m) => BoundQuery -> m (Either String [Row])
 executeQueryM (BoundQuery catalog dependencies columns _ plan) = do
     current <- schema
     case current >>= validateDependencies guardedTables of
         Left err -> pure (Left err)
         Right () -> do
-            result <- withSchemaGuard guardedTables
+            result <-
+                withSchemaGuard
+                    guardedTables
                     (evalRelOpM catalog plan)
             pure (result >>= mapM validateRow)
   where
     guardedTables = [(name, table) | (name, table) <- catalog, name `elem` dependencies]
-    -- | 校验完整输出行而不重新解析函数
+    -- \| 校验完整输出行而不重新解析函数
     validateRow row
         | map fst row /= map fst columns = Left "bound query output schema mismatch"
         | otherwise = mapM validateColumn (zip columns row)
-    -- | 校验输出列的物理值
+    -- \| 校验输出列的物理值
     validateColumn ((name, column), (_, value))
         | columnType column == CNull, value == VNull = Right (name, value)
         | valueFits (columnType column) value = Right (name, value)

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Relation.hs

@@ -20,14 +20,14 @@ bindWriteColumns db statement = case statement of
         Delete table <$> mapM (bindSlots columns []) condition
     _ -> Right statement
   where
-    -- | 保留写入目标并绑定右侧表达式
+    -- \| 保留写入目标并绑定右侧表达式
     bindItem columns (name, expression) = (,) name <$> bindSlots columns [] expression
 
 -- | 按绑定布局排列一行并拒绝缺列
 orderRow :: [String] -> Row -> Either String Row
 orderRow columns row = mapM column columns
   where
-    -- | 保留列名并取得物理值
+    -- \| 保留列名并取得物理值
     column name = case lookup name row of
         Just value -> Right (name, value)
         Nothing -> Left ("missing bound column: " ++ name)
@@ -84,8 +84,10 @@ bindSlots columns outer expression = case expression of
     ColumnSlot slot name -> ColumnSlot <$> rebindSlot columns slot name "unknown local column: " <*> pure name
     OuterColumnSlot width slot name
         | width < 0 -> Left ("bound column position mismatch: " ++ name)
-        | otherwise -> OuterColumnSlot (length columns)
-            <$> rebindSlot outer slot name "unknown column: " <*> pure name
+        | otherwise ->
+            OuterColumnSlot (length columns)
+                <$> rebindSlot outer slot name "unknown column: "
+                <*> pure name
     FunctionCall name arguments -> FunctionCall name <$> mapM bind arguments
     BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM bind arguments
     Construct ty arguments -> Construct ty <$> mapM bind arguments
@@ -121,7 +123,7 @@ bindSlots columns outer expression = case expression of
     bind = bindSlots columns outer
     -- \| 查找布局中首次出现的列
     slots names name = [slot | (slot, key) <- zip [0 ..] names, key == name]
-    -- | 保留有效位置，仅允许唯一列重定位
+    -- \| 保留有效位置，仅允许唯一列重定位
     rebindSlot names slot name missing
         | slot < 0 = Left ("bound column position mismatch: " ++ name)
         | take 1 (drop slot names) == [name] = Right slot
@@ -133,7 +135,7 @@ bindSlots columns outer expression = case expression of
     outerReference name = case slots outer name of
         slot : _ -> Right (OuterColumnSlot (length columns) slot name)
         [] -> Left ("unknown column: " ++ name)
-    -- | 将子查询自由变量绑定到父输入布局
+    -- \| 将子查询自由变量绑定到父输入布局
     bindSubquery query = do
         references <- case query of
             Subquery _ names -> mapM reference names
@@ -141,12 +143,12 @@ bindSlots columns outer expression = case expression of
                 | map fst references == names -> mapM rebind references
                 | otherwise -> Left "bound subquery references mismatch"
         Right (BoundSubquery (subqueryStatement query) (subqueryRefs query) references)
-    -- | 补回限定名之前先绑定真实物理列
+    -- \| 补回限定名之前先绑定真实物理列
     reference name = do
         let physical = if name `elem` (columns ++ outer) then name else reverse (takeWhile (/= '.') (reverse name))
         boundReference <- bind (Col physical)
         Right (name, boundReference)
-    -- | 重绑定时保留局部或外层身份
+    -- \| 重绑定时保留局部或外层身份
     rebind (name, boundReference) = (,) name <$> bind boundReference
     -- \| 绑定两个操作数
     binary constructor a b = constructor <$> bind a <*> bind b

chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/SQL.hs

@@ -1,9 +1,9 @@
 module ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, invokeSQLFunction, sqlType, constructSQLValue) where
 
-import Control.Monad (zipWithM_)
 import ChuSQL.Core.Engine.Runtime.Functions
 import ChuSQL.Core.Engine.Runtime.Types
 import ChuSQL.Core.Model (ColumnType (..), Value (..))
+import Control.Monad (zipWithM_)
 
 -- SQL 现有标量表示与已解析运行时函数之间的类型边界。
 
@@ -54,7 +54,9 @@ invokeSQLFunction fid expected values = do
                 then Left "function argument count mismatch"
                 else do
                     zipWithM_
-                      validateArgument (signatureArguments sig) values
+                        validateArgument
+                        (signatureArguments sig)
+                        values
                     if VNull `elem` values
                         then Right VNull
                         else do

chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs

@@ -1,15 +1,16 @@
 {-# LANGUAGE TupleSections #-}
-module ChuSQL.Core.Engine.Semantic (check, prepare, prepareRowExpression, prepareCheckExpression, querySchema) where
 
-import Control.Monad (void)
+module ChuSQL.Core.Engine.Semantic (check, prepare, prepareRowExpression, prepareCheckExpression, prepareDomainCheckExpression, querySchema) where
+
 import ChuSQL.Core.Engine.Algebra.Expr (bareColumns, colsInExpr, hasAggregate, hasSubquery)
 import ChuSQL.Core.Engine.Runtime.Functions (FunctionSignature (..), builtinFunctions, functionSignature)
-import ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, sqlType)
 import ChuSQL.Core.Engine.Runtime.Relation (bindSlots)
+import ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, sqlType)
 import ChuSQL.Core.Engine.Runtime.Types
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
 import ChuSQL.Core.Model
+import Control.Monad (void)
 import Data.Char (isAlphaNum, isAscii, toLower)
 import Data.List (intercalate, isInfixOf, isPrefixOf, isSuffixOf, nub)
 
@@ -46,7 +47,7 @@ data Scope = Scope
 scopeAt :: String -> Scope -> String -> Either String (String, Column)
 scopeAt place scope c = search (scopeFrames scope)
   where
-    -- | 在最近的可见列层停止查找
+    -- \| 在最近的可见列层停止查找
     search [] = Left (missingColumn place c (concat (scopeFrames scope)))
     search (columns : rest) = case columnAt place columns c of
         Right entry -> Right entry
@@ -116,7 +117,12 @@ checkGrouping env keys items having
     | null keys && null having && not (any (hasAggregate . snd) items) = Right ()
     | otherwise = do
         checkColumns "GROUP BY" env keys
-        mapM_ (checkRuntimeColumn "GROUP BY" env) keys
+        mapM_
+            ( \column -> do
+                (_, definition) <- scopeAt "GROUP BY" env column
+                void (requireHashing "GROUP BY" (InferType (columnType definition)))
+            )
+            keys
         mapM_ okCol (nub (concatMap (bareColumns . snd) items ++ concatMap bareColumns having))
   where
     -- \| 这一列能不能出现在分组查询里
@@ -172,12 +178,12 @@ inferExpr db place env (Neg a) = do
         InferType x
             | numericType x -> Right t
             | otherwise -> Left (place ++ ": operator needs TInt on both sides, got TInt and " ++ typeLabel x)
-inferExpr db place env (Gt a b) = comparison db place env a b
-inferExpr db place env (Lt a b) = comparison db place env a b
-inferExpr db place env (Eq a b) = comparison db place env a b
-inferExpr db place env (GtE a b) = comparison db place env a b
-inferExpr db place env (LtE a b) = comparison db place env a b
-inferExpr db place env (NotEq a b) = comparison db place env a b
+inferExpr db place env (Gt a b) = comparison OrdCapability db place env a b
+inferExpr db place env (Lt a b) = comparison OrdCapability db place env a b
+inferExpr db place env (Eq a b) = comparison EqCapability db place env a b
+inferExpr db place env (GtE a b) = comparison OrdCapability db place env a b
+inferExpr db place env (LtE a b) = comparison OrdCapability db place env a b
+inferExpr db place env (NotEq a b) = comparison EqCapability db place env a b
 inferExpr db place env (And a b) = boolean db place env a b
 inferExpr db place env (Or a b) = boolean db place env a b
 inferExpr db place env (IsNull a) = inferExpr db place env a >> Right (InferType CBool)
@@ -215,12 +221,15 @@ inferExpr db place env (InList a es _) = do
     mapM_ (itemType place ta) ts
     Right (InferType CBool)
 inferExpr _ _ _ (ExistsSub _ _) = Right (InferType CBool)
-inferExpr db place env (QuantCmp _ a sq q) = do
+inferExpr db place env (QuantCmp operator a sq q) = do
     ta <- inferExpr db place env a
     cols <- inferSubqueryOutput db env sq
     case cols of
         [(_, t)]
-            | compatible ta t -> Right (InferType CBool)
+            | compatible ta t -> do
+                let capability = if operator `elem` [CmpEq, CmpNe] then EqCapability else OrdCapability
+                mapM_ (requireCapability capability place) [ta, t]
+                Right (InferType CBool)
             | otherwise -> Left (place ++ ": " ++ quantLabel q ++ " subquery column has type " ++ renderType t ++ ", expected " ++ renderType ta)
         _ -> Left (place ++ ": " ++ quantLabel q ++ " subquery must return exactly one column")
 
@@ -241,7 +250,7 @@ inferSubqueryOutput _ _ BoundSubquery{} = Left "execution subquery cannot be use
 inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
     SelectDistinct q -> do
         columns <- inferSubqueryOutput db outerScope sq{subqueryStatement = q}
-        mapM_ (requireOrdering "DISTINCT" . snd) columns
+        mapM_ (requireHashing "DISTINCT" . snd) columns
         _ <- distinctOrdering q
         Right columns
     q@Select{selectItems = items} -> do
@@ -295,12 +304,14 @@ numericOperand place want other t = case t of
     _ -> Left (place ++ ": operator needs " ++ renderType want ++ " on both sides, got " ++ renderType other ++ " and " ++ renderType t)
 
 -- | 比较两边的类型检查
-comparison :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
-comparison db place env a b = do
+comparison :: TypeCapability -> Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
+comparison capability db place env a b = do
     ta <- inferExpr db place env a
     tb <- inferExpr db place env b
     if compatible ta tb
-        then Right (InferType CBool)
+        then do
+            mapM_ (requireCapability capability place) [ta, tb]
+            Right (InferType CBool)
         else Left (place ++ ": both sides of = must have the same type, got " ++ renderType ta ++ " and " ++ renderType tb)
 
 -- | 两类能不能比，类型族规则来自 Model
@@ -362,7 +373,8 @@ prepare db q = do
     let visible = filter (not . isDomainTable . fst) db
     resolved <- resolveStatement visible typed
     case resolved of
-        CreateDomain name base -> do
+        CreateDomain name (DomainDefinition column _) -> do
+            let base = columnType column
             checkDomainName name
             checkTypeParameters base
             case base of
@@ -373,6 +385,9 @@ prepare db q = do
             if any ((== domainTableName name) . fst) db
                 then Left ("domain already exists: " ++ name)
                 else Right ()
+        AlterDomain name _ -> do
+            _ <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
+            Right ()
         DropDomain name -> do
             _ <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
             if any (any (usesDomain name . columnType . snd) . tableCols . snd) db
@@ -418,7 +433,9 @@ ddlTargets statement = case statement of
 -- | 从 schema 解析列上的命名类型
 resolveDomainTypes :: Database -> Statement -> Either String Statement
 resolveDomainTypes db statement = case statement of
-    CreateDomain name base -> CreateDomain name <$> resolveDomainType base
+    CreateDomain name (DomainDefinition column checks) -> do
+        ty <- resolveDomainType (columnType column)
+        Right (CreateDomain name (DomainDefinition column{columnType = ty} checks))
     CreateTable name cols -> CreateTable name <$> mapM resolveColumnType cols
     AddColumn name col -> AddColumn name <$> resolveColumnType col
     AlterColumnType name col ty -> AlterColumnType name col <$> resolveDomainType ty
@@ -491,9 +508,11 @@ checkResolvedWith db outer q = case q of
             else Right ()
     CreateIndex tbl col -> do
         t <- lookupTable db tbl
-        if col `elem` tableCols' t
-            then checkRuntimeColumn "CREATE INDEX" (Scope (tableCols t) []) col
-            else Left ("CREATE INDEX: unknown column: " ++ col)
+        case lookup col (tableCols t) of
+            Nothing -> Left ("CREATE INDEX: unknown column: " ++ col)
+            Just column
+                | typeClassOf (columnType column) == RuntimeClass -> Left "CREATE INDEX: runtime index key encoding is not registered"
+                | otherwise -> Right ()
     DropIndex tbl col -> do
         t <- lookupTable db tbl
         if col `elem` tableCols' t
@@ -579,10 +598,12 @@ checkResolvedWith db outer q = case q of
     UseDatabase name -> checkDatabaseName name
     ShowDatabases -> Right ()
     CreateDomain{} -> Right ()
+    AlterDomain{} -> Right ()
     DropDomain{} -> Right ()
     ShowDomains -> Right ()
     -- \| 事务控制由会话层执行，语义层不做列检查
     BeginTransaction -> Right ()
+    BeginSerializableTransaction -> Right ()
     CommitTransaction -> Right ()
     RollbackTransaction -> Right ()
     -- \| 保存点名字只是会话层的记号，不做列检查
@@ -660,7 +681,7 @@ checkChecks columns = mapM_ checkOne
         Just text -> case parseExpression text of
             Left err -> Left ("CHECK: " ++ firstLine err)
             Right e -> void (prepareCheckExpression columns e)
-    -- | 只保留解析错误的第一行
+    -- \| 只保留解析错误的第一行
     firstLine = takeWhile (/= '\n')
 
 -- | 账号名上限
@@ -825,6 +846,21 @@ prepareCheckExpression columns expression = do
     checkBool [] "CHECK" (Scope columns []) resolved
     bindSlots (map fst columns) [] resolved
 
+-- | 在单值作用域规范化领域 VALUE 的大小写
+prepareDomainCheckExpression :: ColumnType -> Expr -> Either String Expr
+prepareDomainCheckExpression ty expression = do
+    checkNoAggregate "CHECK" expression
+    if hasSubquery expression then Left "CHECK: subqueries are not allowed here" else Right ()
+    let names = nub ("value" : colsInExpr expression)
+        columns = [(name, plainColumn ty) | name <- names, map toLower name == "value"]
+    resolved <- resolveExpr [] columns [] valueName expression
+    prepareCheckExpression [("value", plainColumn ty)] resolved
+  where
+    -- \| 领域条件只允许引用 VALUE
+    valueName name
+        | map toLower name == "value" = Right "value"
+        | otherwise = Left ("unknown column in DOMAIN CHECK: " ++ name)
+
 -- | 将推导类型转换为可空参数类型
 inferredArgument :: InferredType -> Maybe ColumnType
 inferredArgument InferNull = Nothing
@@ -856,8 +892,14 @@ statementColumns stmt = case stmt of
     SelectDistinct q -> statementColumns q
     Select items fromC mWhere groupBy having orderBy _ -> do
         ordering <- mapM (orderExpression items . fst) orderBy
-        Right (concatMap (colsInExpr . snd) items ++ fromColumns fromC
-            ++ concatMap colsInExpr mWhere ++ groupBy ++ concatMap colsInExpr having ++ concatMap colsInExpr ordering)
+        Right
+            ( concatMap (colsInExpr . snd) items
+                ++ fromColumns fromC
+                ++ concatMap colsInExpr mWhere
+                ++ groupBy
+                ++ concatMap colsInExpr having
+                ++ concatMap colsInExpr ordering
+            )
     _ -> Right []
   where
     -- \| 取 FROM 里出现的列
@@ -909,11 +951,12 @@ nameIn env place c = fst <$> columnAt place env c
 scopedColumnAt :: String -> [(String, Column)] -> EnclosingScopes -> String -> Either String (String, Column)
 scopedColumnAt place inner outer c
     | length (filter (== '.') c) == 1
-    , columns : _ <- filter ownsSource (inner : outer) = columnAt place columns c
+    , columns : _ <- filter ownsSource (inner : outer) =
+        columnAt place columns c
     | otherwise = scopeAt place (Scope inner outer) c
   where
     qualifier = takeWhile (/= '.') c ++ "."
-    -- | 判断当前层是否声明该来源限定名
+    -- \| 判断当前层是否声明该来源限定名
     ownsSource = any (isPrefixOf qualifier . fst)
 
 -- | 单表保留原表头，连接使用唯一前缀
@@ -927,18 +970,21 @@ checkOrder db env items column = do
     expression <- orderExpression items column
     void (inferExpr db "ORDER BY" env expression >>= requireOrdering "ORDER BY")
 
--- | 校验列已有排序能力
-checkRuntimeColumn :: String -> Scope -> String -> Either String ()
-checkRuntimeColumn place env column = do
-    (_, definition) <- scopeAt place env column
-    void (requireOrdering place (InferType (columnType definition)))
-
--- | 拒绝尚未注册能力的复合类型
-requireOrdering :: String -> InferredType -> Either String InferredType
-requireOrdering place inferred@(InferType ty)
-    | typeClassOf ty == RuntimeClass = Left (place ++ ": runtime type capability is not registered")
+-- | 统一检查已注册能力并保留 NULL 传播
+requireCapability :: TypeCapability -> String -> InferredType -> Either String InferredType
+requireCapability capability place inferred@(InferType ty)
+    | not (hasTypeCapability capability ty) = Left (place ++ ": type capability is not registered: " ++ show capability)
     | otherwise = Right inferred
-requireOrdering _ inferred = Right inferred
+requireCapability _ _ inferred = Right inferred
+
+-- | 只允许已提供排序能力的类型
+requireOrdering :: String -> InferredType -> Either String InferredType
+requireOrdering = requireCapability OrdCapability
+
+-- | 分组与去重同时要求相等和哈希能力
+requireHashing :: String -> InferredType -> Either String InferredType
+requireHashing place inferred =
+    requireCapability EqCapability place inferred >> requireCapability HashCapability place inferred
 
 -- | 解析投影、条件、排序与连接引用
 resolveQuery :: Database -> EnclosingScopes -> Statement -> [(String, Expr)] -> Either String Statement
@@ -957,10 +1003,12 @@ resolveQuery db outer q items = do
         qualifiedReference c =
             qualifiedReferenceIn db (selectFrom q) c
                 || ( any
-                       (any
-                          (\ (key, _)
-                             -> length (filter (== '.') key) == 1
-                                  && ("." ++ key) `isSuffixOf` c))
+                        ( any
+                            ( \(key, _) ->
+                                length (filter (== '.') key) == 1
+                                    && ("." ++ key) `isSuffixOf` c
+                            )
+                        )
                         outer
                         && (not (any (elem '.' . fst) db) || any (\(table, _) -> (table ++ ".") `isPrefixOf` c) db)
                    )
@@ -981,13 +1029,13 @@ resolveQuery db outer q items = do
     condition <- mapM (resolveExpr db env outer (name "WHERE")) (selectWhere q)
     grouping <- mapM (name "GROUP BY") (selectGroupBy q)
     having <- mapM (resolveExpr db env outer (name "HAVING")) (selectHaving q)
-    -- | 整项名称可用输出别名，复合表达式只查来源
+    -- \| 整项名称可用输出别名，复合表达式只查来源
     let orderKey key@(OrderColumn column)
             | column `elem` map fst projected = key <$ orderExpression projected key
             | otherwise = OrderColumn <$> name "ORDER BY" column
         orderKey key@(OrderPosition _) = key <$ orderPosition (length projected) key
         orderKey (OrderExpression expression) = OrderExpression <$> resolveExpr db env outer (name "ORDER BY") expression
-    ordering <- mapM (\(key, direction) -> (, direction) <$> orderKey key) (selectOrderBy q)
+    ordering <- mapM (\(key, direction) -> (,direction) <$> orderKey key) (selectOrderBy q)
     pure (Select projected source condition grouping having ordering (selectLimit q))
 
 -- | 收集没有别名遮蔽的来源表名

chusql-core/engine/src/ChuSQL/Core/Engine/Storage.hs

@@ -118,6 +118,10 @@ class (Monad m) => MonadStorage m where
     -- \| ALTER 用：整表换列定义与全部行
     replaceSchema :: String -> [(String, Column)] -> [Row] -> m (Either String ())
 
+    -- | 校验完整快照后原子修改领域定义
+    alterDomain :: String -> (Database -> Either String [(String, Column)]) -> m (Either String ())
+    alterDomain _ _ = pure (Left "atomic domain alteration is unavailable in this storage")
+
     -- \| 取全库快照（表名 + 列 + 全部行）
     snapshot :: m (Either String Database)
 

chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module ChuSQL.Core.Engine.Storage.IPC (
@@ -29,10 +29,10 @@ module ChuSQL.Core.Engine.Storage.IPC (
     doDescribeTable,
     doDropTable,
     doListCatalog,
+    databaseSnapshot,
+    snapshotDatabase,
 ) where
 
-import Data.Foldable (for_)
-import Control.Monad (when)
 import ChuSQL.Core.Engine.Parallel (parallelShardLimit, poolRun, workerPool)
 import ChuSQL.Core.Engine.Storage
 import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest)
@@ -41,16 +41,43 @@ import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaCo
 import Control.Concurrent (getNumCapabilities)
 import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, putMVar, readMVar, takeMVar, withMVar)
 import Control.Exception (bracket, mask_)
+import Control.Monad (when)
 import Data.Aeson (eitherDecodeStrict, encode)
 import Data.Aeson qualified as A
 import Data.Aeson.KeyMap qualified as KM
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BL
+import Data.Foldable (for_)
 import Data.Maybe (fromMaybe)
 import System.IO.Unsafe (unsafePerformIO)
 
 -- IPC 存储实现：把 MonadStorage 的操作变成发给存储库的 JSON 请求。
 
+-- 复用相同提交点的不可变快照版本。
+databaseSnapshot :: Maybe (String, Database) -> Env -> IO (Either String (String, Database))
+databaseSnapshot previous env = do
+    response <- ask env "database_snapshot" (ReqDatabaseSnapshot (fst <$> previous)) Just
+    pure $ case response of
+        Left err -> Left err
+        Right (RespSnapshotUnchanged checkpoint) -> case previous of
+            Just cached | fst cached == checkpoint -> Right cached
+            _ -> Left "snapshot version does not match cached database"
+        Right (RespDomainSnapshot infos rows checkpoint) -> do
+            db <- snapshotDatabase infos rows
+            Right (checkpoint, db)
+        Right (RespError err) -> Left err
+        _ -> Left "unexpected database snapshot response"
+
+-- 从同一版本的结构和行集构建引擎数据库。
+snapshotDatabase :: [TableInfo] -> [(String, [Row])] -> Either String Database
+snapshotDatabase infos rows = mapM load infos
+  where
+    -- 布局、对象身份与数据必须来自同一版本。
+    load info = do
+        values <- maybe (Left "incomplete database snapshot") Right (lookup (tiTable info) rows)
+        let name = tiTable info
+        Right (name, Table name (schemaToColumns (tiColumns info)) values (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info))
+
 -- | 一条会话的存储环境：当前库名随会话走，不共享
 data Env = Env
     { envDatabase :: Maybe String
@@ -147,12 +174,13 @@ closeConnection = modifyMVar_ linkRef $ \current -> withMVar (snd linkUsers) $ \
 sendRequest :: Request -> IO Response
 sendRequest req = withStorageLink $ \case
     Nothing -> pure (RespError "storage not configured")
-                                      Just link
-                                        -> do raw <- slRequest link (BL.toStrict (encode req))
+    Just link ->
+        do
+            raw <- slRequest link (BL.toStrict (encode req))
             case raw of
                 Left e -> pure (RespError ("storage error: " ++ e))
-                                                Right bytes
-                                                  -> case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
+                Right bytes ->
+                    case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
                         Left e -> pure (RespError ("decode error: " ++ e))
                         Right resp -> pure resp
 
@@ -250,8 +278,8 @@ doScan env t = ask env "scan" (ReqScan t) $ \case
 -- | 发带投影的 Scan
 doScanColumns :: Env -> String -> [String] -> IO (Either String [Row])
 doScanColumns env t cols = ask env "scan" (ReqScanColumns t cols) $ \case
-                                                                      RespRows rows
-                                                                        -> Just
+    RespRows rows ->
+        Just
             [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
     _ -> Nothing
 
@@ -353,7 +381,7 @@ instance MonadStorage IPCStorage where
     withSchemaGuard dependencies action = IPCStorage $ \env ->
         runIPCStorageIn action env{envSchemaGuard = Just dependencies}
 
-    -- | 写前握手，旧存储不能先写入后才报错
+    -- \| 写前握手，旧存储不能先写入后才报错
     withWriteSchemaGuard dependencies action = IPCStorage $ \env -> case dependencies of
         [] -> pure (Left "bound write requires a target schema guard")
         (target, _) : _ -> do
@@ -430,24 +458,25 @@ instance MonadStorage IPCStorage where
     -- \| 删一列
     dropColumn t c = IPCStorage $ \env -> ask env "drop_column" (ReqDropColumn t c) okOnly
 
-    -- \| 列表 + 逐表扫描拼库
-    snapshot = IPCStorage $ \env -> do
-        result <- doListCatalog env
-        case result of
+    -- \| 校验一致快照并复查提交点后发布领域
+    alterDomain name validate = IPCStorage $ \env -> do
+        snapshotResult <- ask env "domain_snapshot" ReqDomainSnapshot $ \case
+            RespDomainSnapshot infos rows checkpoint -> Just (infos, rows, checkpoint)
+            _ -> Nothing
+        case snapshotResult of
             Left err -> pure (Left err)
-            Right xs -> fmap sequence (mapM (loadEntry env) xs)
+            Right (infos, rows, checkpoint) -> case mapM (loadDomainEntry rows) infos >>= validate of
+                Left err -> pure (Left err)
+                Right cols -> ask env "alter_domain" (ReqAlterDomain name (map toWire cols) checkpoint) okOnly
       where
-        -- \| 读取表数据并保留扫描错误
-        loadEntry env info = do
-            rows <- doScan env (tiTable info)
-            pure $
-                fmap
-                    ( \rs ->
-                        ( tiTable info
-                        , Table (tiTable info) (schemaToColumns (tiColumns info)) rs (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info)
-                        )
-                    )
-                    rows
+        -- \| 保留快照身份并拒绝缺失的表数据
+        loadDomainEntry rows info = do
+            values <- maybe (Left "incomplete domain snapshot") Right (lookup (tiTable info) rows)
+            let key = tiTable info
+            Right (key, Table key (schemaToColumns (tiColumns info)) values (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info))
+
+    -- 在存储读门内获取同一版本的完整快照。
+    snapshot = IPCStorage $ \env -> fmap (fmap snd) (databaseSnapshot Nothing env)
 
     -- \| 只问数据字典要结构，设了当前库只留它的表
     schema = IPCStorage $ \env -> do

chusql-core/engine/src/ChuSQL/Core/Engine/Storage/Memory.hs

@@ -30,7 +30,7 @@ instance MonadStorage MemoryStorage where
     -- \| 纯状态视图在求值期间不受外部修改
     withSchemaGuard _ action = action
 
-    -- | 纯状态写入不受外部结构变更影响
+    -- \| 纯状态写入不受外部结构变更影响
     withWriteSchemaGuard _ action = action
 
     -- \| 全表扫描
@@ -81,6 +81,11 @@ instance MonadStorage MemoryStorage where
                                 db
                             )
 
+    -- \| 在同一状态转换内校验并发布领域
+    alterDomain name validate = MemoryStorage $ \db -> case validate db of
+        Left err -> Right (Left err, db)
+        Right cols -> runMemoryStorage (replaceSchema name cols []) db
+
     -- \| 原样返回当前库
     snapshot = MemoryStorage $ \db -> Right (Right db, db)
 

chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/AST.hs

@@ -1,15 +1,26 @@
-module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), OrderKey (..), makeSelect, distinctOrdering, orderPosition, orderExpression, orderKeyExpression) where
+module ChuSQL.Core.Engine.Syntax.AST (Statement (..), DomainDefinition (..), DomainAlter (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), OrderKey (..), makeSelect, distinctOrdering, orderPosition, orderExpression, orderKeyExpression) where
 
-import ChuSQL.Core.Model (Column (..), ColumnType, Value (..))
-import ChuSQL.Core.Engine.Runtime.Types (TypeId, TypeExpr, RuntimeValue)
 import ChuSQL.Core.Engine.Runtime.Functions (FunctionId)
+import ChuSQL.Core.Engine.Runtime.Types (RuntimeValue, TypeExpr, TypeId)
+import ChuSQL.Core.Model (Column (..), ColumnType, Value (..))
 
 -- 语法树：语句、数据来源、条件表达式、排序方向。
 
+-- | 领域的基础列属性及具名检查条件
+data DomainDefinition = DomainDefinition Column [(String, String)] deriving (Show, Eq)
+
+-- | 领域约束及默认值的结构变更
+data DomainAlter
+    = DomainDefault (Maybe Value)
+    | DomainNullable Bool
+    | DomainAddCheck (Maybe String) String
+    | DomainDropCheck String
+    deriving (Show, Eq)
+
 data Statement
     = Select
-        -- | 输出名称与投影表达式，普通列用 Col
         { selectItems :: [(String, Expr)]
+        -- ^ 输出名称与投影表达式，普通列用 Col
         , selectFrom :: FromClause
         , selectWhere :: Maybe Expr
         , selectGroupBy :: [String]
@@ -22,7 +33,8 @@ data Statement
     | Delete String (Maybe Expr)
     | Update String [(String, Expr)] (Maybe Expr)
     | CreateTable String [(String, Column)]
-    | CreateDomain String ColumnType
+    | CreateDomain String DomainDefinition
+    | AlterDomain String DomainAlter
     | DropDomain String
     | ShowDomains
     | DropTable String
@@ -40,35 +52,37 @@ data Statement
     | ShowGrants
     | ShowRoles
     | DropUser String
-    -- | 新角色：权限的载体，用户靠成员资格继承它的权限
-    | CreateRole String
-    -- | 删角色：连同它的授权与成员一起删
-    | DropRole String
-    -- | GRANT 权限 ON 表 TO 角色，末位表示带 WITH GRANT OPTION
-    | GrantPrivileges [String] String String Bool
-    -- | REVOKE 权限 ON 表 FROM 角色
-    | RevokePrivileges [String] String String
+    | -- | 新角色：权限的载体，用户靠成员资格继承它的权限
+      CreateRole String
+    | -- | 删角色：连同它的授权与成员一起删
+      DropRole String
+    | -- | GRANT 权限 ON 表 TO 角色，末位表示带 WITH GRANT OPTION
+      GrantPrivileges [String] String String Bool
+    | -- | REVOKE 权限 ON 表 FROM 角色
+      RevokePrivileges [String] String String
     | RevokeGrantOption [String] String String
-    -- | GRANT 角色 TO 用户：给用户加角色
-    | GrantRole String [String]
-    -- | REVOKE <角色> FROM <用户>[, ...]
-    | RevokeRole String [String]
+    | -- | GRANT 角色 TO 用户：给用户加角色
+      GrantRole String [String]
+    | -- | REVOKE <角色> FROM <用户>[, ...]
+      RevokeRole String [String]
     | CreateDatabase String
     | DropDatabase String
     | UseDatabase String
     | ShowDatabases
-    -- | 开事务：BEGIN / START TRANSACTION
-    | BeginTransaction
-    -- | 提交事务
-    | CommitTransaction
-    -- | 回滚事务
-    | RollbackTransaction
-    -- | 建保存点：SAVEPOINT 名字
-    | Savepoint String
-    -- | 回滚到保存点：ROLLBACK TO [SAVEPOINT] 名字
-    | RollbackToSavepoint String
-    -- | 释放保存点：RELEASE [SAVEPOINT] 名字
-    | ReleaseSavepoint String
+    | -- | 开事务：BEGIN / START TRANSACTION
+      BeginTransaction
+    | -- | 串行化快照事务
+      BeginSerializableTransaction
+    | -- | 提交事务
+      CommitTransaction
+    | -- | 回滚事务
+      RollbackTransaction
+    | -- | 建保存点：SAVEPOINT 名字
+      Savepoint String
+    | -- | 回滚到保存点：ROLLBACK TO [SAVEPOINT] 名字
+      RollbackToSavepoint String
+    | -- | 释放保存点：RELEASE [SAVEPOINT] 名字
+      ReleaseSavepoint String
     deriving (Show, Eq)
 
 -- | 连接类型：内连接与左外连接
@@ -86,7 +100,8 @@ data FromClause
     deriving (Show, Eq)
 
 -- | 子查询：语句，加上它对外层列的引用（自由变量，语义检查时填）
-data Subquery = Subquery
+data Subquery
+    = Subquery
         { subqueryStatement :: Statement
         , subqueryRefs :: [String]
         }
@@ -219,9 +234,9 @@ resolveDistinctOrdering :: Statement -> Either String [(OrderKey, SortDir)]
 resolveDistinctOrdering q = mapM resolve (selectOrderBy q)
   where
     items = case q of
-        Select { selectItems = projected } -> projected
+        Select{selectItems = projected} -> projected
         _ -> []
-    -- | 排序键必须出现在去重结果中
+    -- \| 排序键必须出现在去重结果中
     resolve (key, direction) = do
         position <- orderPosition (length items) key
         case position of
@@ -230,7 +245,7 @@ resolveDistinctOrdering q = mapM resolve (selectOrderBy q)
                 [slot] -> Right (OrderPosition slot, direction)
                 [] -> Left "DISTINCT: ORDER BY column must appear in the select list"
                 _ -> Left "DISTINCT: ambiguous ORDER BY column"
-    -- | 名称或完整表达式必须对应去重输出项
+    -- \| 名称或完整表达式必须对应去重输出项
     matches (OrderColumn column) label expression = label == column || expression == Col column
     matches (OrderExpression key) _ expression = key == expression
     matches (OrderPosition _) _ _ = False

chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs

@@ -1,16 +1,16 @@
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TupleSections #-}
 
 module ChuSQL.Core.Engine.Syntax.Parser (parseStatement, parseExpression) where
 
-import Data.Functor (($>))
-import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
 import ChuSQL.Core.Engine.Builtin (Builtin (..), builtinName, builtinNames, builtinNode, compareNode)
-import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Runtime.Types
+import ChuSQL.Core.Engine.Syntax.AST
+import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
 import Control.Monad (void)
 import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
 import Data.Char (isAlpha, isAlphaNum, isHexDigit, isSpace, toLower, toUpper)
+import Data.Functor (($>))
 import Data.List (intercalate, isInfixOf)
 import Data.Maybe (fromMaybe)
 import Data.Void (Void)
@@ -115,8 +115,9 @@ operatorTable =
     [ [Prefix (Neg <$ symbol "-")]
     , [InfixL (Mul <$ symbol "*"), InfixL (Div <$ symbol "/")]
     , [InfixL (Add <$ symbol "+"), InfixL (Sub <$ symbol "-")]
-    , [ InfixN comparisonOp ]
-    , [ Postfix inPredicate
+    , [InfixN comparisonOp]
+    ,
+        [ Postfix inPredicate
         , Postfix (try quantifiedCmp)
         , Postfix (IsNotNull <$ try (keyword "is" *> keyword "not" *> keyword "null"))
         , Postfix (IsNull <$ (keyword "is" *> keyword "null"))
@@ -210,7 +211,9 @@ subquerySelect = Subquery <$> queryStatement <*> pure []
 -- | 读取带具体类型参数的构造器
 constructorCall :: Parser Expr
 constructorCall = do
-    cid <- (TypeConstructorId 5 <$ keyword "list") <|> (TypeConstructorId 6 <$ keyword "maybe")
+    cid <-
+        (TypeConstructorId 5 <$ keyword "list")
+            <|> (TypeConstructorId 6 <$ keyword "maybe")
             <|> (TypeConstructorId 7 <$ keyword "tuple")
     arguments <- between (symbol "<") (symbol ">") (sepBy runtimeTypeP (symbol ","))
     values <- between (symbol "(") (symbol ")") (sepBy expr (symbol ","))
@@ -218,9 +221,14 @@ constructorCall = do
 
 -- | 解析运行时逻辑类型语法
 runtimeTypeP :: Parser TypeExpr
-runtimeTypeP = choice
-    [ intType <$ keyword "int", doubleType <$ keyword "double", boolType <$ keyword "bool"
-    , stringType <$ keyword "string", stringType <$ keyword "str", stringType <$ keyword "text"
+runtimeTypeP =
+    choice
+        [ intType <$ keyword "int"
+        , doubleType <$ keyword "double"
+        , boolType <$ keyword "bool"
+        , stringType <$ keyword "string"
+        , stringType <$ keyword "str"
+        , stringType <$ keyword "text"
         , listType <$> between (symbol "[") (symbol "]") runtimeTypeP
         , listType <$> (keyword "list" *> runtimeTypeP)
         , maybeType <$> (keyword "maybe" *> runtimeTypeP)
@@ -238,11 +246,11 @@ scalarFunctionCall = do
 aggregateCall :: Parser Expr
 aggregateCall = choice (countAll : map named builtinNames)
   where
-    -- | COUNT(*)，没有参数
+    -- \| COUNT(*)，没有参数
     countAll = CountAll <$ try (keyword (builtinName BCountAll) *> between (symbol "(") (symbol ")") (symbol "*"))
-    -- | 表里每一个带参数的内置函数
+    -- \| 表里每一个带参数的内置函数
     named (name, builtin) = builtinNode builtin <$> aggArg name
-    -- | 读聚合函数的参数
+    -- \| 读聚合函数的参数
     aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr)
 
 -- | 只认字面量，给 DEFAULT 用
@@ -252,14 +260,11 @@ literalValue =
         [ VNull <$ keyword "null"
         , VBool True <$ keyword "TRUE"
         , VBool False <$ keyword "FALSE"
-        , try (negateLit <$> floatLit)
+        , try (symbol "-" *> (VFloat . negate <$> try floatLit <|> VInt . negate <$> integer))
+        , try (VFloat <$> floatLit)
         , VInt <$> integer
-        , VFloat <$> try floatLit
         , VStr <$> stringLit
         ]
-  where
-    -- | 负浮点字面量
-    negateLit d = VFloat (negate d)
 
 -- | 一个排序键：输出序号、列名或表达式
 orderItem :: Parser (OrderKey, SortDir)
@@ -365,8 +370,10 @@ tableRef = do
 -- | 连接类型：内连接 / 左外连接
 joinKind :: Parser JoinKind
 joinKind =
-    try ((keyword "left" *> optional (keyword "outer") *> keyword "join")
-           $> LeftJoin)
+    try
+        ( (keyword "left" *> optional (keyword "outer") *> keyword "join")
+            $> LeftJoin
+        )
         <|> try ((keyword "inner" *> keyword "join") $> InnerJoin)
         <|> (keyword "join" $> InnerJoin)
 
@@ -430,7 +437,8 @@ createTableStatement = do
 
 -- | 读 DROP TABLE
 dropTableStatement :: Parser Statement
-dropTableStatement = do keyword "drop"
+dropTableStatement = do
+    keyword "drop"
     keyword "table"
     DropTable <$> tableName
 
@@ -491,7 +499,8 @@ alterTableStatement = do
 
 -- | 读 CREATE USER，口令是明文
 createUserStatement :: Parser Statement
-createUserStatement = do keyword "create"
+createUserStatement = do
+    keyword "create"
     keyword "user"
     name <- userName
     CreateUser name <$> identifiedBy
@@ -513,14 +522,18 @@ alterUserStatement = do
 
 -- | 读身份属性开关
 identityAttribute :: Parser (String, Bool)
-identityAttribute = choice
+identityAttribute =
+    choice
         [ ("allow_sudo_auth", True) <$ keyword "allow_sudo_auth"
         , ("allow_sudo_auth", False) <$ keyword "noallow_sudo_auth"
         , ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
         , ("system_catalog_manager", False) <$ keyword "nosystem_catalog_manager"
-    , ("login", True) <$ keyword "login", ("login", False) <$ keyword "nologin"
-    , ("superuser", True) <$ keyword "superuser", ("superuser", False) <$ keyword "nosuperuser"
-    , ("enabled", True) <$ keyword "enabled", ("enabled", False) <$ keyword "disabled"
+        , ("login", True) <$ keyword "login"
+        , ("login", False) <$ keyword "nologin"
+        , ("superuser", True) <$ keyword "superuser"
+        , ("superuser", False) <$ keyword "nosuperuser"
+        , ("enabled", True) <$ keyword "enabled"
+        , ("enabled", False) <$ keyword "disabled"
         ]
 
 -- | 读 ALTER ROLE 属性或口令
@@ -533,7 +546,8 @@ alterRoleStatement = do
 
 -- | 读 DROP USER
 dropUserStatement :: Parser Statement
-dropUserStatement = do keyword "drop"
+dropUserStatement = do
+    keyword "drop"
     keyword "user"
     DropUser <$> userName
 
@@ -566,9 +580,11 @@ privilegeName =
 
 -- | ON 后面的授权对象：* 或一张表
 grantObject :: Parser String
-grantObject = try (("database:" ++) <$> (keyword "database" *> identifier))
+grantObject =
+    try (("database:" ++) <$> (keyword "database" *> identifier))
         <|> try ((++ ".*") <$> (identifier <* symbol "." <* symbol "*"))
-    <|> ("*" <$ symbol "*") <|> (optional (keyword "table") *> tableName)
+        <|> ("*" <$ symbol "*")
+        <|> (optional (keyword "table") *> tableName)
 
 -- | 可选的 WITH GRANT OPTION
 grantOption :: Parser Bool
@@ -603,6 +619,64 @@ revokeStatement = do
         , if optionOnly then fail "GRANT OPTION FOR requires object privileges" else RevokeRole <$> userName <*> (keyword "from" *> sepBy1 userName (symbol ","))
         ]
 
+-- | 读取领域及其独立约束
+createDomainStatement :: Parser Statement
+createDomainStatement = do
+    name <- keyword "create" *> keyword "domain" *> identifier
+    ty <- keyword "as" *> columnTypeP
+    modifiers <- many domainConstraint
+    pure (CreateDomain name (foldl (flip ($)) (DomainDefinition (plainColumn ty) []) modifiers))
+
+-- | 读取领域属性或 CHECK 条件
+domainConstraint :: Parser (DomainDefinition -> DomainDefinition)
+domainConstraint =
+    choice
+        [ try (keyword "not" *> keyword "null") $> domainNull False
+        , keyword "null" $> domainNull True
+        , keyword "default" *> (domainDefault . Just <$> literalValue)
+        , do
+            name <- optional (keyword "constraint" *> identifier)
+            text <- keyword "check" *> checkText
+            pure (domainCheck (fromMaybe "" name) text)
+        ]
+
+-- | 设置领域非空声明
+domainNull :: Bool -> DomainDefinition -> DomainDefinition
+domainNull nullable (DomainDefinition column checks) = DomainDefinition column{columnNullable = nullable} checks
+
+-- | 设置领域默认值
+domainDefault :: Maybe Value -> DomainDefinition -> DomainDefinition
+domainDefault value (DomainDefinition column checks) = DomainDefinition column{columnDefault = value} checks
+
+-- | 增加领域检查条件
+domainCheck :: String -> String -> DomainDefinition -> DomainDefinition
+domainCheck name text (DomainDefinition column checks) = DomainDefinition column (checks ++ [(name, text)])
+
+-- | 读取领域约束与默认值变更
+alterDomainStatement :: Parser Statement
+alterDomainStatement = do
+    name <- keyword "alter" *> keyword "domain" *> identifier
+    action <-
+        choice
+            [ keyword "set"
+                *> choice
+                    [ DomainDefault . Just <$> (keyword "default" *> literalValue)
+                    , DomainNullable False <$ (keyword "not" *> keyword "null")
+                    ]
+            , keyword "drop"
+                *> choice
+                    [ DomainDefault Nothing <$ keyword "default"
+                    , DomainNullable True <$ (keyword "not" *> keyword "null")
+                    , DomainDropCheck <$> (keyword "constraint" *> identifier)
+                    ]
+            , keyword "add"
+                *> ( DomainAddCheck
+                        <$> optional (keyword "constraint" *> identifier)
+                        <*> (keyword "check" *> checkText)
+                   )
+            ]
+    pure (AlterDomain name action)
+
 -- | 建表时的一列：类型后面跟若干约束
 columnDef :: Parser (String, Column)
 columnDef = do
@@ -615,18 +689,24 @@ columnDef = do
 columnConstraint :: Parser (Column -> Column)
 columnConstraint =
     choice
-        [ try ((keyword "not" *> keyword "null")
-                 $> (\ c -> c {columnNullable = False}))
-        , keyword "null" $> (\ c -> c {columnNullable = True})
+        [ try
+            ( (keyword "not" *> keyword "null")
+                $> (\c -> c{columnNullable = False})
+            )
+        , keyword "null" $> (\c -> c{columnNullable = True})
         , keyword "auto_increment"
-            $>
-              (\ c -> c {columnAutoIncrement = True, columnNullable = False})
-        , try ((keyword "primary" *> keyword "key")
-                 $>
-                   (\ c
-                      -> c {columnPrimaryKey = True, columnUnique = True,
-                            columnNullable = False}))
-        , keyword "unique" $> (\ c -> c {columnUnique = True})
+            $> (\c -> c{columnAutoIncrement = True, columnNullable = False})
+        , try
+            ( (keyword "primary" *> keyword "key")
+                $> ( \c ->
+                        c
+                            { columnPrimaryKey = True
+                            , columnUnique = True
+                            , columnNullable = False
+                            }
+                   )
+            )
+        , keyword "unique" $> (\c -> c{columnUnique = True})
         , keyword "default" *> ((\v c -> c{columnDefault = Just v}) <$> literalValue)
         , keyword "check" *> ((\s c -> c{columnCheck = Just s}) <$> checkText)
         ]
@@ -669,7 +749,8 @@ columnTypeP =
 -- | 解析复合列的稳定类型身份
 runtimeColumnType :: Parser ColumnType
 runtimeColumnType = do
-    expression <- choice
+    expression <-
+        choice
             [ listType <$> between (symbol "[") (symbol "]") runtimeTypeP
             , listType <$> (keyword "list" *> runtimeTypeP)
             , maybeType <$> (keyword "maybe" *> runtimeTypeP)
@@ -734,7 +815,7 @@ queryStatement = withStatement <|> selectStatement
 expandWith :: [(String, [String], Statement)] -> Statement -> Either String Statement
 expandWith defs main = go [] defs
   where
-    -- | 前面的 CTE 已进环境，接着展开本体
+    -- \| 前面的 CTE 已进环境，接着展开本体
     go env [] = expandStatement env main
     go env ((name, cols, body) : rest) = do
         body' <- expandStatement env body
@@ -749,14 +830,15 @@ cteKey = map toLower
 renameColumns :: String -> [String] -> Statement -> Either String Statement
 renameColumns _ [] q = Right q
 renameColumns name cols (SelectDistinct q) = SelectDistinct <$> renameColumns name cols q
-renameColumns name cols q@Select { selectItems = items } = do
+renameColumns name cols q@Select{selectItems = items} = do
     checkCteArity name cols (map snd items)
-    ordering <- if all (\(label, expression) -> expression == Col label) items
+    ordering <-
+        if all (\(columnName, expression) -> expression == Col columnName) items
             then Right (selectOrderBy q)
             else mapM renameOrder (selectOrderBy q)
-    Right q { selectItems = zip cols (map snd items), selectOrderBy = ordering }
+    Right q{selectItems = zip cols (map snd items), selectOrderBy = ordering}
   where
-    -- | 列清单同步改写内层排序输出别名
+    -- \| 列清单同步改写内层排序输出别名
     renameOrder (OrderColumn column, direction) = case [new | ((old, _), new) <- zip items cols, old == column] of
         [] -> Right (OrderColumn column, direction)
         [new] -> Right (OrderColumn new, direction)
@@ -774,16 +856,16 @@ checkCteArity name cols out
 expandStatement :: [(String, Statement)] -> Statement -> Either String Statement
 expandStatement env stmt = case stmt of
     SelectDistinct q -> SelectDistinct <$> expandStatement env q
-    q@Select { selectFrom = fromC, selectItems = items, selectWhere = mWhere } -> do
+    q@Select{selectFrom = fromC, selectItems = items, selectWhere = mWhere} -> do
         fromC' <- expandClause env fromC
         items' <- traverse (\(name, e) -> fmap (name,) (expandExpr env e)) items
         w <- traverse (expandExpr env) mWhere
         having <- traverse (expandExpr env) (selectHaving q)
         ordering <- mapM expandOrder (selectOrderBy q)
-        Right q { selectFrom = fromC', selectItems = items', selectWhere = w, selectHaving = having, selectOrderBy = ordering }
+        Right q{selectFrom = fromC', selectItems = items', selectWhere = w, selectHaving = having, selectOrderBy = ordering}
     _ -> Right stmt
   where
-    -- | 展开排序表达式中的 CTE 子查询
+    -- \| 展开排序表达式中的 CTE 子查询
     expandOrder (OrderExpression expression, direction) = (,) . OrderExpression <$> expandExpr env expression <*> pure direction
     expandOrder ordering = Right ordering
 
@@ -832,10 +914,10 @@ expandExpr env e = case e of
     QuantCmp op x sq q -> (\x' sq' -> QuantCmp op x' sq' q) <$> go x <*> goSub sq
     _ -> Right e
   where
-    -- | 继续看子表达式
+    -- \| 继续看子表达式
     go = expandExpr env
-    -- | 继续看子查询里的语句
-    goSub sq = (\stmt -> sq { subqueryStatement = stmt }) <$> expandStatement env (subqueryStatement sq)
+    -- \| 继续看子查询里的语句
+    goSub sq = (\stmt -> sq{subqueryStatement = stmt}) <$> expandStatement env (subqueryStatement sq)
 
 -- | 读 INSERT，可一次插多行
 insertStatement :: Parser Statement
@@ -878,15 +960,18 @@ updateStatement = do
 -- | 事务控制语句
 transactionStatement :: Parser Statement
 transactionStatement =
-    try (BeginTransaction <$ (keyword "start" *> keyword "transaction"))
-        <|> (BeginTransaction <$ (keyword "begin" *> optional (keyword "transaction")))
+    (beginMode =<< (try (keyword "start" *> keyword "transaction") <|> (keyword "begin" *> void (optional (keyword "transaction")))))
         <|> (CommitTransaction <$ (keyword "commit" *> optional (keyword "transaction")))
         <|> try (RollbackToSavepoint <$> rollbackToName)
         <|> (RollbackTransaction <$ (keyword "rollback" *> optional (keyword "transaction")))
         <|> (Savepoint <$> (keyword "savepoint" *> identifier))
         <|> (ReleaseSavepoint <$> (keyword "release" *> optional (keyword "savepoint") *> identifier))
   where
-    -- | ROLLBACK TO [SAVEPOINT] 名字
+    -- 解析可选的串行化隔离级别。
+    beginMode _ = do
+        mode <- optional (keyword "isolation" *> keyword "level" *> keyword "serializable")
+        pure (maybe BeginTransaction (const BeginSerializableTransaction) mode)
+    -- \| ROLLBACK TO [SAVEPOINT] 名字
     rollbackToName =
         keyword "rollback" *> keyword "to" *> optional (keyword "savepoint") *> identifier
 
@@ -897,7 +982,7 @@ parseStatement input =
         Left err -> Left (safeParseError input err)
         Right q -> Right q
   where
-    -- | 按关键字分派到各语句解析器
+    -- \| 按关键字分派到各语句解析器
     statementP =
         withStatement
             <|> transactionStatement
@@ -907,7 +992,8 @@ parseStatement input =
             <|> (UseDatabase <$> (keyword "use" *> identifier))
             <|> try (ShowDatabases <$ (keyword "show" *> keyword "databases"))
             <|> try (ShowDomains <$ (keyword "show" *> keyword "domains"))
-            <|> try (CreateDomain <$> (keyword "create" *> keyword "domain" *> identifier) <*> (keyword "as" *> columnTypeP))
+            <|> try createDomainStatement
+            <|> try alterDomainStatement
             <|> try (DropDomain <$> (keyword "drop" *> keyword "domain" *> identifier))
             <|> insertStatement
             <|> deleteStatement

chusql-core/engine/test/NormalizationSpec.hs

@@ -19,49 +19,87 @@ spec = do
                 `shouldBe` True
             attributeClosure [] ["a"] `shouldBe` ["a"]
         it "accepts BCNF with a declared key" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [["a"]] [] True (Just True)))
+            fmap
+                (map verdict . findings)
+                ( analyzeNormalization
+                    schema
+                    (Declaration [["a"]] [] True (Just True))
+                )
                 `shouldBe` Right (replicate 4 Satisfied)
         it "detects partial dependencies of composite keys" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [["a", "b"]] [Dependency ["a"] ["c"]] True (Just True)))
+            fmap
+                (map verdict . findings)
+                ( analyzeNormalization
+                    schema
+                    (Declaration [["a", "b"]] [Dependency ["a"] ["c"]] True (Just True))
+                )
                 `shouldBe` Right [Satisfied, Violated, Violated, Violated]
         it "detects transitive dependencies and a preserving split" $ do
-            let analysis = analyzeNormalization schema
+            let analysis =
+                    analyzeNormalization
+                        schema
                         (Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True))
             fmap (map verdict . findings) analysis
                 `shouldBe` Right [Satisfied, Satisfied, Violated, Violated]
             fmap suggestions analysis
                 `shouldBe` Right [Decomposition [["b", "c"], ["a", "b"]] Satisfied Satisfied]
         it "distinguishes 3NF from BCNF and detects dependency loss" $ do
-            let analysis = analyzeNormalization schema
+            let analysis =
+                    analyzeNormalization
+                        schema
                         (Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True))
             fmap (map verdict . findings) analysis
                 `shouldBe` Right [Satisfied, Satisfied, Satisfied, Violated]
             fmap suggestions analysis
                 `shouldBe` Right [Decomposition [["b", "c"], ["a", "c"]] Satisfied Violated]
         it "does not certify incomplete dependencies" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [["a"]] [] False (Just True)))
+            fmap
+                (map verdict . findings)
+                ( analyzeNormalization
+                    schema
+                    (Declaration [["a"]] [] False (Just True))
+                )
                 `shouldBe` Right [Satisfied, Insufficient, Insufficient, Insufficient]
         it "requires an atomicity declaration" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [] [] True Nothing)) `shouldBe` Right (replicate 4 Insufficient)
+            fmap
+                (map verdict . findings)
+                ( analyzeNormalization
+                    schema
+                    (Declaration [] [] True Nothing)
+                )
+                `shouldBe` Right (replicate 4 Insufficient)
         it "propagates a declared 1NF violation" $ do
-            fmap (map verdict . findings) (analyzeNormalization schema
-                (Declaration [] [] True (Just False))) `shouldBe` Right (replicate 4 Violated)
+            fmap
+                (map verdict . findings)
+                ( analyzeNormalization
+                    schema
+                    (Declaration [] [] True (Just False))
+                )
+                `shouldBe` Right (replicate 4 Violated)
         it "rejects unknown attributes" $ do
             analyzeNormalization schema (Declaration [] [Dependency ["z"] ["a"]] True (Just True))
                 `shouldBe` Left "normalization: unknown or duplicate dependency attributes"
         it "rejects nonminimal declared candidate keys" $ do
-            analyzeNormalization schema (Declaration [["a", "b"]]
-                [Dependency ["a"] ["b", "c"]] True (Just True))
+            analyzeNormalization
+                schema
+                ( Declaration
+                    [["a", "b"]]
+                    [Dependency ["a"] ["b", "c"]]
+                    True
+                    (Just True)
+                )
                 `shouldBe` Left "normalization: declared candidate key is not minimal"
         it "includes the empty candidate key for constant relations" $ do
-            fmap candidateKeys (analyzeNormalization schema
-                (Declaration [] [Dependency [] ["a", "b", "c"]] True (Just True))) `shouldBe` Right [[]]
+            fmap
+                candidateKeys
+                ( analyzeNormalization
+                    schema
+                    (Declaration [] [Dependency [] ["a", "b", "c"]] True (Just True))
+                )
+                `shouldBe` Right [[]]
         it "rejects excessive exhaustive searches" $ do
-            analyzeNormalization [(show n, TInt) | n <- [1 :: Int .. 13]]
+            analyzeNormalization
+                [(show n, TInt) | n <- [1 :: Int .. 13]]
                 (Declaration [] [] True (Just True))
                 `shouldBe` Left "normalization: exhaustive analysis supports at most 12 columns"
   where

chusql-core/model/src/ChuSQL/Core/Model.hs

@@ -1,57 +1,58 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module ChuSQL.Core.Model
-    ( ColumnType (..)
-    , Column (..)
-    , pattern TInt
-    , pattern TStr
-    , pattern TBool
-    , TypeClass (..)
-    , Value (..)
-    , Row
-    , TableMeta (..)
-    , Histogram (..)
-    , Table (..)
-    , TableIdentity (..)
-    , Database
-    , histogramOf
-    , histogramFor
-    , colNames
-    , colType
-    , lookupTable
-    , resolveTable
-    , lastTablePart
-    , deriveQualifier
-    , allColumns
-    , qualify
-    , unqualify
-    , resolveColumn
-    , plainColumn
-    , typeLabel
-    , typeName
-    , parseColumnType
-    , domainTableName
-    , isDomainTable
-    , typeClassOf
-    , assignable
-    , comparableTypes
-    , integerType
-    , numericType
-    , valueFits
-    , coerceValue
-    , canonicalValue
-    , compareValue
-    , valuesEqual
-    , hashValue
-    ) where
+module ChuSQL.Core.Model (
+    ColumnType (..),
+    Column (..),
+    pattern TInt,
+    pattern TStr,
+    pattern TBool,
+    TypeClass (..),
+    Value (..),
+    Row,
+    TableMeta (..),
+    Histogram (..),
+    Table (..),
+    TableIdentity (..),
+    Database,
+    histogramOf,
+    histogramFor,
+    colNames,
+    colType,
+    lookupTable,
+    resolveTable,
+    lastTablePart,
+    deriveQualifier,
+    allColumns,
+    qualify,
+    unqualify,
+    resolveColumn,
+    plainColumn,
+    typeLabel,
+    typeName,
+    parseColumnType,
+    domainTableName,
+    isDomainTable,
+    typeClassOf,
+    assignable,
+    comparableTypes,
+    hasTypeCapability,
+    integerType,
+    numericType,
+    valueFits,
+    coerceValue,
+    canonicalValue,
+    compareValue,
+    valuesEqual,
+    hashValue,
+) where
 
+import ChuSQL.Core.Runtime
+import qualified Data.ByteString.Lazy.Char8 as BS
 import Data.Char (isDigit, isSpace, toLower)
 import Data.Hashable (Hashable (..))
 import Data.List (isPrefixOf, isSuffixOf, stripPrefix)
 import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Word (Word64)
-import ChuSQL.Core.Runtime
-import qualified Data.ByteString.Lazy.Char8 as BS
 
 -- 数据模型：列类型、列约束、值、行、表、数据库，外加查表小工具。
 
@@ -192,11 +193,11 @@ parseColumnType raw
         ("blob", []) -> Just CBlob
         _ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
   where
-    -- | 去掉空白的类型名
+    -- \| 去掉空白的类型名
     cleaned = map toLower (filter (not . isSpace) raw)
-    -- | 基础名与参数段
+    -- \| 基础名与参数段
     (base, rest) = span (/= '(') cleaned
-    -- | 括号里的参数表
+    -- \| 括号里的参数表
     args = case stripSuffixMaybe ")" (drop 1 rest) of
         Nothing -> []
         Just inner -> map (filter (not . isSpace)) (splitOn ',' inner)
@@ -265,6 +266,8 @@ typeClassOf CRuntime{} = RuntimeClass
 
 -- | 同大类可赋值；日期/时间列接受字符串字面量
 assignable :: ColumnType -> ColumnType -> Bool
+assignable (CDomain _ base) source = assignable base source
+assignable target (CDomain _ base) = assignable target base
 assignable target source
     | source == CNull = True
     | target == source = True
@@ -284,19 +287,29 @@ integerType _ = False
 
 -- | 比较用的类型族：同大类可比，日期时间与文本互比
 comparableTypes :: ColumnType -> ColumnType -> Bool
+comparableTypes (CDomain _ base) other = comparableTypes base other
+comparableTypes other (CDomain _ base) = comparableTypes other base
 comparableTypes a b
-    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = False
+    | a == CNull || b == CNull = True
+    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = a == b && hasTypeCapability EqCapability a
     | otherwise = a == CNull || b == CNull || sameClass || crossTemporal
   where
-    -- | 两个类型同属一个大类
+    -- \| 两个类型同属一个大类
     sameClass = typeClassOf a == typeClassOf b
-    -- | 时间与文本放在一起比
+    -- \| 时间与文本放在一起比
     crossTemporal = (temporal a && textual b) || (textual a && temporal b)
-    -- | 是不是时间类型
+    -- \| 是不是时间类型
     temporal t = typeClassOf t == TemporalClass
-    -- | 是不是文本类型
+    -- \| 是不是文本类型
     textual t = typeClassOf t == TextClass
 
+-- | 领域沿用基础类型的已注册值运算能力
+hasTypeCapability :: TypeCapability -> ColumnType -> Bool
+hasTypeCapability capability (CDomain _ base) = hasTypeCapability capability base
+hasTypeCapability capability (CRuntime tid) =
+    either (const False) (elem capability . descriptorCapabilities) (describeType builtinTypes tid)
+hasTypeCapability _ _ = True
+
 -- | 是不是数值类型
 numericType :: ColumnType -> Bool
 numericType t = typeClassOf t == NumericClass
@@ -380,9 +393,9 @@ toDecimal p s v
         VFloat d -> rounded d
         _ -> Left ("cannot put this value into " ++ typeLabel (CDecimal p s))
   where
-    -- | 缩放因子
+    -- \| 缩放因子
     scale = (10 :: Double) ^ s
-    -- | 按比例四舍五入
+    -- \| 按比例四舍五入
     rounded d
         | isNaN d || isInfinite d || isInfinite (d * scale) = Left "decimal value is not finite or exceeds precision"
         | abs result >= (10 :: Double) ^ (p - s) = Left "decimal value exceeds precision"
@@ -443,7 +456,6 @@ validTimeText t = case splitOn ':' t of
 allOf :: Int -> String -> Bool
 allOf n s = length s == n && all isDigit s
 
-
 -- | 引擎里的一行值
 data Value
     = VNull
@@ -480,7 +492,7 @@ compareValue a b = case (canonicalValue a, canonicalValue b) of
     (VFloat x, VFloat y) -> compare x y
     (VStr x, VStr y) -> compare x y
     (VBool x, VBool y) -> compare x y
-    (VRuntime tx x, VRuntime ty y) -> compare (encodeType tx, show (canonicalRuntime x)) (encodeType ty, show (canonicalRuntime y))
+    (VRuntime tx x, VRuntime ty y) -> compare (tx, x) (ty, y)
     (x, y) -> compare (valueRank x) (valueRank y)
 
 -- | 族的先后，只用来给异族值定序
@@ -504,7 +516,7 @@ hashValue v = case canonicalValue v of
     VFloat d -> hashWithSalt 1 d
     VStr t -> hashWithSalt 2 t
     VBool b -> hashWithSalt 3 b
-    VRuntime tid value -> hashWithSalt 4 (BS.unpack (encodeType tid), show (canonicalRuntime value))
+    VRuntime tid value -> hashWithSalt 4 (BS.unpack (encodeType tid), value)
 
 -- | 解析现有标量列的逻辑类型
 scalarTypeExpression :: ColumnType -> Maybe TypeExpr
@@ -526,14 +538,6 @@ scalarRuntimeValue (VBool b) = Just (RBool b)
 scalarRuntimeValue (VStr text) = Just (RString text)
 scalarRuntimeValue _ = Nothing
 
--- | 统一复合值中的浮点零关键字
-canonicalRuntime :: RuntimeValue -> RuntimeValue
-canonicalRuntime (RDouble n) | n == 0 = RDouble 0
-canonicalRuntime (RList values) = RList (map canonicalRuntime values)
-canonicalRuntime (RMaybe value) = RMaybe (fmap canonicalRuntime value)
-canonicalRuntime (RTuple values) = RTuple (map canonicalRuntime values)
-canonicalRuntime value = value
-
 -- | 值按类型打散搅拌
 instance Hashable Value where
     hashWithSalt s = hashWithSalt s . hashValue
@@ -635,11 +639,11 @@ resolveTable db name = case lookup name db of
         | [(key, table)] <- suffixed -> Right (key, table)
         | otherwise -> Left (miss suffixed)
   where
-    -- | 引用里去掉库前缀的那一段
+    -- \| 引用里去掉库前缀的那一段
     bare = lastTablePart name
-    -- | schema 里以这个表名收尾的键：`sales.users` 能推出裸表名引用
+    -- \| schema 里以这个表名收尾的键：`sales.users` 能推出裸表名引用
     suffixed = [(key, table) | (key, table) <- db, ('.' : name) `isSuffixOf` key]
-    -- | 一个候选都没有就是查无此表，多于一个就是有歧义
+    -- \| 一个候选都没有就是查无此表，多于一个就是有歧义
     miss [] = "unknown table: " ++ name
     miss _ = "ambiguous table: " ++ name
 
@@ -664,6 +668,8 @@ resolveColumn name env = case [(k, v) | (k, v) <- env, matches k] of
     [] -> Left ("unknown column: " ++ name)
     _ -> Left ("ambiguous column: " ++ name)
   where
-    -- | 裸名匹配末段，库限定名只补一层前缀
-    matches k = k == name || ('.' : name) `isSuffixOf` k
+    -- \| 裸名匹配末段，库限定名只补一层前缀
+    matches k =
+        k == name
+            || ('.' : name) `isSuffixOf` k
             || (length (filter (== '.') name) == 2 && length (filter (== '.') k) == 1 && ('.' : k) `isSuffixOf` name)

chusql-core/model/src/ChuSQL/Core/Protocol.hs

@@ -105,6 +105,14 @@ data Request
     | ReqDropIndex String String
     | ReqDropColumn String String
     | ReqReplaceSchema String [SchemaColumn] [Row]
+    | ReqDomainSnapshot
+    | ReqDatabaseSnapshot (Maybe String)
+    | ReqMvccBegin Bool
+    | ReqMvccLock String [TxnOp] [String]
+    | ReqMvccPreview String
+    | ReqMvccCommit String String
+    | ReqMvccRollback String
+    | ReqAlterDomain String [SchemaColumn] String
     | ReqListCatalog
     | ReqApplyTransaction [TxnOp]
 
@@ -253,6 +261,14 @@ instance ToJSON Request where
             , "columns" .= cols
             , "rows" .= map rowToJSON rs
             ]
+    toJSON (ReqMvccBegin serializable) = object ["method" .= ("mvcc_begin" :: T.Text), "serializable" .= serializable]
+    toJSON (ReqMvccLock token ops dependencies) = object ["method" .= ("mvcc_lock" :: T.Text), "transaction" .= token, "ops" .= ops, "reads" .= dependencies]
+    toJSON (ReqMvccPreview token) = object ["method" .= ("mvcc_preview" :: T.Text), "transaction" .= token]
+    toJSON (ReqMvccCommit token checkpoint) = object ["method" .= ("mvcc_commit" :: T.Text), "transaction" .= token, "checkpoint" .= checkpoint, "ops" .= ([] :: [TxnOp])]
+    toJSON (ReqMvccRollback token) = object ["method" .= ("mvcc_rollback" :: T.Text), "transaction" .= token]
+    toJSON ReqDomainSnapshot = object ["method" .= ("domain_snapshot" :: T.Text)]
+    toJSON (ReqDatabaseSnapshot checkpoint) = object ["method" .= ("database_snapshot" :: T.Text), "checkpoint" .= checkpoint]
+    toJSON (ReqAlterDomain name columns checkpoint) = object ["method" .= ("alter_domain" :: T.Text), "table" .= name, "columns" .= columns, "checkpoint" .= checkpoint]
     toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
     toJSON (ReqApplyTransaction ops) =
         object
@@ -418,6 +434,9 @@ data Response
     | RespOk
     | RespError String
     | RespCatalog [TableInfo]
+    | RespDomainSnapshot [TableInfo] [(String, [Row])] String
+    | RespSnapshotUnchanged String
+    | RespMvccSnapshot String [TableInfo] [(String, [Row])] String
 
 -- | JSON 解回响应
 instance FromJSON Response where
@@ -432,6 +451,17 @@ instance FromJSON Response where
             "tables" -> RespTables <$> o .: "tables"
             "error" -> RespError <$> o .: "message"
             "schema" -> RespSchema <$> parseJSON (A.Object o)
+            "snapshot_unchanged" -> RespSnapshotUnchanged <$> o .: "checkpoint"
+            "mvcc_snapshot" -> do
+                schemas <- o .: "schemas"
+                tables <- o .: "rows" :: Parser [(String, [A.Value])]
+                rows <- mapM (\(name, values) -> (,) name <$> mapM rowFromJSON values) tables
+                RespMvccSnapshot <$> o .: "transaction" <*> pure schemas <*> pure rows <*> o .: "checkpoint"
+            "domain_snapshot" -> do
+                schemas <- o .: "schemas"
+                tables <- o .: "rows" :: Parser [(String, [A.Value])]
+                rows <- mapM (\(name, values) -> (,) name <$> mapM rowFromJSON values) tables
+                RespDomainSnapshot schemas rows <$> o .: "checkpoint"
             "catalog" -> do
                 xs <- o .: "schemas" :: Parser [A.Value]
                 RespCatalog <$> mapM parseJSON xs

chusql-core/model/src/ChuSQL/Core/Runtime.hs

@@ -1,19 +1,45 @@
-module ChuSQL.Core.Runtime
-    ( TypeConstructorId (..), TypeId, TypeExpr (..), Kind (..)
-    , TypeRegistry, TypeDescriptor (..), PhysicalType (..), RuntimeValue (..)
-    , builtinTypes, resolveType, describeType, typeExpression
-    , intType, doubleType, boolType, stringType, listType, maybeType, tupleType, renderTypeExpr, parseTypeExpr, renderRuntimeValue
-    , validateValue, encodeValue, decodeValue, encodeType, decodeType, runtimeToJSON, runtimeFromJSON
-    ) where
+module ChuSQL.Core.Runtime (
+    TypeConstructorId (..),
+    TypeId,
+    TypeExpr (..),
+    Kind (..),
+    TypeRegistry,
+    TypeDescriptor (..),
+    TypeCapability (..),
+    PhysicalType (..),
+    RuntimeValue (..),
+    builtinTypes,
+    resolveType,
+    describeType,
+    typeExpression,
+    intType,
+    doubleType,
+    boolType,
+    stringType,
+    listType,
+    maybeType,
+    tupleType,
+    renderTypeExpr,
+    parseTypeExpr,
+    renderRuntimeValue,
+    validateValue,
+    encodeValue,
+    decodeValue,
+    encodeType,
+    decodeType,
+    runtimeToJSON,
+    runtimeFromJSON,
+) where
 
 import Control.Monad (zipWithM, zipWithM_)
 import Data.Aeson (Value (..), eitherDecode, encode)
 import Data.Aeson.Types (Parser, parseEither)
 import qualified Data.ByteString.Lazy as BS
+import Data.Char (isAlphaNum, toLower)
+import Data.Hashable (Hashable (..))
 import Data.Scientific (floatingOrInteger)
 import qualified Data.Text as T
 import qualified Data.Vector as V
-import Data.Char (isAlphaNum, toLower)
 import qualified Text.ParserCombinators.ReadP as P
 
 -- 运行时类型身份、构造器注册及版本化物理编码。
@@ -31,30 +57,66 @@ newtype TypeId = TypeId TypeExpr deriving (Show, Eq, Ord)
 data Kind = TypeKind | TypeArrow Kind Kind | ProductKind deriving (Show, Eq)
 
 -- | 描述独立的物理表示
-data PhysicalType = SignedInteger | FloatingPoint | Boolean | Utf8 | Sequence PhysicalType
-    | Optional PhysicalType | Product [PhysicalType] deriving (Show, Eq)
+data PhysicalType
+    = SignedInteger
+    | FloatingPoint
+    | Boolean
+    | Utf8
+    | Sequence PhysicalType
+    | Optional PhysicalType
+    | Product [PhysicalType]
+    deriving (Show, Eq)
+
+-- | 类型实例可提供的值运算
+data TypeCapability = EqCapability | OrdCapability | HashCapability deriving (Show, Eq)
 
 -- | 保存类型实例描述
 data TypeDescriptor = TypeDescriptor
-    { descriptorId :: TypeId, descriptorName :: String, descriptorPhysical :: PhysicalType
-    } deriving (Show, Eq)
+    { descriptorId :: TypeId
+    , descriptorName :: String
+    , descriptorPhysical :: PhysicalType
+    , descriptorCapabilities :: [TypeCapability]
+    }
+    deriving (Show, Eq)
 
 -- | 保存构造器元数据
 newtype TypeRegistry = TypeRegistry [(TypeConstructorId, String, Kind)] deriving (Show, Eq)
 
 -- | 表达运行时值
-data RuntimeValue = RInt Int | RDouble Double | RBool Bool | RString String
-    | RList [RuntimeValue] | RMaybe (Maybe RuntimeValue) | RTuple [RuntimeValue]
-    deriving (Show, Eq)
+data RuntimeValue
+    = RInt Int
+    | RDouble Double
+    | RBool Bool
+    | RString String
+    | RList [RuntimeValue]
+    | RMaybe (Maybe RuntimeValue)
+    | RTuple [RuntimeValue]
+    deriving (Show, Eq, Ord)
+
+-- | 递归哈希结构并统一浮点正负零
+instance Hashable RuntimeValue where
+    -- \| 根据构造器和子值混合哈希
+    hashWithSalt salt value = case value of
+        RInt n -> hashWithSalt (hashWithSalt salt (1 :: Int)) n
+        RDouble n -> hashWithSalt (hashWithSalt salt (2 :: Int)) (if n == 0 then 0 else n)
+        RBool flag -> hashWithSalt (hashWithSalt salt (3 :: Int)) flag
+        RString text -> hashWithSalt (hashWithSalt salt (4 :: Int)) text
+        RList values -> hashWithSalt (hashWithSalt salt (5 :: Int)) values
+        RMaybe optional -> hashWithSalt (hashWithSalt salt (6 :: Int)) optional
+        RTuple values -> hashWithSalt (hashWithSalt salt (7 :: Int)) values
 
 -- | 恢复固定编号的内建构造器
 builtinTypes :: TypeRegistry
-builtinTypes = TypeRegistry
-    [(TypeConstructorId 1, "Int", TypeKind), (TypeConstructorId 2, "Double", TypeKind)
-    ,(TypeConstructorId 3, "Bool", TypeKind), (TypeConstructorId 4, "String", TypeKind)
-    ,(TypeConstructorId 5, "List", TypeArrow TypeKind TypeKind)
-    ,(TypeConstructorId 6, "Maybe", TypeArrow TypeKind TypeKind)
-    ,(TypeConstructorId 7, "Tuple", ProductKind)]
+builtinTypes =
+    TypeRegistry
+        [ (TypeConstructorId 1, "Int", TypeKind)
+        , (TypeConstructorId 2, "Double", TypeKind)
+        , (TypeConstructorId 3, "Bool", TypeKind)
+        , (TypeConstructorId 4, "String", TypeKind)
+        , (TypeConstructorId 5, "List", TypeArrow TypeKind TypeKind)
+        , (TypeConstructorId 6, "Maybe", TypeArrow TypeKind TypeKind)
+        , (TypeConstructorId 7, "Tuple", ProductKind)
+        ]
 
 -- | 构造整数类型表达式
 intType :: TypeExpr
@@ -96,7 +158,7 @@ renderTypeExpr ty@(TypeApply cid arguments) = case (cid, arguments) of
     (TypeConstructorId 7, fields) -> "(" ++ joinTypes fields ++ ")"
     _ -> show ty
   where
-    -- | 连接元组字段类型
+    -- \| 连接元组字段类型
     joinTypes [] = ""
     joinTypes [field] = renderTypeExpr field
     joinTypes (field : fields) = renderTypeExpr field ++ ", " ++ joinTypes fields
@@ -107,25 +169,28 @@ parseTypeExpr source = case P.readP_to_S (P.skipSpaces *> expression <* P.skipSp
     [(ty, "")] -> Right ty
     _ -> Left "invalid runtime type expression"
   where
-    -- | 解析类型原子和构造器应用
-    expression = (intType <$ token "int") P.<++ (doubleType <$ token "double")
-        P.<++ (boolType <$ token "bool") P.<++ (stringType <$ token "string")
+    -- \| 解析类型原子和构造器应用
+    expression =
+        (intType <$ token "int")
+            P.<++ (doubleType <$ token "double")
+            P.<++ (boolType <$ token "bool")
+            P.<++ (stringType <$ token "string")
             P.<++ (listType <$> between "[" "]" expression)
             P.<++ (listType <$> (token "list" *> expression))
             P.<++ (maybeType <$> (token "maybe" *> expression))
             P.<++ (tupleType <$> between "(" ")" (P.sepBy expression (symbol ",")))
-    -- | 解析具有名称边界的类型关键字
+    -- \| 解析具有名称边界的类型关键字
     token word = do
         mapM_ character word
         rest <- P.look
         case rest of
             c : _ | isAlphaNum c || c == '_' -> P.pfail
             _ -> P.skipSpaces
-    -- | 不区分大小写匹配关键字字符
+    -- \| 不区分大小写匹配关键字字符
     character c = P.satisfy ((== c) . toLower)
-    -- | 解析类型分隔符
+    -- \| 解析类型分隔符
     symbol text = P.string text <* P.skipSpaces
-    -- | 解析括号包围的类型
+    -- \| 解析括号包围的类型
     between open close = P.between (symbol open) (symbol close)
 
 -- | 渲染运行时值的可读文本
@@ -165,7 +230,12 @@ resolveType registry@(TypeRegistry constructors) expression@(TypeApply cid args)
         (TypeConstructorId 6, TypeArrow TypeKind TypeKind, [child]) -> Right (Optional child)
         (TypeConstructorId 7, ProductKind, fields) -> Right (Product fields)
         _ -> Left ("invalid type constructor application: " ++ name)
-    Right (TypeDescriptor (TypeId expression) name physical)
+    let capabilities =
+            [ capability
+            | capability <- [EqCapability, OrdCapability, HashCapability]
+            , all (elem capability . descriptorCapabilities) children
+            ]
+    Right (TypeDescriptor (TypeId expression) name physical capabilities)
 
 -- | 按身份查询类型描述
 describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
@@ -216,7 +286,9 @@ decodeValue registry expected bytes = do
     json <- eitherDecode bytes
     (expression, payload) <- parseEither parseEnvelope json
     descriptor <- resolveType registry expression
-    if descriptorId descriptor /= expected then Left "encoded value type identity mismatch" else do
+    if descriptorId descriptor /= expected
+        then Left "encoded value type identity mismatch"
+        else do
             value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
             validateValue registry expected value
             Right value

chusql-core/storage/src/btree.rs

@@ -22,7 +22,8 @@ const SLOT: usize = 2;
 const CELL_FIXED: usize = 2 + 8;
 
 /// 键长上限：节点里的格子必须放得进一页
-pub const MAX_KEY_BYTES: usize = 64;
+pub const MAX_KEY_BYTES: usize = 128;
+const LEGACY_KEY_BYTES: usize = 64;
 
 /// 一个节点最多几个键
 fn max_keys(order: usize) -> usize {
@@ -31,7 +32,7 @@ fn max_keys(order: usize) -> usize {
 
 /// 一个格子最多占多少字节
 fn max_cell_bytes() -> usize {
-    CELL_FIXED + MAX_KEY_BYTES
+    CELL_FIXED + LEGACY_KEY_BYTES
 }
 
 /// 这个 order 放得进一页吗
@@ -44,6 +45,16 @@ pub fn max_order(page_size: usize) -> usize {
     page_size.saturating_sub(HEADER) / (SLOT + max_cell_bytes()) + 1
 }
 
+/// 按页容量和分支数计算有效键长
+pub fn key_limit(page_size: usize, order: usize) -> usize {
+    if order < 2 {
+        return 0;
+    }
+    (page_size.saturating_sub(HEADER) / (order - 1))
+        .saturating_sub(SLOT + CELL_FIXED)
+        .min(MAX_KEY_BYTES)
+}
+
 /// 读一个 u8
 fn read_u8(p: &Page, off: usize) -> u8 {
     p.data[off]
@@ -66,7 +77,12 @@ fn write_u16(p: &mut Page, off: usize, v: u16) {
 
 /// 读一个小端 u32
 fn read_u32(p: &Page, off: usize) -> u32 {
-    u32::from_le_bytes([p.data[off], p.data[off + 1], p.data[off + 2], p.data[off + 3]])
+    u32::from_le_bytes([
+        p.data[off],
+        p.data[off + 1],
+        p.data[off + 2],
+        p.data[off + 3],
+    ])
 }
 
 /// 写一个小端 u32
@@ -91,7 +107,7 @@ fn write_meta(page: &mut Page, page_size: usize, order: usize, root: PageId) {
     page.zero();
     page.data[0..4].copy_from_slice(META_MAGIC);
     write_u32(page, OFF_PAGE_SIZE, page_size as u32);
-    write_u16(page, OFF_MAX_KEY, MAX_KEY_BYTES as u16);
+    write_u16(page, OFF_MAX_KEY, key_limit(page_size, order) as u16);
     write_u64(page, OFF_ROOT, root);
     write_u16(page, OFF_ORDER, order as u16);
 }
@@ -115,6 +131,13 @@ fn check_meta(page: &Page, page_size: usize, order: usize) -> io::Result<()> {
             ),
         ));
     }
+    let stored_key = read_u16(page, OFF_MAX_KEY) as usize;
+    if stored_key < LEGACY_KEY_BYTES || stored_key > key_limit(page_size, order) {
+        return Err(io::Error::new(
+            io::ErrorKind::InvalidData,
+            "unsupported index key limit",
+        ));
+    }
     Ok(())
 }
 
@@ -169,13 +192,19 @@ fn put_node(p: &mut Page, node: &Node) -> io::Result<()> {
 /// 从一页读出节点
 fn get_node(p: &Page) -> io::Result<Node> {
     if p.data.len() < HEADER {
-        return Err(io::Error::new(io::ErrorKind::InvalidData, "truncated index node header"));
+        return Err(io::Error::new(
+            io::ErrorKind::InvalidData,
+            "truncated index node header",
+        ));
     }
     let kind = read_u8(p, OFF_KIND);
     let count = read_u16(p, OFF_COUNT) as usize;
     let slots_end = HEADER + count * SLOT;
     if !matches!(kind, NODE_LEAF | NODE_INTERNAL) || slots_end > p.data.len() {
-        return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid index node kind or slot count"));
+        return Err(io::Error::new(
+            io::ErrorKind::InvalidData,
+            "invalid index node kind or slot count",
+        ));
     }
     let trailer = read_u64(p, OFF_NEXT);
     let mut keys = Vec::with_capacity(count);
@@ -184,30 +213,55 @@ fn get_node(p: &Page) -> io::Result<Node> {
     for i in 0..count {
         let off = read_u16(p, HEADER + i * SLOT) as usize;
         if off < slots_end || off + CELL_FIXED > p.data.len() {
-            return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid index cell offset"));
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidData,
+                "invalid index cell offset",
+            ));
         }
         let klen = read_u16(p, off) as usize;
         if klen > MAX_KEY_BYTES || off + CELL_FIXED + klen > p.data.len() {
-            return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid index key length"));
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidData,
+                "invalid index key length",
+            ));
         }
         if off + CELL_FIXED + klen > cell_end {
-            return Err(io::Error::new(io::ErrorKind::InvalidData, "overlapping index cells"));
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidData,
+                "overlapping index cells",
+            ));
         }
         cell_end = off;
         keys.push(p.data[off + 2..off + 2 + klen].to_vec());
         values.push(read_u64(p, off + 2 + klen));
     }
     if keys.windows(2).any(|pair| pair[0] > pair[1]) {
-        return Err(io::Error::new(io::ErrorKind::InvalidData, "index keys are not sorted"));
+        return Err(io::Error::new(
+            io::ErrorKind::InvalidData,
+            "index keys are not sorted",
+        ));
     }
     if kind == NODE_INTERNAL {
         values.push(trailer);
         if values.contains(&META_PAGE) {
-            return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid index child page"));
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidData,
+                "invalid index child page",
+            ));
         }
-        Ok(Node { kind, next: 0, keys, values })
+        Ok(Node {
+            kind,
+            next: 0,
+            keys,
+            values,
+        })
     } else {
-        Ok(Node { kind, next: trailer, keys, values })
+        Ok(Node {
+            kind,
+            next: trailer,
+            keys,
+            values,
+        })
     }
 }
 
@@ -244,7 +298,12 @@ fn split_node(node: &mut Node) -> (Vec<u8>, Node) {
         node.keys.pop();
         (
             sep,
-            Node { kind: NODE_INTERNAL, next: 0, keys: right_keys, values: right_values },
+            Node {
+                kind: NODE_INTERNAL,
+                next: 0,
+                keys: right_keys,
+                values: right_values,
+            },
         )
     }
 }
@@ -287,20 +346,26 @@ impl DiskBTree {
     }
 
     /// 键太长直接报错，避免写坏节点
-    fn check_key(&self, key: &[u8]) -> io::Result<()> {
-        if key.len() > MAX_KEY_BYTES {
+    pub(crate) fn check_key(key: &[u8], page_size: usize, order: usize) -> io::Result<()> {
+        let limit = key_limit(page_size, order);
+        if key.len() > limit {
             return Err(io::Error::new(
                 io::ErrorKind::InvalidInput,
                 format!(
                     "index key is {} bytes, at most {} are supported",
                     key.len(),
-                    MAX_KEY_BYTES
+                    limit
                 ),
             ));
         }
         Ok(())
     }
 
+    /// 按当前索引配置预检键长
+    pub(crate) fn validate_key(&self, key: &[u8]) -> io::Result<()> {
+        Self::check_key(key, self.file.page_size(), self.order)
+    }
+
     /// 读根页页号；空树是 None
     fn root(&mut self) -> io::Result<Option<PageId>> {
         let r = self.file.with_page(META_PAGE, |p| read_u64(p, OFF_ROOT))?;
@@ -331,6 +396,11 @@ impl DiskBTree {
         self.file.update_page(id, |p| put_node(p, node))?
     }
 
+    /// 设置后续索引页的提交点
+    pub(crate) fn set_lsn(&mut self, lsn: u64) {
+        self.file.set_lsn(lsn);
+    }
+
     /// 清空整棵树
     pub fn clear(&mut self) -> io::Result<()> {
         let page_size = self.file.page_size();
@@ -362,14 +432,26 @@ impl DiskBTree {
 
     /// 按 key 取全部位置（重复键按值升序）
     pub fn get_all(&mut self, key: &[u8]) -> io::Result<Vec<u64>> {
-        let mut values: Vec<_> = self.scan(Some(key), Some(key))?.into_iter().map(|(_, value)| value).collect();
+        let mut values: Vec<_> = self
+            .scan(Some(key), Some(key))?
+            .into_iter()
+            .map(|(_, value)| value)
+            .collect();
         values.sort_unstable();
         Ok(values)
     }
 
     /// 插入一个键值对（键可重复）
     pub fn insert(&mut self, key: &[u8], value: u64) -> io::Result<()> {
-        self.check_key(key)?;
+        self.validate_key(key)?;
+        if key.len() > LEGACY_KEY_BYTES {
+            let limit = key_limit(self.file.page_size(), self.order);
+            let mut meta = self.file.read_page(META_PAGE)?;
+            if read_u16(&meta, OFF_MAX_KEY) as usize != limit {
+                write_u16(&mut meta, OFF_MAX_KEY, limit as u16);
+                self.file.write_page(&meta)?;
+            }
+        }
         match self.root()? {
             None => {
                 let node = Node {
@@ -412,7 +494,9 @@ impl DiskBTree {
         } else {
             let child = node.values[child_slot(&node.keys, key)];
             if let Some((sep, right_id)) = self.insert_rec(child, key, value)? {
-                let at = node.keys.partition_point(|k| k.as_slice() <= sep.as_slice());
+                let at = node
+                    .keys
+                    .partition_point(|k| k.as_slice() <= sep.as_slice());
                 node.keys.insert(at, sep);
                 node.values.insert(at + 1, right_id);
             }

chusql-core/storage/src/catalog.rs

@@ -37,6 +37,8 @@ pub struct TableSchema {
     #[serde(default)]
     pub object_id: u64,
     #[serde(default)]
+    pub file_generation: String,
+    #[serde(default)]
     // 0 表示旧目录尚无可验证的结构版本。
     pub schema_version: u64,
     #[serde(default)]
@@ -78,6 +80,13 @@ impl Catalog {
             return Ok(Catalog::default());
         }
         let mut catalog: Self = serde_json::from_slice(&bytes).map_err(io::Error::other)?;
+        if catalog
+            .tables
+            .values()
+            .any(|schema| !valid_generation(&schema.file_generation))
+        {
+            return Err(io::Error::other("invalid physical file generation"));
+        }
         catalog.upgrade_object_ids()?;
         Ok(catalog)
     }
@@ -94,7 +103,9 @@ impl Catalog {
         }
         for schema in self.tables.values_mut() {
             if schema.object_id == 0 {
-                self.object_high_water = self.object_high_water.checked_add(1)
+                self.object_high_water = self
+                    .object_high_water
+                    .checked_add(1)
                     .ok_or_else(|| io::Error::other("catalog object id exhausted"))?;
                 schema.object_id = self.object_high_water;
             }
@@ -102,9 +113,37 @@ impl Catalog {
         Ok(())
     }
 
+    /// 切换物理文件代次而不改变逻辑结构版本
+    pub(crate) fn set_generation(
+        &mut self,
+        table: &str,
+        object: u64,
+        source: &str,
+        target: &str,
+    ) -> io::Result<()> {
+        if !valid_generation(target) {
+            return Err(io::Error::other("invalid physical file generation"));
+        }
+        let schema = self
+            .tables
+            .get_mut(table)
+            .ok_or_else(|| io::Error::other("migration table missing"))?;
+        if schema.object_id != object
+            || (schema.file_generation != source && schema.file_generation != target)
+        {
+            return Err(io::Error::other(
+                "serialization_failure: migration object changed",
+            ));
+        }
+        schema.file_generation = target.to_owned();
+        Ok(())
+    }
+
     /// 分配不复用的对象编号
     pub fn reserve_object_id(&mut self) -> io::Result<u64> {
-        self.object_high_water = self.object_high_water.checked_add(1)
+        self.object_high_water = self
+            .object_high_water
+            .checked_add(1)
             .ok_or_else(|| io::Error::other("catalog object id exhausted"))?;
         Ok(self.object_high_water)
     }
@@ -123,7 +162,11 @@ impl Catalog {
         file.sync_all()?;
         drop(file);
         std::fs::rename(pending, &path)?;
-        std::fs::OpenOptions::new().read(true).write(true).open(path)?.sync_all()
+        std::fs::OpenOptions::new()
+            .read(true)
+            .write(true)
+            .open(path)?
+            .sync_all()
     }
 
     /// 一张表的 schema
@@ -149,7 +192,12 @@ impl Catalog {
     }
 
     /// 按日志中的编号建立表
-    pub fn create_table_with_id(&mut self, table: &str, columns: Vec<SchemaColumn>, object_id: Option<u64>) -> io::Result<()> {
+    pub fn create_table_with_id(
+        &mut self,
+        table: &str,
+        columns: Vec<SchemaColumn>,
+        object_id: Option<u64>,
+    ) -> io::Result<()> {
         if self.tables.contains_key(table) {
             return Err(io::Error::new(
                 io::ErrorKind::AlreadyExists,
@@ -160,13 +208,17 @@ impl Catalog {
             Some(id) if id == 0 || self.tables.values().any(|schema| schema.object_id == id) => {
                 return Err(io::Error::other("invalid catalog object id"));
             }
-            Some(id) => { self.object_high_water = self.object_high_water.max(id); id }
+            Some(id) => {
+                self.object_high_water = self.object_high_water.max(id);
+                id
+            }
             None => self.reserve_object_id()?,
         };
         self.tables.insert(
             table.to_string(),
             TableSchema {
                 object_id,
+                file_generation: String::new(),
                 schema_version: 1,
                 system: false,
                 columns,
@@ -182,7 +234,9 @@ impl Catalog {
 
     /// 标记内部账号表
     pub fn mark_system(&mut self, table: &str) -> io::Result<()> {
-        let entry = self.tables.get_mut(table)
+        let entry = self
+            .tables
+            .get_mut(table)
             .ok_or_else(|| io::Error::other("missing system table"))?;
         entry.system = true;
         Ok(())
@@ -306,7 +360,10 @@ impl Catalog {
             ));
         }
         let version = next_schema_version(entry)?;
-        let mut entry = self.tables.remove(from).ok_or_else(|| io::Error::other("missing rename source"))?;
+        let mut entry = self
+            .tables
+            .remove(from)
+            .ok_or_else(|| io::Error::other("missing rename source"))?;
         entry.schema_version = version;
         self.seen.remove(from);
         self.tables.insert(to.to_string(), entry);
@@ -319,13 +376,19 @@ impl Catalog {
     }
 
     /// 用日志中的目标版本替换列定义
-    pub fn set_columns_version(&mut self, table: &str, columns: Vec<SchemaColumn>, version: Option<u64>) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
+    pub fn set_columns_version(
+        &mut self,
+        table: &str,
+        columns: Vec<SchemaColumn>,
+        version: Option<u64>,
+    ) -> io::Result<()> {
+        let entry = self.tables.get_mut(table).ok_or_else(|| {
+            io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
+        })?;
         if let Some(version) = version {
-            if version == 0 { return Err(io::Error::other("invalid WAL schema version")); }
+            if version == 0 {
+                return Err(io::Error::other("invalid WAL schema version"));
+            }
             entry.schema_version = version;
         } else if entry.columns != columns {
             entry.schema_version = next_schema_version(entry)?;
@@ -342,7 +405,11 @@ impl Catalog {
     pub fn normalize_types(&mut self) -> io::Result<bool> {
         let mut changed = false;
         for entry in self.tables.values_mut() {
-            if entry.columns.iter().any(|column| normalize_type(&column.ty) != column.ty) {
+            if entry
+                .columns
+                .iter()
+                .any(|column| normalize_type(&column.ty) != column.ty)
+            {
                 entry.schema_version = next_schema_version(entry)?;
             }
             for column in entry.columns.iter_mut() {
@@ -362,13 +429,19 @@ impl Catalog {
     }
 
     /// 用日志目标版本删除列定义
-    pub fn remove_column_version(&mut self, table: &str, column: &str, version: Option<u64>) -> io::Result<bool> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
+    pub fn remove_column_version(
+        &mut self,
+        table: &str,
+        column: &str,
+        version: Option<u64>,
+    ) -> io::Result<bool> {
+        let entry = self.tables.get_mut(table).ok_or_else(|| {
+            io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
+        })?;
         if let Some(version) = version {
-            if version == 0 { return Err(io::Error::other("invalid WAL schema version")); }
+            if version == 0 {
+                return Err(io::Error::other("invalid WAL schema version"));
+            }
             entry.schema_version = version;
         } else if entry.columns.iter().any(|c| c.name == column) {
             entry.schema_version = next_schema_version(entry)?;
@@ -388,10 +461,9 @@ impl Catalog {
 
     /// 记住这一版已整理过（隐藏列名要留住）
     pub fn mark_compacted(&mut self, table: &str) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
+        let entry = self.tables.get_mut(table).ok_or_else(|| {
+            io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
+        })?;
         entry.compacted = true;
         self.seen.remove(table);
         Ok(())
@@ -399,7 +471,9 @@ impl Catalog {
 
     /// 这张表还有隐藏列字节吗
     pub fn has_dropped_columns(&self, table: &str) -> bool {
-        self.tables.get(table).is_some_and(|e| !e.dropped_columns.is_empty())
+        self.tables
+            .get(table)
+            .is_some_and(|e| !e.dropped_columns.is_empty())
     }
 
     /// 还有隐藏列字节待整理的表
@@ -413,10 +487,9 @@ impl Catalog {
 
     /// 记下一条索引定义
     pub fn add_index(&mut self, table: &str, column: &str) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
+        let entry = self.tables.get_mut(table).ok_or_else(|| {
+            io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
+        })?;
         if entry.indexes.iter().any(|i| i.column == column) {
             return Err(io::Error::new(
                 io::ErrorKind::AlreadyExists,
@@ -431,10 +504,9 @@ impl Catalog {
 
     /// 去掉一条索引定义
     pub fn remove_index(&mut self, table: &str, column: &str) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
+        let entry = self.tables.get_mut(table).ok_or_else(|| {
+            io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
+        })?;
         match entry.indexes.iter().position(|i| i.column == column) {
             None => Err(io::Error::new(
                 io::ErrorKind::NotFound,
@@ -450,11 +522,20 @@ impl Catalog {
 
 /// 把行里"字典还不知道的列"补进来；返回有没有变化
 fn add_missing_columns(entry: &mut TableSchema, row: &Row) -> io::Result<bool> {
-    let additions: Vec<_> = row.iter().filter(|(name, _)|
-        !entry.dropped_columns.contains(*name) && !entry.columns.iter().any(|c| &c.name == *name))
-        .filter_map(|(name, value)| infer_type(value).map(|ty| SchemaColumn {
-            name: name.clone(), ty, ..Default::default()
-        })).collect();
+    let additions: Vec<_> = row
+        .iter()
+        .filter(|(name, _)| {
+            !entry.dropped_columns.contains(*name)
+                && !entry.columns.iter().any(|c| &c.name == *name)
+        })
+        .filter_map(|(name, value)| {
+            infer_type(value).map(|ty| SchemaColumn {
+                name: name.clone(),
+                ty,
+                ..Default::default()
+            })
+        })
+        .collect();
     if additions.is_empty() {
         return Ok(false);
     }
@@ -465,7 +546,9 @@ fn add_missing_columns(entry: &mut TableSchema, row: &Row) -> io::Result<bool> {
 
 /// 递增结构版本，耗尽时拒绝变更
 fn next_schema_version(entry: &TableSchema) -> io::Result<u64> {
-    entry.schema_version.checked_add(1)
+    entry
+        .schema_version
+        .checked_add(1)
         .ok_or_else(|| io::Error::other("catalog schema version exhausted"))
 }
 
@@ -576,12 +659,22 @@ fn hist_add(stat: &mut ColumnStat, v: &serde_json::Value) {
 /// 从直方图里减掉一个值；值在区间外就不动
 fn hist_remove(stat: &mut ColumnStat, v: &serde_json::Value) {
     let Some(x) = v.as_f64() else { return };
-    let (Some(lo), Some(hi)) = (stat.lo, stat.hi) else { return };
+    let (Some(lo), Some(hi)) = (stat.lo, stat.hi) else {
+        return;
+    };
     if x < lo || x > hi || stat.hist.len() != HIST_BUCKETS {
         return;
     }
     let index = hist_index(lo, hi, x);
-    if let Some(bucket) = (0..stat.hist.len()).filter(|&i| stat.hist[i] > 0).min_by_key(|&i| i.abs_diff(index)) {
+    if let Some(bucket) = (0..stat.hist.len())
+        .filter(|&i| stat.hist[i] > 0)
+        .min_by_key(|&i| i.abs_diff(index))
+    {
         stat.hist[bucket] -= 1;
     }
 }
+
+/// 文件代次仅允许空值或固定长度十六进制
+pub(crate) fn valid_generation(value: &str) -> bool {
+    value.is_empty() || (value.len() == 32 && value.bytes().all(|byte| byte.is_ascii_hexdigit()))
+}

chusql-core/storage/src/config.rs

@@ -33,7 +33,9 @@ pub fn default_config_path() -> PathBuf {
     {
         let appdata = std::env::var_os("APPDATA").filter(|v| !v.is_empty());
         if let Some(appdata) = appdata {
-            return PathBuf::from(appdata).join(APP_DIR_NAME).join(CONFIG_FILE_NAME);
+            return PathBuf::from(appdata)
+                .join(APP_DIR_NAME)
+                .join(CONFIG_FILE_NAME);
         }
     }
     #[cfg(not(windows))]
@@ -62,7 +64,9 @@ pub fn default_data_dir() -> PathBuf {
     }
     let roaming = std::env::var_os("APPDATA").filter(|v| !v.is_empty());
     if let Some(roaming) = roaming {
-        return PathBuf::from(roaming).join(APP_DIR_NAME).join(DATA_DIR_NAME);
+        return PathBuf::from(roaming)
+            .join(APP_DIR_NAME)
+            .join(DATA_DIR_NAME);
     }
     PathBuf::from(APP_DIR_NAME).join(DATA_DIR_NAME)
 }
@@ -210,9 +214,7 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
         })?,
     };
 
-    let file_origin = Origin::File(
-        path.clone().unwrap_or_else(default_config_path),
-    );
+    let file_origin = Origin::File(path.clone().unwrap_or_else(default_config_path));
 
     let (page_size, page_origin) = pick(
         file.page.and_then(|p| p.size),
@@ -250,8 +252,12 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
     let log_files = log_files.trim().to_string();
     let log_level = log_level.trim();
 
-    let log_level = Level::parse(log_level)
-        .ok_or_else(|| format!("log.level is not one of off/error/warn/info/debug: {}", log_level))?;
+    let log_level = Level::parse(log_level).ok_or_else(|| {
+        format!(
+            "log.level is not one of off/error/warn/info/debug: {}",
+            log_level
+        )
+    })?;
 
     if data_dir.is_empty() {
         return Err("storage.data_dir must not be empty".to_string());

chusql-core/storage/src/ffi.rs

@@ -1,6 +1,6 @@
 use std::cell::RefCell;
-use std::ffi::{c_char, CStr};
-use std::panic::{catch_unwind, AssertUnwindSafe};
+use std::ffi::{CStr, c_char};
+use std::panic::{AssertUnwindSafe, catch_unwind};
 use std::ptr;
 use std::slice;
 
@@ -42,7 +42,11 @@ pub unsafe extern "C" fn chusql_storage_open(config_path: *const c_char) -> *mut
             let text = unsafe { CStr::from_ptr(config_path) }
                 .to_str()
                 .map_err(|_| "config path is not valid UTF-8".to_string())?;
-            if text.is_empty() { None } else { Some(text.to_string()) }
+            if text.is_empty() {
+                None
+            } else {
+                Some(text.to_string())
+            }
         };
         Storage::open(path.as_deref()).map(Box::new)
     }));
@@ -78,27 +82,57 @@ pub unsafe extern "C" fn chusql_storage_close(handle: *mut Storage) {
 /// 输出指针可写且不与输入重叠；响应使用 free 释放。
 #[unsafe(no_mangle)]
 pub unsafe extern "C" fn chusql_storage_maintenance(
-    config_path: *const c_char, request: *const u8, request_len: usize,
-    out: *mut *mut u8, out_len: *mut usize,
+    config_path: *const c_char,
+    request: *const u8,
+    request_len: usize,
+    out: *mut *mut u8,
+    out_len: *mut usize,
 ) -> i32 {
-    if !out.is_null() { unsafe { *out = ptr::null_mut(); } }
-    if !out_len.is_null() { unsafe { *out_len = 0; } }
-    if request.is_null() || out.is_null() || out_len.is_null() || request_len > isize::MAX as usize {
+    if !out.is_null() {
+        unsafe {
+            *out = ptr::null_mut();
+        }
+    }
+    if !out_len.is_null() {
+        unsafe {
+            *out_len = 0;
+        }
+    }
+    if request.is_null() || out.is_null() || out_len.is_null() || request_len > isize::MAX as usize
+    {
         set_error("invalid maintenance argument");
         return ERR;
     }
     let result = catch_unwind(AssertUnwindSafe(|| {
-        let path = if config_path.is_null() { None } else { Some(unsafe { CStr::from_ptr(config_path) }.to_str().map_err(|e| e.to_string())?) };
-        let text = std::str::from_utf8(unsafe { slice::from_raw_parts(request, request_len) }).map_err(|e| e.to_string())?;
+        let path = if config_path.is_null() {
+            None
+        } else {
+            Some(
+                unsafe { CStr::from_ptr(config_path) }
+                    .to_str()
+                    .map_err(|e| e.to_string())?,
+            )
+        };
+        let text = std::str::from_utf8(unsafe { slice::from_raw_parts(request, request_len) })
+            .map_err(|e| e.to_string())?;
         Storage::maintenance(path, text)
     }));
     let response = match result {
         Ok(Ok(response)) => response,
-        Ok(Err(err)) => { set_error(err); return ERR; }
-        Err(_) => { set_error("panic in system maintenance"); return ERR; }
+        Ok(Err(err)) => {
+            set_error(err);
+            return ERR;
+        }
+        Err(_) => {
+            set_error("panic in system maintenance");
+            return ERR;
+        }
     };
     let buffer = response.into_bytes().into_boxed_slice();
-    unsafe { *out_len = buffer.len(); *out = Box::into_raw(buffer) as *mut u8; }
+    unsafe {
+        *out_len = buffer.len();
+        *out = Box::into_raw(buffer) as *mut u8;
+    }
     OK
 }
 
@@ -121,7 +155,12 @@ pub unsafe extern "C" fn chusql_storage_request(
     if !out_len.is_null() {
         unsafe { *out_len = 0 };
     }
-    if handle.is_null() || request.is_null() || out.is_null() || out_len.is_null() || request_len > isize::MAX as usize {
+    if handle.is_null()
+        || request.is_null()
+        || out.is_null()
+        || out_len.is_null()
+        || request_len > isize::MAX as usize
+    {
         set_error("invalid argument");
         return ERR;
     }
@@ -178,6 +217,10 @@ pub unsafe extern "C" fn chusql_storage_last_error(out_len: *mut usize) -> *cons
         if !out_len.is_null() {
             unsafe { *out_len = bytes.len() };
         }
-        if bytes.is_empty() { ptr::null() } else { bytes.as_ptr() }
+        if bytes.is_empty() {
+            ptr::null()
+        } else {
+            bytes.as_ptr()
+        }
     })
 }

chusql-core/storage/src/heap.rs

@@ -1,8 +1,8 @@
+use serde::Deserializer;
+use serde::de::{IgnoredAny, MapAccess, Visitor};
 use std::collections::HashSet;
 use std::io;
 use std::path::Path;
-use serde::de::{IgnoredAny, MapAccess, Visitor};
-use serde::Deserializer;
 
 use crate::btree::DiskBTree;
 use crate::page::PageId;
@@ -11,12 +11,18 @@ use crate::protocol::Row;
 
 // 堆表：行按插入顺序进页，支持全表扫描、按索引取行、行级删除。
 
+pub(crate) const DUPLICATE_ID: &str = "duplicate value on the id index";
+
 const HEADER_SIZE: usize = 2;
 const SLOT_SIZE: usize = 8;
 const SLOT_DIR_START: usize = HEADER_SIZE;
 
 /// 未选字段只校验并跳过，不分配值。
-fn decode_row(bytes: &[u8], columns: Option<&[String]>, hidden: &HashSet<String>) -> io::Result<Row> {
+fn decode_row(
+    bytes: &[u8],
+    columns: Option<&[String]>,
+    hidden: &HashSet<String>,
+) -> io::Result<Row> {
     struct RowVisitor<'a>(Option<&'a [String]>, &'a HashSet<String>);
     impl<'de> Visitor<'de> for RowVisitor<'_> {
         type Value = Row;
@@ -38,7 +44,9 @@ fn decode_row(bytes: &[u8], columns: Option<&[String]>, hidden: &HashSet<String>
         }
     }
     let mut decoder = serde_json::Deserializer::from_slice(bytes);
-    let row = decoder.deserialize_map(RowVisitor(columns, hidden)).map_err(io::Error::other)?;
+    let row = decoder
+        .deserialize_map(RowVisitor(columns, hidden))
+        .map_err(io::Error::other)?;
     decoder.end().map_err(io::Error::other)?;
     Ok(row)
 }
@@ -93,7 +101,7 @@ fn row_int(row: &Row, column: &str) -> Option<i64> {
 }
 
 /// i64 键 → 8 字节大端（保序，负数也在前）
-fn key_of(value: i64) -> [u8; 8] {
+pub(crate) fn key_of(value: i64) -> [u8; 8] {
     (value as u64 ^ (1u64 << 63)).to_be_bytes()
 }
 
@@ -108,10 +116,23 @@ fn value_key(v: &serde_json::Value) -> Option<Vec<u8>> {
 }
 
 /// 取行里某一列的索引键；NULL 与缺列不入索引
-fn row_key(row: &Row, column: &str) -> Option<Vec<u8>> {
+pub(crate) fn row_key(row: &Row, column: &str) -> Option<Vec<u8>> {
     row.get(column).and_then(value_key)
 }
 
+/// 按实际键编码校验一列的索引容量
+pub(crate) fn check_index_key(
+    row: &Row,
+    column: &str,
+    page_size: usize,
+    order: usize,
+) -> io::Result<()> {
+    if let Some(key) = row_key(row, column) {
+        DiskBTree::check_key(&key, page_size, order)?;
+    }
+    Ok(())
+}
+
 pub struct HeapPage;
 
 impl HeapPage {
@@ -312,7 +333,7 @@ impl HeapTable {
                 Ok(()) => {}
                 Err(err) if err.kind() == io::ErrorKind::InvalidData => {
                     // 格式不兼容（例如上一版落的索引文件）：删掉重开
-                    let _ = std::fs::remove_file(p);
+                    crate::page_wal::remove(p)?;
                     t.attach_index(col, p, page_size, btree_order, pool_size)?;
                 }
                 Err(err) => return Err(err),
@@ -373,6 +394,7 @@ impl HeapTable {
             let Some(k) = row_key(&r, column) else {
                 continue;
             };
+            DiskBTree::check_key(&k, page_size, btree_order)?;
             // 行身份索引仍然唯一；其余列允许重复值
             if column == "id" && !seen.insert(k.clone()) {
                 return Err(io::Error::new(
@@ -450,10 +472,11 @@ impl HeapTable {
             let Some(k) = row_key(row, &idx.column) else {
                 continue;
             };
+            idx.tree.validate_key(&k)?;
             if idx.column == "id" && idx.tree.get(&k)?.is_some() {
                 return Err(io::Error::new(
                     io::ErrorKind::InvalidInput,
-                    "duplicate value on the id index".to_string(),
+                    DUPLICATE_ID.to_string(),
                 ));
             }
             pending.push((i, k));
@@ -511,6 +534,16 @@ impl HeapTable {
         Ok((page_id, slot))
     }
 
+    /// 读取身份索引中同键行数供提交预检
+    pub(crate) fn id_key_count(&mut self, key: &[u8]) -> io::Result<usize> {
+        let index = self
+            .indexes
+            .iter_mut()
+            .find(|index| index.column == "id")
+            .ok_or_else(|| io::Error::other("missing id index"))?;
+        Ok(index.tree.get_all(key)?.len())
+    }
+
     /// 按 `id` 取一行
     pub fn get_by_key(&mut self, key: i64) -> io::Result<Option<Row>> {
         self.get_by_column_key("id", key)
@@ -577,13 +610,21 @@ impl HeapTable {
         let mut rows = Vec::new();
         for (key, pos) in pairs {
             if let Some((bound, inclusive)) = &lo_bound {
-                let outside = if *inclusive { &key < bound } else { &key <= bound };
+                let outside = if *inclusive {
+                    &key < bound
+                } else {
+                    &key <= bound
+                };
                 if outside {
                     continue;
                 }
             }
             if let Some((bound, inclusive)) = &hi_bound {
-                let outside = if *inclusive { &key > bound } else { &key >= bound };
+                let outside = if *inclusive {
+                    &key > bound
+                } else {
+                    &key >= bound
+                };
                 if outside {
                     continue;
                 }
@@ -699,7 +740,10 @@ impl HeapTable {
     }
 
     /// 全表扫描，带位置与列投影
-    fn scan_projected_with_positions(&mut self, columns: Option<&[String]>) -> io::Result<Vec<(PageId, u16, Row)>> {
+    fn scan_projected_with_positions(
+        &mut self,
+        columns: Option<&[String]>,
+    ) -> io::Result<Vec<(PageId, u16, Row)>> {
         let n = self.file.num_pages()?;
         self.scan_pages_with_positions(columns, 0, n)
     }
@@ -729,6 +773,14 @@ impl HeapTable {
 
     /// 整表改写并重建所有索引
     pub fn replace_all(&mut self, rows: &[Row]) -> io::Result<()> {
+        for row in rows {
+            Self::encode_row(row, self.file.page_size())?;
+            for index in &self.indexes {
+                if let Some(key) = row_key(row, &index.column) {
+                    index.tree.validate_key(&key)?;
+                }
+            }
+        }
         self.file.truncate()?;
         for idx in &mut self.indexes {
             idx.tree.clear()?;
@@ -745,6 +797,14 @@ impl HeapTable {
         Ok(())
     }
 
+    /// 同时标记堆页与索引页的提交点
+    pub(crate) fn set_lsn(&mut self, lsn: u64) {
+        self.file.set_lsn(lsn);
+        for index in &mut self.indexes {
+            index.tree.set_lsn(lsn);
+        }
+    }
+
     /// 把脏页写回（索引也一起）
     pub fn flush(&mut self) -> io::Result<()> {
         for idx in &mut self.indexes {
@@ -767,11 +827,19 @@ impl HeapTable {
     }
 
     /// 当前缓存页数
-    pub fn cached_pages(&self) -> usize { self.file.cached_pages() }
+    pub fn cached_pages(&self) -> usize {
+        self.file.cached_pages()
+    }
     /// 命中次数
-    pub fn hits(&self) -> u64 { self.file.hits() }
+    pub fn hits(&self) -> u64 {
+        self.file.hits()
+    }
     /// 未命中次数
-    pub fn misses(&self) -> u64 { self.file.misses() }
+    pub fn misses(&self) -> u64 {
+        self.file.misses()
+    }
     /// 命中率
-    pub fn hit_rate(&self) -> f64 { self.file.hit_rate() }
+    pub fn hit_rate(&self) -> f64 {
+        self.file.hit_rate()
+    }
 }

chusql-core/storage/src/lib.rs

@@ -6,7 +6,9 @@ pub mod config;
 pub mod ffi;
 pub mod heap;
 pub mod log;
+mod mvcc;
 pub mod page;
+mod page_wal;
 pub mod protocol;
 pub mod runtime;
 pub mod wal;

chusql-core/storage/src/log.rs

@@ -1,7 +1,7 @@
 use std::fmt;
 use std::io::{IsTerminal, Write};
-use std::sync::atomic::{AtomicU8, Ordering};
 use std::sync::OnceLock;
+use std::sync::atomic::{AtomicU8, Ordering};
 
 // 极简日志：等级用原子变量，关掉的等级只花一次原子读。
 
@@ -123,8 +123,18 @@ fn streams_to_stderr(level: Level) -> bool {
 
 /// 按目标流是否终端决定是否着色
 fn color_enabled(to_stderr: bool) -> bool {
-    let cached = if to_stderr { &COLOR_STDERR } else { &COLOR_STDOUT };
-    *cached.get_or_init(|| if to_stderr { std::io::stderr().is_terminal() } else { std::io::stdout().is_terminal() })
+    let cached = if to_stderr {
+        &COLOR_STDERR
+    } else {
+        &COLOR_STDOUT
+    };
+    *cached.get_or_init(|| {
+        if to_stderr {
+            std::io::stderr().is_terminal()
+        } else {
+            std::io::stdout().is_terminal()
+        }
+    })
 }
 
 /// 拼一行（纯函数，可测）

chusql-core/storage/src/page.rs

@@ -3,6 +3,8 @@ use std::fs::{File, OpenOptions};
 use std::io::{self, Read, Seek, SeekFrom, Write};
 use std::path::Path;
 
+use crate::page_wal::PageWal;
+
 // 页管理：定长页的读写，外加一层页缓冲池。
 
 pub type PageId = u64;
@@ -33,6 +35,7 @@ impl Page {
 #[derive(Debug)]
 pub struct PageFile {
     file: File,
+    journal: PageWal,
     page_size: usize,
     capacity: usize,
     cache: HashMap<PageId, Page>,
@@ -55,14 +58,16 @@ impl PageFile {
         page_size: usize,
         capacity: usize,
     ) -> io::Result<Self> {
-        let file = OpenOptions::new()
+        let mut file = OpenOptions::new()
             .read(true)
             .write(true)
             .create(true)
             .truncate(false)
-            .open(path)?;
+            .open(path.as_ref())?;
+        let journal = PageWal::open(path.as_ref(), page_size, &mut file)?;
         Ok(PageFile {
             file,
+            journal,
             page_size,
             capacity,
             cache: HashMap::new(),
@@ -74,6 +79,16 @@ impl PageFile {
         })
     }
 
+    /// 标记后续页修改所属的提交点
+    pub fn set_lsn(&mut self, lsn: u64) {
+        self.journal.set_lsn(lsn);
+    }
+
+    /// 读取已记录的页提交 LSN
+    pub fn page_lsn(&self, id: PageId) -> Option<u64> {
+        self.journal.page_lsn(id)
+    }
+
     /// 页大小
     pub fn page_size(&self) -> usize {
         self.page_size
@@ -109,7 +124,6 @@ impl PageFile {
         }
     }
 
-
     /// 标记为最近使用
     fn touch(&mut self, id: PageId) {
         self.clock += 1;
@@ -127,27 +141,28 @@ impl PageFile {
             return Ok(false);
         };
         if self.dirty.contains(&victim) {
-            let p = self.cache[&victim].clone();
-            self.write_raw(&p)?;
-            self.dirty.remove(&victim);
+            let pages: Vec<_> = self
+                .dirty
+                .iter()
+                .filter_map(|id| self.cache.get(id).cloned())
+                .collect();
+            let images: Vec<_> = pages
+                .iter()
+                .map(|page| (page.id, page.data.as_slice()))
+                .collect();
+            self.journal.prepare(&images)?;
+            for page in &pages {
+                self.write_image(page)?;
+            }
+            self.dirty.clear();
         }
         self.cache.remove(&victim);
         self.last_used.remove(&victim);
         Ok(true)
     }
 
-    /// 直接写文件
-    fn write_raw(&mut self, page: &Page) -> io::Result<()> {
-        if page.data.len() != self.page_size {
-            return Err(io::Error::new(
-                io::ErrorKind::InvalidInput,
-                format!(
-                    "page has {} bytes, this file uses {}",
-                    page.data.len(),
-                    self.page_size
-                ),
-            ));
-        }
+    /// 将已记录镜像的页写入数据文件
+    fn write_image(&mut self, page: &Page) -> io::Result<()> {
         self.file
             .seek(SeekFrom::Start(page.id * self.page_size as u64))?;
         self.file.write_all(&page.data)
@@ -156,12 +171,12 @@ impl PageFile {
     /// 直接从文件读
     fn read_raw(&mut self, id: PageId) -> io::Result<Page> {
         let mut data = vec![0u8; self.page_size];
-        self.file.seek(SeekFrom::Start(id * self.page_size as u64))?;
+        self.file
+            .seek(SeekFrom::Start(id * self.page_size as u64))?;
         self.file.read_exact(&mut data)?;
         Ok(Page { id, data })
     }
 
-
     /// 读一页（走缓存）
     pub fn read_page(&mut self, id: PageId) -> io::Result<Page> {
         self.note_access(id)?;
@@ -241,26 +256,27 @@ impl PageFile {
             ));
         }
         let on_disk = len / size;
-        let cached_max = self
-            .cache
-            .keys()
-            .copied()
-            .max()
-            .map(|m| m + 1)
-            .unwrap_or(0);
+        let cached_max = self.cache.keys().copied().max().map(|m| m + 1).unwrap_or(0);
         Ok(on_disk.max(cached_max))
     }
 
     /// 把脏页写回磁盘
     pub fn flush(&mut self) -> io::Result<()> {
-        let dirty: Vec<PageId> = self.dirty.iter().copied().collect();
-        for id in dirty {
-            if let Some(p) = self.cache.get(&id) {
-                let p = p.clone();
-                self.write_raw(&p)?;
-            }
+        let pages: Vec<Page> = self
+            .dirty
+            .iter()
+            .filter_map(|id| self.cache.get(id).cloned())
+            .collect();
+        let images: Vec<_> = pages
+            .iter()
+            .map(|page| (page.id, page.data.as_slice()))
+            .collect();
+        self.journal.prepare(&images)?;
+        for page in &pages {
+            self.write_image(page)?;
         }
         self.file.sync_all()?;
+        self.journal.checkpoint()?;
         self.dirty.clear();
         Ok(())
     }
@@ -272,6 +288,7 @@ impl PageFile {
 
     /// 清空文件
     pub fn truncate(&mut self) -> io::Result<()> {
+        self.journal.reset()?;
         self.cache.clear();
         self.last_used.clear();
         self.dirty.clear();

chusql-core/storage/src/page_wal.rs

@@ -0,0 +1,294 @@
+use std::collections::BTreeMap;
+use std::fs::{File, OpenOptions};
+use std::io::{self, Read, Seek, SeekFrom, Write};
+use std::path::{Path, PathBuf};
+
+use serde::{Deserialize, Serialize};
+
+// 全页预写镜像修复撕裂写，页 LSN 在数据同步后原子发布。
+
+const HEADER: usize = 40;
+const RESET: u64 = u64::MAX;
+
+#[derive(Debug, Serialize, Deserialize)]
+struct State {
+    version: u32,
+    page_size: usize,
+    sequence: u64,
+    pages: BTreeMap<u64, u64>,
+}
+
+#[derive(Debug)]
+pub(crate) struct PageWal {
+    path: PathBuf,
+    state: State,
+    lsn: u64,
+    pending: bool,
+    failed: bool,
+    file: Option<File>,
+}
+
+/// 为页文件生成独立的元数据路径
+fn sidecar(path: &Path, suffix: &str) -> PathBuf {
+    let mut name = path.as_os_str().to_os_string();
+    name.push(suffix);
+    PathBuf::from(name)
+}
+
+/// 计算帧校验和以拒绝损坏的完整镜像
+fn checksum(bytes: &[u8]) -> u64 {
+    bytes.iter().fold(0xcbf29ce484222325, |hash, byte| {
+        (hash ^ u64::from(*byte)).wrapping_mul(0x100000001b3)
+    })
+}
+
+/// 同步目录中的创建、替换与删除
+fn sync_parent(path: &Path) -> io::Result<()> {
+    #[cfg(unix)]
+    File::open(
+        path.parent()
+            .filter(|p| !p.as_os_str().is_empty())
+            .unwrap_or(Path::new(".")),
+    )?
+    .sync_all()?;
+    Ok(())
+}
+
+impl PageWal {
+    /// 加载页版本并先恢复未完成的全页写入
+    pub(crate) fn open(path: &Path, page_size: usize, data: &mut File) -> io::Result<Self> {
+        let metadata = sidecar(path, ".pages");
+        let state = match std::fs::read(&metadata) {
+            Ok(bytes) => serde_json::from_slice::<State>(&bytes).map_err(io::Error::other)?,
+            Err(error) if error.kind() == io::ErrorKind::NotFound => State {
+                version: 1,
+                page_size,
+                sequence: 0,
+                pages: BTreeMap::new(),
+            },
+            Err(error) => return Err(error),
+        };
+        if state.version != 1 || state.page_size != page_size {
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidData,
+                "unsupported page LSN metadata",
+            ));
+        }
+        let mut journal = Self {
+            path: path.to_path_buf(),
+            state,
+            lsn: 0,
+            pending: false,
+            failed: false,
+            file: None,
+        };
+        journal.recover(data)?;
+        Ok(journal)
+    }
+
+    /// 设置后续脏页所属的逻辑 WAL 提交点
+    pub(crate) fn set_lsn(&mut self, lsn: u64) {
+        self.lsn = lsn;
+    }
+
+    /// 读取已写镜像记录的页 LSN
+    pub(crate) fn page_lsn(&self, page: u64) -> Option<u64> {
+        self.state.pages.get(&page).copied()
+    }
+
+    /// 延迟创建日志并同步目录项
+    fn handle(&mut self) -> io::Result<&mut File> {
+        if self.file.is_none() {
+            let path = sidecar(&self.path, ".page-wal");
+            let file = OpenOptions::new()
+                .read(true)
+                .write(true)
+                .create(true)
+                .truncate(false)
+                .open(&path)?;
+            sync_parent(&path)?;
+            self.file = Some(file);
+        }
+        Ok(self.file.as_mut().expect("opened above"))
+    }
+
+    /// 持久化一批镜像后才允许修改数据页
+    pub(crate) fn prepare(&mut self, pages: &[(u64, &[u8])]) -> io::Result<()> {
+        if self.failed {
+            return Err(io::Error::other("page journal requires recovery"));
+        }
+        if pages.iter().any(|(page, bytes)| {
+            (*page == RESET && !bytes.is_empty())
+                || (*page != RESET
+                    && (bytes.len() != self.state.page_size
+                        || page.checked_mul(self.state.page_size as u64).is_none()))
+        }) {
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidInput,
+                "invalid page image size or offset",
+            ));
+        }
+        if pages.is_empty() {
+            return Ok(());
+        }
+        self.failed = true;
+        for (page, bytes) in pages {
+            let sequence = self
+                .state
+                .sequence
+                .checked_add(1)
+                .ok_or_else(|| io::Error::other("page write sequence exhausted"))?;
+            let lsn = self
+                .lsn
+                .max(self.state.pages.get(page).copied().unwrap_or(0));
+            let mut frame = Vec::with_capacity(HEADER + bytes.len());
+            frame.extend_from_slice(b"CPW1");
+            frame.extend_from_slice(&sequence.to_le_bytes());
+            frame.extend_from_slice(&lsn.to_le_bytes());
+            frame.extend_from_slice(&page.to_le_bytes());
+            frame.extend_from_slice(&(bytes.len() as u32).to_le_bytes());
+            let mut checked = frame.clone();
+            checked.extend_from_slice(bytes);
+            frame.extend_from_slice(&checksum(&checked).to_le_bytes());
+            frame.extend_from_slice(bytes);
+            let file = self.handle()?;
+            file.seek(SeekFrom::End(0))?;
+            file.write_all(&frame)?;
+            self.state.sequence = sequence;
+            if *page == RESET {
+                self.state.pages.clear();
+            } else {
+                self.state.pages.insert(*page, lsn);
+            }
+            self.pending = true;
+        }
+        self.handle()?.sync_all()?;
+        self.failed = false;
+        Ok(())
+    }
+
+    /// 先记录截断以免重放旧页复活已删除数据
+    pub(crate) fn reset(&mut self) -> io::Result<()> {
+        self.prepare(&[(RESET, &[])])
+    }
+
+    /// 数据同步后发布页版本并清理镜像日志
+    pub(crate) fn checkpoint(&mut self) -> io::Result<()> {
+        if self.failed {
+            return Err(io::Error::other("page journal requires recovery"));
+        }
+        if !self.pending {
+            return Ok(());
+        }
+        self.failed = true;
+        let temporary = sidecar(&self.path, ".pages.pending");
+        let metadata = sidecar(&self.path, ".pages");
+        let mut file = File::create(&temporary)?;
+        serde_json::to_writer(&mut file, &self.state).map_err(io::Error::other)?;
+        file.sync_all()?;
+        drop(file);
+        std::fs::rename(&temporary, &metadata)?;
+        sync_parent(&metadata)?;
+        self.handle()?.set_len(0)?;
+        self.handle()?.sync_all()?;
+        self.pending = false;
+        self.failed = false;
+        Ok(())
+    }
+
+    /// 验证日志帧后重放比页检查点更新的镜像
+    fn recover(&mut self, data: &mut File) -> io::Result<()> {
+        let path = sidecar(&self.path, ".page-wal");
+        let mut file = match File::open(path) {
+            Ok(file) => file,
+            Err(error) if error.kind() == io::ErrorKind::NotFound => return Ok(()),
+            Err(error) => return Err(error),
+        };
+        if file.metadata()?.len() == 0 {
+            return Ok(());
+        }
+        let checkpoint = self.state.sequence;
+        let mut previous = 0;
+        loop {
+            let mut header = [0; HEADER];
+            match file.read_exact(&mut header) {
+                Ok(()) => (),
+                Err(error) if error.kind() == io::ErrorKind::UnexpectedEof => break,
+                Err(error) => return Err(error),
+            }
+            let sequence = u64::from_le_bytes(header[4..12].try_into().expect("fixed header"));
+            let lsn = u64::from_le_bytes(header[12..20].try_into().expect("fixed header"));
+            let page = u64::from_le_bytes(header[20..28].try_into().expect("fixed header"));
+            let len = u32::from_le_bytes(header[28..32].try_into().expect("fixed header")) as usize;
+            if &header[..4] != b"CPW1"
+                || sequence <= previous
+                || (page == RESET && len != 0)
+                || (page != RESET && len != self.state.page_size)
+            {
+                return Err(io::Error::new(
+                    io::ErrorKind::InvalidData,
+                    "invalid page image header",
+                ));
+            }
+            let mut bytes = vec![0; len];
+            match file.read_exact(&mut bytes) {
+                Ok(()) => (),
+                Err(error) if error.kind() == io::ErrorKind::UnexpectedEof => break,
+                Err(error) => return Err(error),
+            }
+            let mut checked = header[..32].to_vec();
+            checked.extend_from_slice(&bytes);
+            if checksum(&checked)
+                != u64::from_le_bytes(header[32..40].try_into().expect("fixed header"))
+            {
+                return Err(io::Error::new(
+                    io::ErrorKind::InvalidData,
+                    "page image checksum mismatch",
+                ));
+            }
+            previous = sequence;
+            if sequence <= checkpoint {
+                continue;
+            }
+            if page == RESET {
+                data.set_len(0)?;
+                self.state.pages.clear();
+            } else {
+                let offset = page
+                    .checked_mul(self.state.page_size as u64)
+                    .ok_or_else(|| io::Error::other("page offset overflow"))?;
+                data.seek(SeekFrom::Start(offset))?;
+                data.write_all(&bytes)?;
+                self.state.pages.insert(page, lsn);
+            }
+            self.state.sequence = sequence;
+        }
+        data.sync_all()?;
+        self.pending = true;
+        self.checkpoint()
+    }
+}
+
+/// 删除页文件及其版本与镜像文件
+pub(crate) fn remove(path: &Path) -> io::Result<()> {
+    for suffix in [".page-wal", ".pages", ".pages.pending", ""] {
+        match std::fs::remove_file(sidecar(path, suffix)) {
+            Ok(()) => (),
+            Err(error) if error.kind() == io::ErrorKind::NotFound => (),
+            Err(error) => return Err(error),
+        }
+    }
+    sync_parent(path)
+}
+
+/// 改名时保留对应页版本与恢复材料
+pub(crate) fn rename(from: &Path, to: &Path) -> io::Result<()> {
+    for suffix in [".page-wal", ".pages", ".pages.pending", ""] {
+        match std::fs::rename(sidecar(from, suffix), sidecar(to, suffix)) {
+            Ok(()) => (),
+            Err(error) if error.kind() == io::ErrorKind::NotFound => (),
+            Err(error) => return Err(error),
+        }
+    }
+    sync_parent(to)
+}

chusql-core/storage/src/protocol.rs

@@ -94,19 +94,40 @@ pub struct IndexWire {
 #[derive(Debug, Serialize, Deserialize)]
 #[serde(tag = "method", rename_all = "snake_case")]
 pub enum Request {
-    CatalogManage { command: Box<Request> },
+    CatalogManage {
+        command: Box<Request>,
+    },
     AccountsList,
-    IdentityInitialize { administrator: String },
-    RoleCreate { user: String },
-    IdentityAlter { user: String, can_login: Option<bool>, is_superuser: Option<bool>, enabled: Option<bool>, system_catalog_manager: Option<bool>, allow_sudo_auth: Option<bool> },
-    AccountCreate { user: String, password_hash: String },
-    AccountReset { user: String, password_hash: String },
+    IdentityInitialize {
+        administrator: String,
+    },
+    RoleCreate {
+        user: String,
+    },
+    IdentityAlter {
+        user: String,
+        can_login: Option<bool>,
+        is_superuser: Option<bool>,
+        enabled: Option<bool>,
+        system_catalog_manager: Option<bool>,
+        allow_sudo_auth: Option<bool>,
+    },
+    AccountCreate {
+        user: String,
+        password_hash: String,
+    },
+    AccountReset {
+        user: String,
+        password_hash: String,
+    },
     AccountLogin {
         user: String,
         #[serde(default)]
         at: Option<String>,
     },
-    AccountDrop { user: String },
+    AccountDrop {
+        user: String,
+    },
     /// 引导系统目录：建系统表，给了 user 就同时补首个管理员
     BootstrapSystem {
         #[serde(default)]
@@ -115,14 +136,18 @@ pub enum Request {
         password_hash: Option<String>,
     },
     SystemStatus,
-    BootstrapTypes { types: Vec<Row> },
+    BootstrapTypes {
+        types: Vec<Row>,
+    },
     Ping,
     Scan {
         table: String,
         #[serde(default)]
         columns: Option<Vec<String>>,
     },
-    ValidateWrite { table: String },
+    ValidateWrite {
+        table: String,
+    },
     /// 分片扫描：第 shard 片只读总页数按 shards 均分后的那一段
     ScanShard {
         table: String,
@@ -177,6 +202,37 @@ pub enum Request {
         table: String,
     },
     ListCatalog,
+    DomainSnapshot,
+    MvccBegin {
+        #[serde(default)]
+        serializable: bool,
+    },
+    MvccLock {
+        transaction: String,
+        ops: Vec<StorageOp>,
+        #[serde(default)]
+        reads: Vec<String>,
+    },
+    MvccPreview {
+        transaction: String,
+    },
+    MvccCommit {
+        transaction: String,
+        checkpoint: String,
+        ops: Vec<StorageOp>,
+    },
+    MvccRollback {
+        transaction: String,
+    },
+    DatabaseSnapshot {
+        #[serde(default)]
+        checkpoint: Option<String>,
+    },
+    AlterDomain {
+        table: String,
+        columns: Vec<SchemaColumn>,
+        checkpoint: String,
+    },
     CreateIndex {
         table: String,
         column: String,
@@ -204,7 +260,7 @@ pub enum Request {
 }
 
 /// 事务提交里的一条写操作
-#[derive(Debug, Serialize, Deserialize)]
+#[derive(Debug, Clone, Serialize, Deserialize)]
 #[serde(tag = "op", rename_all = "snake_case")]
 pub enum StorageOp {
     /// 追加写入的行（提交端已先删掉要覆盖的行）
@@ -215,37 +271,89 @@ pub enum StorageOp {
     Replace { table: String, rows: Vec<Row> },
 }
 
+/// 检查存储表名和列名的字符集
+pub(crate) fn valid_storage_name(name: &str) -> bool {
+    !name.is_empty() && name.chars().all(|c| c.is_ascii_alphanumeric() || c == '_')
+}
+
+/// 检查一行顶层字段名
+fn valid_row_columns(row: &Row) -> bool {
+    row.keys().all(|name| valid_storage_name(name))
+}
+
 impl Request {
-    /// 拒绝可能影响文件路径的列名
+    /// 校验列定义与写入载荷的顶层字段名
     pub fn valid_columns(&self) -> bool {
-        let valid = |name: &str| !name.is_empty()
-            && name.chars().all(|c| c.is_ascii_alphanumeric() || c == '_');
         match self {
-            Self::CreateIndex { column, .. } | Self::DropIndex { column, .. }
-            | Self::DropColumn { column, .. } | Self::LookupByIndex { column, .. }
-            | Self::RangeByIndex { column, .. } => valid(column),
-            Self::CreateTable { columns, .. } => columns.iter().all(|c| valid(&c.name)),
-            Self::ReplaceSchema { columns, .. } => columns.iter().all(|c| valid(&c.name)),
+            Self::CreateIndex { column, .. }
+            | Self::DropIndex { column, .. }
+            | Self::DropColumn { column, .. }
+            | Self::LookupByIndex { column, .. }
+            | Self::RangeByIndex { column, .. } => valid_storage_name(column),
+            Self::CreateTable { columns, .. } | Self::AlterDomain { columns, .. } => {
+                columns.iter().all(|c| valid_storage_name(&c.name))
+            }
+            Self::ReplaceSchema { columns, rows, .. } => {
+                columns.iter().all(|c| valid_storage_name(&c.name))
+                    && rows.iter().all(valid_row_columns)
+            }
+            Self::Insert { row, .. } => valid_row_columns(row),
+            Self::InsertBatch { rows, .. } | Self::ReplaceAll { rows, .. } => {
+                rows.iter().all(valid_row_columns)
+            }
+            Self::ApplyTransaction { ops }
+            | Self::MvccLock { ops, .. }
+            | Self::MvccCommit { ops, .. } => ops.iter().all(|op| match op {
+                StorageOp::Upsert { rows, .. } | StorageOp::Replace { rows, .. } => {
+                    rows.iter().all(valid_row_columns)
+                }
+                StorageOp::Delete { .. } => true,
+            }),
             _ => true,
         }
     }
     /// 普通表操作的统一访问边界
     pub fn table(&self) -> Option<&str> {
         match self {
-            Self::Scan { table, .. } | Self::ScanShard { table, .. } | Self::ValidateWrite { table }
+            Self::Scan { table, .. }
+            | Self::ScanShard { table, .. }
+            | Self::ValidateWrite { table }
             | Self::Insert { table, .. }
-            | Self::InsertBatch { table, .. } | Self::DeleteKeys { table, .. }
-            | Self::LookupByIndex { table, .. } | Self::ReplaceAll { table, .. }
+            | Self::InsertBatch { table, .. }
+            | Self::DeleteKeys { table, .. }
+            | Self::LookupByIndex { table, .. }
+            | Self::ReplaceAll { table, .. }
             | Self::RangeByIndex { table, .. }
-            | Self::DescribeTable { table } | Self::CreateTable { table, .. }
-            | Self::DropTable { table } | Self::CreateIndex { table, .. }
-            | Self::DropIndex { table, .. } | Self::DropColumn { table, .. }
+            | Self::DescribeTable { table }
+            | Self::CreateTable { table, .. }
+            | Self::DropTable { table }
+            | Self::CreateIndex { table, .. }
+            | Self::DropIndex { table, .. }
+            | Self::DropColumn { table, .. }
             | Self::Compact { table }
-            | Self::ReplaceSchema { table, .. } => Some(table),
-            Self::Ping | Self::ListTables | Self::ListCatalog | Self::AccountsList | Self::CatalogManage { .. }
-            | Self::IdentityInitialize { .. } | Self::RoleCreate { .. } | Self::IdentityAlter { .. }
-            | Self::AccountCreate { .. } | Self::AccountReset { .. } | Self::AccountLogin { .. }
-            | Self::AccountDrop { .. } | Self::BootstrapSystem { .. } | Self::SystemStatus
+            | Self::ReplaceSchema { table, .. }
+            | Self::AlterDomain { table, .. } => Some(table),
+            Self::Ping
+            | Self::ListTables
+            | Self::ListCatalog
+            | Self::DomainSnapshot
+            | Self::MvccPreview { .. }
+            | Self::MvccBegin { .. }
+            | Self::MvccLock { .. }
+            | Self::MvccCommit { .. }
+            | Self::MvccRollback { .. }
+            | Self::DatabaseSnapshot { .. }
+            | Self::AccountsList
+            | Self::CatalogManage { .. }
+            | Self::IdentityInitialize { .. }
+            | Self::RoleCreate { .. }
+            | Self::IdentityAlter { .. }
+            | Self::AccountCreate { .. }
+            | Self::AccountReset { .. }
+            | Self::AccountLogin { .. }
+            | Self::AccountDrop { .. }
+            | Self::BootstrapSystem { .. }
+            | Self::SystemStatus
             | Self::BootstrapTypes { .. }
             | Self::ApplyTransaction { .. } => None,
         }
@@ -284,14 +392,26 @@ fn default_id_column() -> String {
 #[derive(Debug, Serialize, Deserialize)]
 #[serde(tag = "status", rename_all = "snake_case")]
 pub enum Response {
-    Guarded { response: Box<Response> },
-    Accounts { accounts: Vec<Account> },
+    Guarded {
+        response: Box<Response>,
+    },
+    Accounts {
+        accounts: Vec<Account>,
+    },
     Pong,
-    Rows { rows: Vec<Row> },
-    Tables { tables: Vec<String> },
+    Rows {
+        rows: Vec<Row>,
+    },
+    Tables {
+        tables: Vec<String>,
+    },
     Schema {
         table: String,
-        #[serde(default, serialize_with = "serialize_version", deserialize_with = "deserialize_version")]
+        #[serde(
+            default,
+            serialize_with = "serialize_version",
+            deserialize_with = "deserialize_version"
+        )]
         schema_version: u64,
         columns: Vec<SchemaColumn>,
         #[serde(default)]
@@ -309,9 +429,30 @@ pub enum Response {
         #[serde(default)]
         last_lsn: u64,
     },
-    Error { message: String },
-    Catalog { schemas: Vec<TableSchemaWire> },
-    Object { database_id: u64, object_id: Option<u64> },
+    Error {
+        message: String,
+    },
+    Catalog {
+        schemas: Vec<TableSchemaWire>,
+    },
+    DomainSnapshot {
+        schemas: Vec<TableSchemaWire>,
+        rows: Vec<(String, Vec<Row>)>,
+        checkpoint: String,
+    },
+    MvccSnapshot {
+        transaction: String,
+        schemas: Vec<TableSchemaWire>,
+        rows: Vec<(String, Vec<Row>)>,
+        checkpoint: String,
+    },
+    SnapshotUnchanged {
+        checkpoint: String,
+    },
+    Object {
+        database_id: u64,
+        object_id: Option<u64>,
+    },
 }
 
 #[derive(Debug, Deserialize)]
@@ -330,7 +471,11 @@ pub struct TableSchemaWire {
     pub database_id: u64,
     #[serde(default)]
     pub object_id: u64,
-    #[serde(default, serialize_with = "serialize_version", deserialize_with = "deserialize_version")]
+    #[serde(
+        default,
+        serialize_with = "serialize_version",
+        deserialize_with = "deserialize_version"
+    )]
     pub schema_version: u64,
     pub columns: Vec<SchemaColumn>,
     #[serde(default)]
@@ -342,7 +487,10 @@ pub struct TableSchemaWire {
 }
 
 /// 将结构版本编码成精确十进制字符串
-fn serialize_version<S: serde::Serializer>(version: &u64, serializer: S) -> Result<S::Ok, S::Error> {
+fn serialize_version<S: serde::Serializer>(
+    version: &u64,
+    serializer: S,
+) -> Result<S::Ok, S::Error> {
     serializer.serialize_str(&version.to_string())
 }
 
@@ -350,9 +498,14 @@ fn serialize_version<S: serde::Serializer>(version: &u64, serializer: S) -> Resu
 fn deserialize_version<'de, D: serde::Deserializer<'de>>(deserializer: D) -> Result<u64, D::Error> {
     let value = serde_json::Value::deserialize(deserializer)?;
     match value {
-        serde_json::Value::String(s) if !s.is_empty() && s.len() <= 20 && s.bytes().all(|c| c.is_ascii_digit()) =>
-            s.parse().map_err(serde::de::Error::custom),
-        serde_json::Value::Number(n) => n.as_u64().ok_or_else(|| serde::de::Error::custom("invalid schema version")),
+        serde_json::Value::String(s)
+            if !s.is_empty() && s.len() <= 20 && s.bytes().all(|c| c.is_ascii_digit()) =>
+        {
+            s.parse().map_err(serde::de::Error::custom)
+        }
+        serde_json::Value::Number(n) => n
+            .as_u64()
+            .ok_or_else(|| serde::de::Error::custom("invalid schema version")),
         _ => Err(serde::de::Error::custom("invalid schema version")),
     }
 }

chusql-core/storage/src/wal.rs

@@ -26,12 +26,30 @@ const OP_CREATE_TABLE: u8 = 11;
 const OP_DROP_TABLE: u8 = 12;
 const OP_CREATE_INDEX: u8 = 13;
 const OP_DROP_INDEX: u8 = 14;
+const OP_MIGRATE: u8 = 15;
 
 #[derive(Debug, Clone, Serialize, Deserialize, PartialEq)]
 pub enum WalOp {
-    HideColumn { table: String, column: String, schema_version: Option<u64> },
-    Compact { table: String, rows: Vec<Row> },
-    Accounts { accounts: Vec<Account>, removed: Vec<String>, migrate_roles: bool },
+    Migrate {
+        table: String,
+        object_id: u64,
+        source: String,
+        target: String,
+    },
+    HideColumn {
+        table: String,
+        column: String,
+        schema_version: Option<u64>,
+    },
+    Compact {
+        table: String,
+        rows: Vec<Row>,
+    },
+    Accounts {
+        accounts: Vec<Account>,
+        removed: Vec<String>,
+        migrate_roles: bool,
+    },
     Insert {
         table: String,
         row: Row,
@@ -80,6 +98,28 @@ pub enum WalOp {
     Commit,
 }
 
+impl WalOp {
+    /// 返回单表操作的目标，账号组另行展开
+    pub(crate) fn table(&self) -> Option<&str> {
+        match self {
+            Self::Migrate { table, .. }
+            | Self::HideColumn { table, .. }
+            | Self::Compact { table, .. }
+            | Self::Insert { table, .. }
+            | Self::InsertBatch { table, .. }
+            | Self::DeleteKeys { table, .. }
+            | Self::ReplaceAll { table, .. }
+            | Self::DropColumn { table, .. }
+            | Self::ReplaceSchema { table, .. }
+            | Self::CreateTable { table, .. }
+            | Self::DropTable { table }
+            | Self::CreateIndex { table, .. }
+            | Self::DropIndex { table, .. } => Some(table),
+            Self::Accounts { .. } | Self::Commit => None,
+        }
+    }
+}
+
 #[derive(Debug, Serialize, Deserialize)]
 struct HideColumnPayload {
     column: String,
@@ -255,13 +295,11 @@ impl Wal {
     /// 读当前 WAL 的第一条操作；空则 None
     pub fn read(&self) -> io::Result<Option<WalOp>> {
         let scan = self.read_all()?;
-        Ok(scan.records.into_iter().find_map(|(_, op)| {
-            if op == WalOp::Commit {
-                None
-            } else {
-                Some(op)
-            }
-        }))
+        Ok(scan.records.into_iter().find_map(
+            |(_, op)| {
+                if op == WalOp::Commit { None } else { Some(op) }
+            },
+        ))
     }
 
     /// 读全部记录，撕裂或损坏的尾巴按长度截断
@@ -287,9 +325,12 @@ impl Wal {
         let mut frames = Vec::new();
         let mut offset = 0usize;
         while offset + 4 <= buf.len() {
-            let body_len =
-                u32::from_le_bytes([buf[offset], buf[offset + 1], buf[offset + 2], buf[offset + 3]])
-                    as usize;
+            let body_len = u32::from_le_bytes([
+                buf[offset],
+                buf[offset + 1],
+                buf[offset + 2],
+                buf[offset + 3],
+            ]) as usize;
             let end = offset + 4 + body_len;
             if end > buf.len() {
                 break;
@@ -324,7 +365,10 @@ impl Wal {
         }
         let bytes = std::fs::read(&path)?;
         if bytes.len() != 8 {
-            return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid WAL checkpoint length"));
+            return Err(io::Error::new(
+                io::ErrorKind::InvalidData,
+                "invalid WAL checkpoint length",
+            ));
         }
         let mut raw = [0u8; 8];
         raw.copy_from_slice(&bytes[..8]);
@@ -342,10 +386,14 @@ impl Wal {
             if let Some((lsn, _, _, _)) = frames.last() {
                 base = base.max(*lsn);
             }
-            *slot = base.checked_add(1).ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
+            *slot = base
+                .checked_add(1)
+                .ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
         }
         let lsn = *slot;
-        *slot = slot.checked_add(1).ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
+        *slot = slot
+            .checked_add(1)
+            .ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
         Ok(lsn)
     }
 
@@ -392,6 +440,7 @@ fn truncate(f: &mut File) -> io::Result<()> {
 /// 把操作编成字节
 fn encode(op: &WalOp, lsn: u64) -> io::Result<Vec<u8>> {
     let (op_type, table, payload) = match op {
+        WalOp::Migrate { table, .. } => (OP_MIGRATE, table.clone(), serde_json::to_vec(op).map_err(io::Error::other)?),
         WalOp::HideColumn { table, column, schema_version } => (OP_HIDE_COLUMN, table.clone(),
             serde_json::to_vec(&serde_json::json!({"column":column,"schema_version":schema_version})).map_err(io::Error::other)?),
         WalOp::Compact { table, rows } => {
@@ -487,6 +536,25 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
     let payload = &body[11 + table_len..];
 
     let op = match op_type {
+        OP_MIGRATE => {
+            let op: WalOp = serde_json::from_slice(payload)
+                .map_err(|e| format!("bad migration payload: {e}"))?;
+            match &op {
+                WalOp::Migrate {
+                    table: name,
+                    source,
+                    target,
+                    ..
+                } if name == &table
+                    && crate::catalog::valid_generation(source)
+                    && !target.is_empty()
+                    && crate::catalog::valid_generation(target) =>
+                {
+                    op
+                }
+                _ => return Err("invalid migration WAL".into()),
+            }
+        }
         OP_COMMIT => WalOp::Commit,
         OP_HIDE_COLUMN => {
             let value: serde_json::Value = serde_json::from_slice(payload)
@@ -498,28 +566,61 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
                     .map_err(|e| format!("bad hide_column payload: {e}"))?;
                 (p.column, p.schema_version)
             };
-            WalOp::HideColumn { table, column, schema_version }
+            WalOp::HideColumn {
+                table,
+                column,
+                schema_version,
+            }
         }
         OP_COMPACT => {
-            let rows: Vec<Row> = serde_json::from_slice(payload)
-                .map_err(|e| format!("bad compact payload: {e}"))?;
+            let rows: Vec<Row> =
+                serde_json::from_slice(payload).map_err(|e| format!("bad compact payload: {e}"))?;
             WalOp::Compact { table, rows }
         }
         OP_ACCOUNTS => {
-            if table != USERS_TABLE { return Err("invalid account WAL table".into()); }
-            let value: serde_json::Value = serde_json::from_slice(payload).map_err(|e| format!("bad account payload: {e}"))?;
+            if table != USERS_TABLE {
+                return Err("invalid account WAL table".into());
+            }
+            let value: serde_json::Value =
+                serde_json::from_slice(payload).map_err(|e| format!("bad account payload: {e}"))?;
             let (accounts, removed, migrate_roles) = if value.is_array() {
-                (serde_json::from_value(value).map_err(|e| format!("bad account payload: {e}"))?, Vec::new(), false)
+                (
+                    serde_json::from_value(value)
+                        .map_err(|e| format!("bad account payload: {e}"))?,
+                    Vec::new(),
+                    false,
+                )
             } else {
-                (serde_json::from_value(value.get("accounts").cloned().ok_or("missing account payload")?).map_err(|e| format!("bad account payload: {e}"))?,
-                    serde_json::from_value(value.get("removed").cloned().ok_or("missing identity cleanup")?).map_err(|e| format!("bad account cleanup: {e}"))?,
-                    value.get("migrate_roles").and_then(serde_json::Value::as_bool).ok_or("missing role migration flag")?)
+                (
+                    serde_json::from_value(
+                        value
+                            .get("accounts")
+                            .cloned()
+                            .ok_or("missing account payload")?,
+                    )
+                    .map_err(|e| format!("bad account payload: {e}"))?,
+                    serde_json::from_value(
+                        value
+                            .get("removed")
+                            .cloned()
+                            .ok_or("missing identity cleanup")?,
+                    )
+                    .map_err(|e| format!("bad account cleanup: {e}"))?,
+                    value
+                        .get("migrate_roles")
+                        .and_then(serde_json::Value::as_bool)
+                        .ok_or("missing role migration flag")?,
+                )
             };
-            WalOp::Accounts { accounts, removed, migrate_roles }
+            WalOp::Accounts {
+                accounts,
+                removed,
+                migrate_roles,
+            }
         }
         OP_INSERT => {
-            let row: Row =
-                serde_json::from_slice(payload).map_err(|e| format!("bad insert payload: {}", e))?;
+            let row: Row = serde_json::from_slice(payload)
+                .map_err(|e| format!("bad insert payload: {}", e))?;
             WalOp::Insert { table, row }
         }
         OP_INSERT_BATCH => {

chusql-core/storage/tests/btree_test.rs

@@ -1,4 +1,4 @@
-use chusql_core_storage::btree::{fits_in_page, DiskBTree, MAX_KEY_BYTES};
+use chusql_core_storage::btree::{DiskBTree, MAX_KEY_BYTES, fits_in_page};
 use chusql_core_storage::config::{DEFAULT_BTREE_ORDER, DEFAULT_PAGE_SIZE};
 use chusql_core_storage::page::DEFAULT_POOL_SIZE;
 use std::io::{ErrorKind, Seek, SeekFrom, Write};
@@ -16,20 +16,28 @@ fn malformed_node_fields_return_invalid_data() {
         tree.insert(b"y", 2).unwrap();
     }
     let original = std::fs::read(&path).unwrap();
-    let cell = u16::from_le_bytes([original[DEFAULT_PAGE_SIZE + 11], original[DEFAULT_PAGE_SIZE + 12]]) as usize;
+    let cell = u16::from_le_bytes([
+        original[DEFAULT_PAGE_SIZE + 11],
+        original[DEFAULT_PAGE_SIZE + 12],
+    ]) as usize;
     for (name, offset, bytes) in [
         ("slot count", 1, vec![255, 255]),
         ("node kind", 0, vec![2]),
         ("cell overlaps slots", 11, vec![0, 0]),
         ("cell beyond page", 11, vec![255, 15]),
-        ("overlapping cells", 13, (cell as u16).to_le_bytes().to_vec()),
+        (
+            "overlapping cells",
+            13,
+            (cell as u16).to_le_bytes().to_vec(),
+        ),
         ("key length", cell, vec![255, 255]),
         ("key order", cell + 2, vec![b'z']),
         ("zero child", 0, vec![1]),
     ] {
         std::fs::write(&path, &original).unwrap();
         let mut file = std::fs::OpenOptions::new().write(true).open(&path).unwrap();
-        file.seek(SeekFrom::Start((DEFAULT_PAGE_SIZE + offset) as u64)).unwrap();
+        file.seek(SeekFrom::Start((DEFAULT_PAGE_SIZE + offset) as u64))
+            .unwrap();
         file.write_all(&bytes).unwrap();
         drop(file);
         let mut tree = open(dir.path(), "corrupt.idx");
@@ -42,7 +50,13 @@ fn malformed_node_fields_return_invalid_data() {
 
 /// 按默认参数打开指定索引文件
 fn open(dir: &std::path::Path, name: &str) -> DiskBTree {
-    DiskBTree::open(dir.join(name), DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap()
+    DiskBTree::open(
+        dir.join(name),
+        DEFAULT_PAGE_SIZE,
+        DEFAULT_BTREE_ORDER,
+        DEFAULT_POOL_SIZE,
+    )
+    .unwrap()
 }
 
 /// 整数键编码成保序的 8 字节（与堆表一致）
@@ -101,12 +115,24 @@ fn reopen_persists() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("t.idx");
     {
-        let mut t = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap();
+        let mut t = DiskBTree::open(
+            &path,
+            DEFAULT_PAGE_SIZE,
+            DEFAULT_BTREE_ORDER,
+            DEFAULT_POOL_SIZE,
+        )
+        .unwrap();
         for i in 0..50 {
             t.insert(&key(i), i as u64).unwrap();
         }
     }
-    let mut t = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap();
+    let mut t = DiskBTree::open(
+        &path,
+        DEFAULT_PAGE_SIZE,
+        DEFAULT_BTREE_ORDER,
+        DEFAULT_POOL_SIZE,
+    )
+    .unwrap();
     for i in 0..50 {
         assert_eq!(t.get(&key(i)).unwrap(), Some(i as u64));
     }
@@ -148,12 +174,26 @@ fn config_mismatch_errors() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("t.idx");
     {
-        let mut t = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap();
+        let mut t = DiskBTree::open(
+            &path,
+            DEFAULT_PAGE_SIZE,
+            DEFAULT_BTREE_ORDER,
+            DEFAULT_POOL_SIZE,
+        )
+        .unwrap();
         t.insert(&key(1), 1).unwrap();
     }
     assert!(DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 8, DEFAULT_POOL_SIZE).is_err());
     assert!(DiskBTree::open(&path, 8192, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).is_err());
-    assert!(DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).is_ok());
+    assert!(
+        DiskBTree::open(
+            &path,
+            DEFAULT_PAGE_SIZE,
+            DEFAULT_BTREE_ORDER,
+            DEFAULT_POOL_SIZE
+        )
+        .is_ok()
+    );
 }
 
 /// 不是索引文件要报错
@@ -162,7 +202,15 @@ fn not_an_index_file_errors() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("junk.idx");
     std::fs::write(&path, vec![7u8; DEFAULT_PAGE_SIZE]).unwrap();
-    assert!(DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).is_err());
+    assert!(
+        DiskBTree::open(
+            &path,
+            DEFAULT_PAGE_SIZE,
+            DEFAULT_BTREE_ORDER,
+            DEFAULT_POOL_SIZE
+        )
+        .is_err()
+    );
 }
 
 /// order 放不进一页要报错
@@ -182,7 +230,10 @@ fn delete_removes_only_that_key() {
         t.insert(&key(i), i as u64 + 1).unwrap();
     }
 
-    assert!(t.delete(&key(50), 51).unwrap(), "deleting an existing entry should return true");
+    assert!(
+        t.delete(&key(50), 51).unwrap(),
+        "deleting an existing entry should return true"
+    );
     assert_eq!(t.get(&key(50)).unwrap(), None);
     assert_eq!(t.get(&key(49)).unwrap(), Some(50));
     assert_eq!(t.get(&key(51)).unwrap(), Some(52));
@@ -262,7 +313,11 @@ fn splits_keep_keys_sorted() {
     let all: Vec<Vec<u8>> = t.iter_all().unwrap().into_iter().map(|(k, _)| k).collect();
     assert_eq!(all, expected);
     for k in &expected {
-        assert!(t.get(k).unwrap().is_some(), "missing {:?}", String::from_utf8_lossy(k));
+        assert!(
+            t.get(k).unwrap().is_some(),
+            "missing {:?}",
+            String::from_utf8_lossy(k)
+        );
     }
 }
 
@@ -314,3 +369,61 @@ fn clear_resets_the_tree() {
     t.insert(b"c", 3).unwrap();
     assert_eq!(t.get(b"c").unwrap(), Some(3));
 }
+
+/// 长键跨页后可重启查询并保留旧配置
+#[test]
+fn long_keys_split_reopen_and_preserve_dense_configuration() {
+    use chusql_core_storage::btree::key_limit;
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("long.idx");
+    let mut tree = DiskBTree::open(&path, 512, 4, DEFAULT_POOL_SIZE).unwrap();
+    for n in 0..80_u64 {
+        let key = format!("{n:03}{}", "a".repeat(125));
+        tree.insert(key.as_bytes(), n).unwrap();
+    }
+    drop(tree);
+    let mut tree = DiskBTree::open(&path, 512, 4, DEFAULT_POOL_SIZE).unwrap();
+    assert_eq!(tree.scan(None, None).unwrap().len(), 80);
+    for n in 0..80_u64 {
+        let key = format!("{n:03}{}", "a".repeat(125));
+        assert_eq!(tree.get(key.as_bytes()).unwrap(), Some(n));
+    }
+    let dense_path = dir.path().join("dense.idx");
+    let mut dense = DiskBTree::open(&dense_path, 512, 7, DEFAULT_POOL_SIZE).unwrap();
+    let limit = key_limit(512, 7);
+    assert!((64..MAX_KEY_BYTES).contains(&limit));
+    dense.insert(&vec![b'a'; limit], 1).unwrap();
+    assert_eq!(
+        dense.insert(&vec![b'b'; limit + 1], 2).unwrap_err().kind(),
+        ErrorKind::InvalidInput
+    );
+    assert_eq!(dense.get(&vec![b'a'; limit]).unwrap(), Some(1));
+}
+
+/// 旧文件头可无损打开并首次写入长键
+#[test]
+fn legacy_key_header_upgrades_only_when_long_keys_are_written() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("legacy.idx");
+    let mut tree = open(dir.path(), "legacy.idx");
+    tree.insert(b"old", 1).unwrap();
+    drop(tree);
+    let mut bytes = std::fs::read(&path).unwrap();
+    bytes[8..10].copy_from_slice(&64_u16.to_le_bytes());
+    std::fs::write(&path, &bytes).unwrap();
+    let mut tree = open(dir.path(), "legacy.idx");
+    assert_eq!(tree.get(b"old").unwrap(), Some(1));
+    drop(tree);
+    assert_eq!(std::fs::read(&path).unwrap(), bytes);
+    let mut tree = open(dir.path(), "legacy.idx");
+    let key = "author/".to_string() + &"p".repeat(80);
+    tree.insert(key.as_bytes(), 2).unwrap();
+    drop(tree);
+    let mut tree = open(dir.path(), "legacy.idx");
+    assert_eq!(tree.get(key.as_bytes()).unwrap(), Some(2));
+    assert_eq!(tree.get(b"old").unwrap(), Some(1));
+    assert_eq!(
+        &std::fs::read(&path).unwrap()[8..10],
+        &128_u16.to_le_bytes()
+    );
+}

chusql-core/storage/tests/catalog_test.rs

@@ -33,9 +33,14 @@ fn schema_versions_track_structure_and_survive_reload() {
 fn legacy_schema_version_remains_unknown_until_change() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("catalog.json");
-    std::fs::write(&path, json!({"tables": {
+    std::fs::write(
+        &path,
+        json!({"tables": {
             "t": {"object_id": 42, "columns": []}
-    }}).to_string()).unwrap();
+        }})
+        .to_string(),
+    )
+    .unwrap();
     let mut c = Catalog::load(&path).unwrap();
     assert_eq!(c.describe("t").unwrap().schema_version, 0);
     c.save(&path).unwrap();
@@ -51,10 +56,15 @@ fn legacy_schema_version_remains_unknown_until_change() {
 fn exhausted_schema_version_preserves_structure() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("catalog.json");
-    std::fs::write(&path, json!({"tables": {
+    std::fs::write(
+        &path,
+        json!({"tables": {
             "t": {"object_id": 42, "schema_version": u64::MAX,
                 "columns": [{"name": "id", "ty": "int"}]}
-    }}).to_string()).unwrap();
+        }})
+        .to_string(),
+    )
+    .unwrap();
     let mut c = Catalog::load(&path).unwrap();
     assert!(c.remove_column("t", "id").is_err());
     assert!(c.set_columns("t", vec![]).is_err());
@@ -90,20 +100,42 @@ fn object_ids_survive_reload_and_are_not_reused() {
 fn legacy_object_ids_upgrade_without_collisions() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("catalog.json");
-    std::fs::write(&path, json!({"tables": {
+    std::fs::write(
+        &path,
+        json!({"tables": {
             "a": {"columns": [], "object_id": 42},
             "b": {"columns": []}
-    }}).to_string()).unwrap();
+        }})
+        .to_string(),
+    )
+    .unwrap();
     let catalog = Catalog::load(&path).unwrap();
     assert_eq!(catalog.describe("a").unwrap().object_id, 42);
     assert_eq!(catalog.describe("b").unwrap().object_id, 43);
     catalog.save(&path).unwrap();
-    assert_eq!(Catalog::load(&path).unwrap().describe("b").unwrap().object_id, 43);
-    std::fs::write(&path, json!({"tables": {
+    assert_eq!(
+        Catalog::load(&path)
+            .unwrap()
+            .describe("b")
+            .unwrap()
+            .object_id,
+        43
+    );
+    std::fs::write(
+        &path,
+        json!({"tables": {
             "a": {"columns": [], "object_id": 42},
             "b": {"columns": [], "object_id": 42}
-    }}).to_string()).unwrap();
-    assert!(Catalog::load(&path).unwrap_err().to_string().contains("duplicate"));
+        }})
+        .to_string(),
+    )
+    .unwrap();
+    assert!(
+        Catalog::load(&path)
+            .unwrap_err()
+            .to_string()
+            .contains("duplicate")
+    );
 }
 
 /// 编号耗尽明确失败且不建立对象
@@ -115,8 +147,6 @@ fn exhausted_object_ids_fail_without_creating_table() {
     assert!(catalog.describe("t").is_none());
 }
 
-
-
 /// 用键值对构造一行
 fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
     let mut m = Row::new();
@@ -128,7 +158,8 @@ fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
 
 /// 空文件得到空字典，未知表返回 None
 #[test]
-fn empty_file_gives_empty_catalog_and_unknown_table_returns_none() {    let dir = tempfile::tempdir().unwrap();
+fn empty_file_gives_empty_catalog_and_unknown_table_returns_none() {
+    let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("catalog.json");
     let c = Catalog::load(&path).unwrap();
     assert_eq!(c.table_names().len(), 0);
@@ -142,7 +173,8 @@ fn ensure_then_describe() {
     let path = dir.path().join("catalog.json");
 
     let mut c = Catalog::load(&path).unwrap();
-    c.ensure_columns("users", &row(&[("id", json!(1)), ("name", json!("Alice"))])).unwrap();
+    c.ensure_columns("users", &row(&[("id", json!(1)), ("name", json!("Alice"))]))
+        .unwrap();
     c.save(&path).unwrap();
 
     let c2 = Catalog::load(&path).unwrap();
@@ -164,8 +196,10 @@ fn second_insert_does_not_duplicate_columns() {
     let path = dir.path().join("catalog.json");
 
     let mut c = Catalog::load(&path).unwrap();
-    c.ensure_columns("users", &row(&[("id", json!(1))])).unwrap();
-    c.ensure_columns("users", &row(&[("id", json!(2))])).unwrap();
+    c.ensure_columns("users", &row(&[("id", json!(1))]))
+        .unwrap();
+    c.ensure_columns("users", &row(&[("id", json!(2))]))
+        .unwrap();
     assert_eq!(c.describe("users").unwrap().columns.len(), 1);
 }
 
@@ -176,9 +210,11 @@ fn remove_column_drops_definition_stats_and_index() {
     let path = dir.path().join("catalog.json");
 
     let mut c = Catalog::load(&path).unwrap();
-    c.ensure_columns("t", &row(&[("id", json!(1)), ("code", json!(5))])).unwrap();
+    c.ensure_columns("t", &row(&[("id", json!(1)), ("code", json!(5))]))
+        .unwrap();
     c.add_index("t", "code").unwrap();
-    c.rebuild_stats("t", &[row(&[("id", json!(1)), ("code", json!(5))])]).unwrap();
+    c.rebuild_stats("t", &[row(&[("id", json!(1)), ("code", json!(5))])])
+        .unwrap();
 
     let removed = c.remove_column("t", "code").unwrap();
     assert!(removed, "first remove should hit the column");
@@ -186,7 +222,10 @@ fn remove_column_drops_definition_stats_and_index() {
     assert_eq!(s.columns.len(), 1);
     assert_eq!(s.columns[0].name, "id");
     assert!(s.indexes.is_empty(), "index on code should be gone");
-    assert!(!s.stats.contains_key("code"), "stats for code should be gone");
+    assert!(
+        !s.stats.contains_key("code"),
+        "stats for code should be gone"
+    );
 
     let again = c.remove_column("t", "code").unwrap();
     assert!(!again);
@@ -217,7 +256,8 @@ fn stats_track_a_histogram_for_numeric_columns() {
     assert!(name.hist.is_empty(), "字符串列不进直方图");
     assert_eq!(name.lo, None);
 
-    c.record_insert("t", &row(&[("id", json!(1000)), ("name", json!("x"))])).unwrap();
+    c.record_insert("t", &row(&[("id", json!(1000)), ("name", json!("x"))]))
+        .unwrap();
     let s = c.describe("t").unwrap();
     let id = s.stats.get("id").unwrap();
     assert_eq!(id.lo, Some(0.0));
@@ -240,7 +280,9 @@ fn stats_track_a_histogram_for_numeric_columns() {
 fn duplicate_deletion_keeps_distinct_until_last_occurrence() {
     let mut catalog = Catalog::default();
     let duplicate = row(&[("id", json!(1)), ("v", json!(7))]);
-    catalog.rebuild_stats("t", &[duplicate.clone(), duplicate.clone()]).unwrap();
+    catalog
+        .rebuild_stats("t", &[duplicate.clone(), duplicate.clone()])
+        .unwrap();
     catalog.record_delete("t", std::slice::from_ref(&duplicate));
     assert_eq!(catalog.describe("t").unwrap().stats["v"].distinct, 1);
     catalog.record_delete("t", &[duplicate]);
@@ -251,7 +293,9 @@ fn duplicate_deletion_keeps_distinct_until_last_occurrence() {
 #[test]
 fn capped_distinct_keeps_histogram_and_other_columns_accurate() {
     let mut catalog = Catalog::default();
-    let rows: Vec<Row> = (0..5000).map(|n| row(&[("id", json!(n)), ("v", json!(n % 2))])).collect();
+    let rows: Vec<Row> = (0..5000)
+        .map(|n| row(&[("id", json!(n)), ("v", json!(n % 2))]))
+        .collect();
     catalog.rebuild_stats("t", &rows).unwrap();
     let schema = catalog.describe("t").unwrap();
     assert!(schema.stats["id"].capped);
@@ -277,7 +321,9 @@ fn rebuilt_histogram_has_exact_buckets_in_any_order() {
     let stat = &forward.describe("t").unwrap().stats["v"];
     assert_eq!(stat.hist, vec![10; 16]);
     assert_eq!(stat.hist, reverse.describe("t").unwrap().stats["v"].hist);
-    forward.record_insert("t", &row(&[("v", json!(10000))])).unwrap();
+    forward
+        .record_insert("t", &row(&[("v", json!(10000))]))
+        .unwrap();
     forward.record_delete("t", &[row(&[("v", json!(10000))])]);
     forward.rebuild_stats("t", &rows[80..]).unwrap();
     let repaired = &forward.describe("t").unwrap().stats["v"];
@@ -316,7 +362,13 @@ fn legacy_catalog_loads_and_normalizes() {
     assert_eq!(s.columns.len(), 2);
     assert!(s.columns[0].nullable, "老列默认可空");
     assert!(c.normalize_types().unwrap());
-    let types: Vec<&str> = c.describe("legacy").unwrap().columns.iter().map(|col| col.ty.as_str()).collect();
+    let types: Vec<&str> = c
+        .describe("legacy")
+        .unwrap()
+        .columns
+        .iter()
+        .map(|col| col.ty.as_str())
+        .collect();
     assert_eq!(types, vec!["int", "str"]);
     assert!(!c.normalize_types().unwrap(), "第二次没有可改的");
 }

chusql-core/storage/tests/config_test.rs

@@ -36,8 +36,7 @@ fn defaults_without_file() {
 fn file_overrides_only_written_keys() {
     let _guard = env_guard();
     let path = PathBuf::from("t.toml");
-    let loaded = config::resolve(Some("[page]\nsize = 8192\n"), Some(path.clone()))
-        .unwrap();
+    let loaded = config::resolve(Some("[page]\nsize = 8192\n"), Some(path.clone())).unwrap();
 
     assert_eq!(loaded.config.page_size, 8192);
     assert_eq!(loaded.config.btree_order, DEFAULT_BTREE_ORDER);
@@ -45,9 +44,17 @@ fn file_overrides_only_written_keys() {
     assert_eq!(loaded.config.log_files, PathBuf::from(DEFAULT_LOG_FILES));
     assert_eq!(loaded.config_path, Some(path.clone()));
 
-    let page = loaded.origins.iter().find(|(n, _, _)| *n == "page.size").unwrap();
+    let page = loaded
+        .origins
+        .iter()
+        .find(|(n, _, _)| *n == "page.size")
+        .unwrap();
     assert_eq!(page.2, Origin::File(path));
-    let order = loaded.origins.iter().find(|(n, _, _)| *n == "btree.order").unwrap();
+    let order = loaded
+        .origins
+        .iter()
+        .find(|(n, _, _)| *n == "btree.order")
+        .unwrap();
     assert_eq!(order.2, Origin::Default);
 }
 
@@ -110,7 +117,11 @@ fn default_config_path_follows_system_convention() {
     let path = config::default_config_path();
     assert_eq!(path.file_name().unwrap(), "settings.toml");
     assert_eq!(path.parent().unwrap().file_name().unwrap(), "ChuSQL");
-    assert!(path.ends_with(format!("ChuSQL{}settings.toml", std::path::MAIN_SEPARATOR)), "got {}", path.display());
+    assert!(
+        path.ends_with(format!("ChuSQL{}settings.toml", std::path::MAIN_SEPARATOR)),
+        "got {}",
+        path.display()
+    );
 
     // 本机 APPDATA 存在时必须是 %APPDATA%\ChuSQL\settings.toml
     #[cfg(windows)]
@@ -168,7 +179,11 @@ fn explicit_missing_path_is_an_error() {
         "got {}",
         err
     );
-    assert!(err.contains("chusql-no-such-config-9f21.toml"), "got {}", err);
+    assert!(
+        err.contains("chusql-no-such-config-9f21.toml"),
+        "got {}",
+        err
+    );
 }
 
 /// 不给 --config 且无配置文件时用内置默认

chusql-core/storage/tests/ffi_test.rs

@@ -26,16 +26,40 @@ fn maintenance_rejects_invalid_arguments_and_resets_outputs() {
     let mut len = 99;
     // SAFETY: 输出均可写；无效输入应在任何读取之前被拒绝。
     unsafe {
-        assert_eq!(chusql_storage_maintenance(ptr::null(), ptr::null(), 0, &mut out, &mut len), -1);
+        assert_eq!(
+            chusql_storage_maintenance(ptr::null(), ptr::null(), 0, &mut out, &mut len),
+            -1
+        );
         assert!(out.is_null());
         assert_eq!(len, 0);
         len = 99;
-        assert_eq!(chusql_storage_maintenance(ptr::null(), input.as_ptr(), input.len(), ptr::null_mut(), &mut len), -1);
+        assert_eq!(
+            chusql_storage_maintenance(
+                ptr::null(),
+                input.as_ptr(),
+                input.len(),
+                ptr::null_mut(),
+                &mut len
+            ),
+            -1
+        );
         assert_eq!(len, 0);
         out = input.as_ptr() as *mut u8;
-        assert_eq!(chusql_storage_maintenance(ptr::null(), input.as_ptr(), input.len(), &mut out, ptr::null_mut()), -1);
+        assert_eq!(
+            chusql_storage_maintenance(
+                ptr::null(),
+                input.as_ptr(),
+                input.len(),
+                &mut out,
+                ptr::null_mut()
+            ),
+            -1
+        );
         assert!(out.is_null());
-        assert_eq!(chusql_storage_maintenance(ptr::null(), input.as_ptr(), usize::MAX, &mut out, &mut len), -1);
+        assert_eq!(
+            chusql_storage_maintenance(ptr::null(), input.as_ptr(), usize::MAX, &mut out, &mut len),
+            -1
+        );
     }
     assert!(out.is_null());
     assert_eq!(len, 0);
@@ -47,20 +71,36 @@ fn maintenance_rejects_invalid_arguments_and_resets_outputs() {
 fn request_validates_input_and_returns_owned_response() -> Result<(), Box<dyn std::error::Error>> {
     let temp = tempfile::tempdir()?;
     let config = temp.path().join("settings.toml");
-    std::fs::write(&config, format!("[storage]\ndata_dir = '{}'\nlog_files = '{}'\n[log]\nlevel = 'off'\n", temp.path().join("data").display(), temp.path().join("logs").display()))?;
+    std::fs::write(
+        &config,
+        format!(
+            "[storage]\ndata_dir = '{}'\nlog_files = '{}'\n[log]\nlevel = 'off'\n",
+            temp.path().join("data").display(),
+            temp.path().join("logs").display()
+        ),
+    )?;
     let storage = Storage::open(config.to_str())?;
     let input = br#"{"method":"ping"}"#;
     let mut out = ptr::null_mut();
     let mut len = 0;
     // SAFETY: 句柄和实际请求有效；超长长度必须在构造切片前被拒绝。
     unsafe {
-        assert_eq!(chusql_storage_request(&storage, input.as_ptr(), usize::MAX, &mut out, &mut len), -1);
+        assert_eq!(
+            chusql_storage_request(&storage, input.as_ptr(), usize::MAX, &mut out, &mut len),
+            -1
+        );
         assert!(out.is_null());
         assert_eq!(len, 0);
         assert_eq!(last_error(), "invalid argument");
-        assert_eq!(chusql_storage_request(&storage, [0xff].as_ptr(), 1, &mut out, &mut len), -1);
+        assert_eq!(
+            chusql_storage_request(&storage, [0xff].as_ptr(), 1, &mut out, &mut len),
+            -1
+        );
         assert!(last_error().starts_with("request is not valid UTF-8:"));
-        assert_eq!(chusql_storage_request(&storage, input.as_ptr(), input.len(), &mut out, &mut len), 0);
+        assert_eq!(
+            chusql_storage_request(&storage, input.as_ptr(), input.len(), &mut out, &mut len),
+            0
+        );
         assert!(!out.is_null());
         let response = slice::from_raw_parts(out, len).to_vec();
         chusql_storage_free(out, len);
@@ -71,7 +111,10 @@ fn request_validates_input_and_returns_owned_response() -> Result<(), Box<dyn st
     let config = CString::new(config.to_str().unwrap())?;
     // SAFETY: 路径与输出有效；失败不产生需要释放的缓冲。
     unsafe {
-        assert_eq!(chusql_storage_maintenance(config.as_ptr(), [0xff].as_ptr(), 1, &mut out, &mut len), -1);
+        assert_eq!(
+            chusql_storage_maintenance(config.as_ptr(), [0xff].as_ptr(), 1, &mut out, &mut len),
+            -1
+        );
     }
     assert!(out.is_null());
     assert_eq!(len, 0);
@@ -79,7 +122,18 @@ fn request_validates_input_and_returns_owned_response() -> Result<(), Box<dyn st
     let maintenance = br#"{"mode":"reset","user":"root","password_hash":"hash","types":[{"name":"int","base_type":"int","parameterized":false}]}"#;
     // SAFETY: 维护仅使用本测试临时目录；成功响应复制后由配套函数释放。
     unsafe {
-        assert_eq!(chusql_storage_maintenance(config.as_ptr(), maintenance.as_ptr(), maintenance.len(), &mut out, &mut len), 0, "{}", last_error());
+        assert_eq!(
+            chusql_storage_maintenance(
+                config.as_ptr(),
+                maintenance.as_ptr(),
+                maintenance.len(),
+                &mut out,
+                &mut len
+            ),
+            0,
+            "{}",
+            last_error()
+        );
         assert!(!out.is_null());
         let response = slice::from_raw_parts(out, len).to_vec();
         chusql_storage_free(out, len);

chusql-core/storage/tests/heap_test.rs

@@ -25,20 +25,61 @@ fn delete_propagates_index_read_errors() {
     let original = row(&[("id", json!(1))]);
     t.insert_row(&original).unwrap();
     t.flush().unwrap();
-    let file = std::fs::OpenOptions::new().write(true).open(&index).unwrap();
+    let file = std::fs::OpenOptions::new()
+        .write(true)
+        .open(&index)
+        .unwrap();
     file.set_len(DEFAULT_PAGE_SIZE as u64).unwrap();
     let err = t.delete_by_keys(&[1]).unwrap_err();
     assert_eq!(err.kind(), std::io::ErrorKind::UnexpectedEof);
     assert_eq!(t.scan().unwrap(), vec![original]);
 }
 
+/// 索引键失败不得留下堆行或清空旧表
+#[test]
+fn invalid_index_keys_leave_heap_and_indexes_unchanged() {
+    let dir = tempfile::tempdir().unwrap();
+    let mut table = HeapTable::open(dir.path().join("t.db"), DEFAULT_PAGE_SIZE, 1).unwrap();
+    let original = row(&[("id", json!(1)), ("name", json!("old"))]);
+    table.insert_row(&original).unwrap();
+    table
+        .build_index(
+            "name",
+            &dir.path().join("t.name.idx"),
+            DEFAULT_PAGE_SIZE,
+            4,
+            1,
+        )
+        .unwrap();
+    let invalid = row(&[("id", json!(2)), ("name", json!("x".repeat(129)))]);
+    assert!(table.insert_row(&invalid).is_err());
+    assert_eq!(table.scan().unwrap(), vec![original.clone()]);
+    assert!(table.replace_all(&[invalid]).is_err());
+    assert_eq!(table.scan().unwrap(), vec![original.clone()]);
+    assert_eq!(
+        table.get_by_string_key("name", "old").unwrap(),
+        Some(original)
+    );
+    assert!(
+        table
+            .replace_all(&[row(&[("name", json!("x".repeat(10_000)))])])
+            .is_err()
+    );
+    assert_eq!(table.scan().unwrap().len(), 1);
+}
+
 /// 跨页投影与分片保持行序及隐藏列
 #[test]
 fn projected_shards_preserve_order_and_hidden_columns() {
     let dir = tempfile::tempdir().unwrap();
     let mut t = HeapTable::open(dir.path().join("t.db"), 256, 1).unwrap();
     for i in 0..40 {
-        t.insert_row(&row(&[("id", json!(i)), ("name", json!("alice")), ("secret", json!(i))])).unwrap();
+        t.insert_row(&row(&[
+            ("id", json!(i)),
+            ("name", json!("alice")),
+            ("secret", json!(i)),
+        ]))
+        .unwrap();
     }
     t.set_hidden_columns(["secret".to_string()].into_iter().collect());
     let columns = vec!["id".to_string(), "secret".to_string()];
@@ -47,9 +88,15 @@ fn projected_shards_preserve_order_and_hidden_columns() {
     let pages = t.num_pages().unwrap();
     assert!(pages > 1);
     let mut shards = t.scan_columns_pages(Some(&columns), 0, pages / 2).unwrap();
-    shards.extend(t.scan_columns_pages(Some(&columns), pages / 2, pages + 1).unwrap());
+    shards.extend(
+        t.scan_columns_pages(Some(&columns), pages / 2, pages + 1)
+            .unwrap(),
+    );
     assert_eq!(shards, expected);
-    assert_eq!(t.read_at(0, 0).unwrap().unwrap(), row(&[("id", json!(0)), ("name", json!("alice"))]));
+    assert_eq!(
+        t.read_at(0, 0).unwrap().unwrap(),
+        row(&[("id", json!(0)), ("name", json!("alice"))])
+    );
 }
 
 /// 扫描与点读均返回行解码错误
@@ -78,15 +125,20 @@ fn empty_index_file_is_rebuilt_from_rows() {
     let data = dir.path().join("t.db");
     let index = dir.path().join("t.idx");
     {
-        let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+        let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE)
+            .unwrap();
         for i in 1..=5 {
             t.insert_row(&row(&[("id", json!(i))])).unwrap();
         }
         t.flush().unwrap();
     }
     std::fs::write(&index, b"").unwrap();
-    let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
-    assert!(t.get_by_column_key("id", 3).unwrap().is_some(), "空索引文件要从堆数据重建");
+    let mut t =
+        HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    assert!(
+        t.get_by_column_key("id", 3).unwrap().is_some(),
+        "空索引文件要从堆数据重建"
+    );
     assert!(t.get_by_column_key("id", 9).unwrap().is_none());
 }
 
@@ -97,14 +149,24 @@ fn string_index_looks_up_by_value() {
     let data = dir.path().join("s.db");
     let index = dir.path().join("s.idx");
     let mut t = HeapTable::open(&data, DEFAULT_PAGE_SIZE, DEFAULT_POOL_SIZE).unwrap();
-    t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))])).unwrap();
-    t.insert_row(&row(&[("id", json!(2)), ("name", json!("bob"))])).unwrap();
-    t.insert_row(&row(&[("id", json!(3)), ("name", json!(null))])).unwrap();
-    t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))]))
+        .unwrap();
+    t.insert_row(&row(&[("id", json!(2)), ("name", json!("bob"))]))
+        .unwrap();
+    t.insert_row(&row(&[("id", json!(3)), ("name", json!(null))]))
+        .unwrap();
+    t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE)
+        .unwrap();
 
-    assert_eq!(t.get_by_string_key("name", "bob").unwrap().unwrap()["id"], json!(2));
+    assert_eq!(
+        t.get_by_string_key("name", "bob").unwrap().unwrap()["id"],
+        json!(2)
+    );
     assert!(t.get_by_string_key("name", "dave").unwrap().is_none());
-    assert!(t.get_by_string_key("name", "").unwrap().is_none(), "NULL 不入索引");
+    assert!(
+        t.get_by_string_key("name", "").unwrap().is_none(),
+        "NULL 不入索引"
+    );
 }
 
 /// 允许重复值建索引：点查把重复的行都取回来
@@ -114,9 +176,12 @@ fn duplicate_values_are_indexed_and_all_returned() {
     let data = dir.path().join("d.db");
     let index = dir.path().join("d.idx");
     let mut t = HeapTable::open(&data, DEFAULT_PAGE_SIZE, DEFAULT_POOL_SIZE).unwrap();
-    t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))])).unwrap();
-    t.insert_row(&row(&[("id", json!(2)), ("name", json!("alice"))])).unwrap();
-    t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))]))
+        .unwrap();
+    t.insert_row(&row(&[("id", json!(2)), ("name", json!("alice"))]))
+        .unwrap();
+    t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE)
+        .unwrap();
 
     let mut ids: Vec<i64> = t
         .get_all_by_string_key("name", "alice")
@@ -218,9 +283,15 @@ fn replace_all_rebuilds_index() {
     ])
     .unwrap();
 
-    assert!(t.get_by_key(1).unwrap().is_none(), "old key must be invalidated");
+    assert!(
+        t.get_by_key(1).unwrap().is_none(),
+        "old key must be invalidated"
+    );
     assert!(t.get_by_key(2).unwrap().is_none());
-    let got = t.get_by_key(7).unwrap().expect("new row should be indexed by id");
+    let got = t
+        .get_by_key(7)
+        .unwrap()
+        .expect("new row should be indexed by id");
     assert_eq!(got["name"], json!("Zoe"));
     assert_eq!(t.scan().unwrap().len(), 2);
 }
@@ -239,7 +310,10 @@ fn delete_by_keys_removes_rows() {
     .unwrap();
 
     for i in 1..=5 {
-        t.insert_row(&row(&[("id", json!(i)), ("name", json!(format!("u{}", i)))]))
+        t.insert_row(&row(&[
+            ("id", json!(i)),
+            ("name", json!(format!("u{}", i))),
+        ]))
         .unwrap();
     }
 
@@ -254,7 +328,10 @@ fn delete_by_keys_removes_rows() {
         .collect();
     assert_eq!(ids, vec![1, 3, 5], "remaining rows must keep their order");
 
-    assert!(t.get_by_key(2).unwrap().is_none(), "index entry should be deleted too");
+    assert!(
+        t.get_by_key(2).unwrap().is_none(),
+        "index entry should be deleted too"
+    );
     assert!(t.get_by_key(4).unwrap().is_none());
     assert!(t.get_by_key(3).unwrap().is_some());
 
@@ -284,10 +361,7 @@ fn insert_rows_batch() {
     assert_eq!(t.scan().unwrap().len(), 20);
     assert_eq!(t.get_by_key(20).unwrap().unwrap()["name"], json!("u20"));
 
-    let dup = vec![
-        row(&[("id", json!(100))]),
-        row(&[("id", json!(100))]),
-    ];
+    let dup = vec![row(&[("id", json!(100))]), row(&[("id", json!(100))])];
     assert!(t.insert_rows(&dup).is_err());
 }
 
@@ -320,16 +394,23 @@ fn secondary_index_is_maintained() {
     )
     .unwrap();
     assert!(t.has_index("code"));
-    assert_eq!(t.get_by_column_key("code", 7002).unwrap().unwrap()["id"], json!(2));
+    assert_eq!(
+        t.get_by_column_key("code", 7002).unwrap().unwrap()["id"],
+        json!(2)
+    );
 
     t.insert_row(&row(&[("id", json!(3)), ("code", json!(7003))]))
         .unwrap();
-    assert_eq!(t.get_by_column_key("code", 7003).unwrap().unwrap()["id"], json!(3));
+    assert_eq!(
+        t.get_by_column_key("code", 7003).unwrap().unwrap()["id"],
+        json!(3)
+    );
 
     t.delete_by_keys(&[2]).unwrap();
     assert!(t.get_by_column_key("code", 7002).unwrap().is_none());
 
-    t.insert_row(&row(&[("id", json!(4)), ("code", json!(7001))])).unwrap();
+    t.insert_row(&row(&[("id", json!(4)), ("code", json!(7001))]))
+        .unwrap();
     let mut dup_ids: Vec<i64> = t
         .get_all_by_column_key("code", 7001)
         .unwrap()
@@ -339,7 +420,12 @@ fn secondary_index_is_maintained() {
     dup_ids.sort_unstable();
     assert_eq!(dup_ids, vec![1, 4], "duplicate index values keep both rows");
 
-    let mut t2 = HeapTable::open(dir.path().join("d.db"), DEFAULT_PAGE_SIZE, DEFAULT_POOL_SIZE).unwrap();
+    let mut t2 = HeapTable::open(
+        dir.path().join("d.db"),
+        DEFAULT_PAGE_SIZE,
+        DEFAULT_POOL_SIZE,
+    )
+    .unwrap();
     t2.insert_rows(&[
         row(&[("id", json!(1)), ("age", json!(30))]),
         row(&[("id", json!(2)), ("age", json!(30))]),
@@ -360,7 +446,6 @@ fn secondary_index_is_maintained() {
     );
 }
 
-
 /// 整表整理要收回删行留下的页内空洞
 #[test]
 fn compact_pages_reclaims_dead_space() {
@@ -370,7 +455,8 @@ fn compact_pages_reclaims_dead_space() {
 
     let pad = "x".repeat(200);
     for i in 0..10 {
-        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
+        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
+            .unwrap();
     }
     let pages = t.num_pages().unwrap();
 
@@ -395,7 +481,8 @@ fn deletes_compact_pages_so_space_is_reused() {
 
     let pad = "y".repeat(80);
     for i in 0..30 {
-        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
+        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
+            .unwrap();
     }
     assert_eq!(t.num_pages().unwrap(), 1, "30 行要先塞进一页");
 
@@ -404,7 +491,8 @@ fn deletes_compact_pages_so_space_is_reused() {
     t.delete_by_keys(&keys).unwrap();
 
     for i in 100..119 {
-        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
+        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
+            .unwrap();
     }
     assert_eq!(t.num_pages().unwrap(), 1, "删掉的空间要能被复用");
     assert_eq!(t.scan().unwrap().len(), 30);
@@ -416,11 +504,13 @@ fn compact_pages_keeps_index_positions_valid() {
     let dir = tempfile::tempdir().unwrap();
     let data = dir.path().join("t.db");
     let index = dir.path().join("t.idx");
-    let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    let mut t =
+        HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
 
     let pad = "z".repeat(80);
     for i in 0..30 {
-        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
+        t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
+            .unwrap();
     }
     let keys: Vec<i64> = (5..25).collect();
     t.delete_by_keys(&keys).unwrap();
@@ -428,9 +518,17 @@ fn compact_pages_keeps_index_positions_valid() {
 
     for i in [0, 1, 2, 3, 4, 25, 26, 27, 28, 29] {
         let found = t.get_by_column_key("id", i).unwrap();
-        assert_eq!(found.as_ref().map(|r| r["pad"].clone()), Some(json!(pad)), "整理后 id={} 仍要能点查", i);
+        assert_eq!(
+            found.as_ref().map(|r| r["pad"].clone()),
+            Some(json!(pad)),
+            "整理后 id={} 仍要能点查",
+            i
+        );
     }
     for i in 5..25 {
-        assert!(t.get_by_column_key("id", i).unwrap().is_none(), "删掉的行不该再查出来");
+        assert!(
+            t.get_by_column_key("id", i).unwrap().is_none(),
+            "删掉的行不该再查出来"
+        );
     }
 }

chusql-core/storage/tests/page_test.rs

@@ -142,3 +142,147 @@ fn dirty_page_flushed_on_drop() {
     let p = pf2.read_page(0).unwrap();
     assert_eq!(p.data[0], 42);
 }
+
+/// 已同步镜像恢复撕裂页且页 LSN 持久保留
+#[test]
+fn full_page_image_repairs_torn_write_before_read() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("torn.db");
+    let metadata = dir.path().join("torn.db.pages");
+    let journal = dir.path().join("torn.db.page-wal");
+    let mut file = PageFile::with_options(&path, 512, 1).unwrap();
+    file.set_lsn(7);
+    file.write_page(&Page::new(0, 512)).unwrap();
+    file.flush().unwrap();
+    let old_metadata = std::fs::read(&metadata).unwrap();
+    file.set_lsn(13);
+    let mut changed = Page::new(0, 512);
+    changed.data.fill(0x5a);
+    file.write_page(&changed).unwrap();
+    file.append_page().unwrap(); // 淘汰页零前镜像已同步
+    let image = std::fs::read(&journal).unwrap();
+    assert!(!image.is_empty());
+    drop(file);
+    std::fs::write(&metadata, old_metadata).unwrap();
+    std::fs::write(&journal, &image).unwrap();
+    std::fs::write(&path, [0x11; 213]).unwrap();
+    let mut reopened = PageFile::open(&path, 512).unwrap();
+    assert_eq!(reopened.read_page(0).unwrap().data, changed.data);
+    assert_eq!(reopened.page_lsn(0), Some(13));
+    drop(reopened);
+    assert_eq!(std::fs::metadata(&journal).unwrap().len(), 0);
+    let mut reopened = PageFile::open(&path, 512).unwrap();
+    assert_eq!(reopened.read_page(0).unwrap().data, changed.data);
+    assert_eq!(reopened.page_lsn(0), Some(13));
+}
+
+/// 撕裂日志尾不发布，完整损坏帧明确拒绝
+#[test]
+fn page_image_tail_and_corruption_are_distinguished() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("tail.db");
+    let metadata = dir.path().join("tail.db.pages");
+    let journal = dir.path().join("tail.db.page-wal");
+    let mut file = PageFile::with_options(&path, 512, 1).unwrap();
+    file.write_page(&Page::new(0, 512)).unwrap();
+    file.flush().unwrap();
+    let old_metadata = std::fs::read(&metadata).unwrap();
+    let old_data = std::fs::read(&path).unwrap();
+    file.set_lsn(20);
+    let mut changed = Page::new(0, 512);
+    changed.data.fill(9);
+    file.write_page(&changed).unwrap();
+    file.append_page().unwrap();
+    let image = std::fs::read(&journal).unwrap();
+    drop(file);
+    for end in [1, 39, image.len() - 1] {
+        std::fs::write(&metadata, &old_metadata).unwrap();
+        std::fs::write(&path, &old_data).unwrap();
+        std::fs::write(&journal, &image[..end]).unwrap();
+        let mut reopened = PageFile::open(&path, 512).unwrap();
+        assert_eq!(reopened.read_page(0).unwrap().data, vec![0; 512]);
+    }
+    let mut corrupt = image;
+    corrupt[40] ^= 1;
+    std::fs::write(&metadata, &old_metadata).unwrap();
+    std::fs::write(&journal, &corrupt).unwrap();
+    assert!(
+        PageFile::open(&path, 512)
+            .unwrap_err()
+            .to_string()
+            .contains("checksum")
+    );
+    assert_eq!(std::fs::read(&journal).unwrap(), corrupt);
+}
+
+/// 截断标记阻止旧页重放后复活
+#[test]
+fn truncate_clears_page_versions_and_survives_reopen() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("reset.db");
+    let mut file = PageFile::open(&path, 512).unwrap();
+    file.set_lsn(5);
+    for _ in 0..3 {
+        file.append_page().unwrap();
+    }
+    file.flush().unwrap();
+    file.set_lsn(8);
+    file.truncate().unwrap();
+    file.append_page().unwrap();
+    file.flush().unwrap();
+    assert_eq!(file.page_lsn(0), Some(8));
+    assert_eq!(file.page_lsn(2), None);
+    drop(file);
+    let mut file = PageFile::open(&path, 512).unwrap();
+    assert_eq!(file.num_pages().unwrap(), 1);
+    assert_eq!(file.page_lsn(0), Some(8));
+    assert_eq!(file.page_lsn(2), None);
+}
+
+/// 镜像写入失败后禁止析构或重试绕过恢复
+#[test]
+fn page_journal_error_fences_further_flushes() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("fenced.db");
+    let journal = dir.path().join("fenced.db.page-wal");
+    std::fs::write(&path, [0; 512]).unwrap();
+    let mut file = PageFile::open(&path, 512).unwrap();
+    let mut page = Page::new(0, 512);
+    page.data.fill(7);
+    file.write_page(&page).unwrap();
+    std::fs::create_dir(&journal).unwrap();
+    assert!(file.flush().is_err());
+    std::fs::remove_dir(&journal).unwrap();
+    assert!(
+        file.flush()
+            .unwrap_err()
+            .to_string()
+            .contains("requires recovery")
+    );
+    drop(file);
+    let mut file = PageFile::open(&path, 512).unwrap();
+    assert_eq!(file.read_page(0).unwrap().data, vec![0; 512]);
+}
+
+/// 小缓存淘汰不会反复记录同一批未改页
+#[test]
+fn eviction_batches_images_without_pool_sized_write_amplification() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("bounded.db");
+    let journal = dir.path().join("bounded.db.page-wal");
+    let mut file = PageFile::with_options(&path, 512, 2).unwrap();
+    file.set_lsn(9);
+    for id in 0..100 {
+        let mut page = Page::new(id, 512);
+        page.data.fill(id as u8);
+        file.write_page(&page).unwrap();
+    }
+    assert!(std::fs::metadata(&journal).unwrap().len() <= 100 * (512 + 40));
+    file.flush().unwrap();
+    drop(file);
+    let mut file = PageFile::open(&path, 512).unwrap();
+    for id in 0..100 {
+        assert_eq!(file.read_page(id).unwrap().data, vec![id as u8; 512]);
+        assert_eq!(file.page_lsn(id), Some(9));
+    }
+}

chusql-core/storage/tests/wal_test.rs

@@ -1,5 +1,5 @@
 use chusql_core_storage::protocol::Row;
-use chusql_core_storage::wal::{committed_ops, records_after, Wal, WalOp};
+use chusql_core_storage::wal::{Wal, WalOp, committed_ops, records_after};
 use serde_json::json;
 
 // WAL 测试：追加、读取、清空、截断尾巴、LSN 与提交标记。
@@ -11,12 +11,32 @@ fn schema_versions_round_trip_and_legacy_hide_decodes() {
     let path = dir.path().join("wal.log");
     let wal = Wal::new(&path);
     let ops = [
-        WalOp::HideColumn { table: "t".into(), column: "name".into(), schema_version: Some(u64::MAX) },
-        WalOp::DropColumn { table: "t".into(), column: "name".into(), rows: vec![], schema_version: Some(3) },
-        WalOp::ReplaceSchema { table: "t".into(), columns: vec![], rows: vec![], schema_version: Some(4) },
+        WalOp::HideColumn {
+            table: "t".into(),
+            column: "name".into(),
+            schema_version: Some(u64::MAX),
+        },
+        WalOp::DropColumn {
+            table: "t".into(),
+            column: "name".into(),
+            rows: vec![],
+            schema_version: Some(3),
+        },
+        WalOp::ReplaceSchema {
+            table: "t".into(),
+            columns: vec![],
+            rows: vec![],
+            schema_version: Some(4),
+        },
     ];
     wal.append_group(&ops).unwrap();
-    assert_eq!(committed_ops(&wal.read_all().unwrap().records).into_iter().map(|(_, op)| op).collect::<Vec<_>>(), ops);
+    assert_eq!(
+        committed_ops(&wal.read_all().unwrap().records)
+            .into_iter()
+            .map(|(_, op)| op)
+            .collect::<Vec<_>>(),
+        ops
+    );
     drop(wal);
     let mut body = 1_u64.to_le_bytes().to_vec();
     body.push(8);
@@ -26,9 +46,14 @@ fn schema_versions_round_trip_and_legacy_hide_decodes() {
     let mut frame = (body.len() as u32).to_le_bytes().to_vec();
     frame.extend_from_slice(&body);
     std::fs::write(&path, frame).unwrap();
-    assert_eq!(Wal::new(&path).read().unwrap(), Some(WalOp::HideColumn {
-        table: "t".into(), column: "name".into(), schema_version: None,
-    }));
+    assert_eq!(
+        Wal::new(&path).read().unwrap(),
+        Some(WalOp::HideColumn {
+            table: "t".into(),
+            column: "name".into(),
+            schema_version: None,
+        })
+    );
 }
 
 /// 建表编号完整往返且兼容旧载荷
@@ -37,7 +62,11 @@ fn create_table_ids_round_trip_and_legacy_payloads_decode() {
     let dir = tempfile::tempdir().unwrap();
     let path = dir.path().join("wal.log");
     let wal = Wal::new(&path);
-    let op = WalOp::CreateTable { table: "t".into(), columns: vec![], object_id: Some(42) };
+    let op = WalOp::CreateTable {
+        table: "t".into(),
+        columns: vec![],
+        object_id: Some(42),
+    };
     wal.append(&op).unwrap();
     assert_eq!(wal.read_all().unwrap().records[0].1, op);
     drop(wal);
@@ -50,11 +79,16 @@ fn create_table_ids_round_trip_and_legacy_payloads_decode() {
     frame.extend_from_slice(&body);
     std::fs::write(&path, frame).unwrap();
     let wal = Wal::new(&path);
-    assert_eq!(wal.read_all().unwrap().records[0].1,
-        WalOp::CreateTable { table: "t".into(), columns: vec![], object_id: None });
+    assert_eq!(
+        wal.read_all().unwrap().records[0].1,
+        WalOp::CreateTable {
+            table: "t".into(),
+            columns: vec![],
+            object_id: None
+        }
+    );
 }
 
-
 /// 用键值对构造一行
 fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
     let mut m = Row::new();
@@ -167,7 +201,10 @@ fn every_record_gets_an_increasing_lsn() {
     let scan = wal.read_all().unwrap();
     let lsns: Vec<u64> = scan.records.iter().map(|(lsn, _)| *lsn).collect();
     assert_eq!(lsns, vec![1, 2, 3]);
-    assert_eq!(scan.good_len as u64, std::fs::metadata(&path).unwrap().len());
+    assert_eq!(
+        scan.good_len as u64,
+        std::fs::metadata(&path).unwrap().len()
+    );
 
     let reopened = Wal::new(&path);
     reopened
@@ -254,7 +291,10 @@ fn trailing_torn_frame_can_be_truncated() {
     assert!(scan.good_len < full.len() - 3);
 
     wal.truncate_to(scan.good_len).unwrap();
-    assert_eq!(std::fs::metadata(&path).unwrap().len(), scan.good_len as u64);
+    assert_eq!(
+        std::fs::metadata(&path).unwrap().len(),
+        scan.good_len as u64
+    );
     assert_eq!(wal.read_all().unwrap().records.len(), 1);
 }
 
@@ -360,9 +400,21 @@ fn lsn_continues_from_the_checkpoint() {
 #[test]
 fn records_after_keeps_only_the_tail() {
     let records = vec![
-        (1u64, WalOp::Insert { table: "t".into(), row: row(&[("id", json!(1))]) }),
+        (
+            1u64,
+            WalOp::Insert {
+                table: "t".into(),
+                row: row(&[("id", json!(1))]),
+            },
+        ),
         (2, WalOp::Commit),
-        (3, WalOp::Insert { table: "t".into(), row: row(&[("id", json!(2))]) }),
+        (
+            3,
+            WalOp::Insert {
+                table: "t".into(),
+                row: row(&[("id", json!(2))]),
+            },
+        ),
         (4, WalOp::Commit),
     ];
     let kept = records_after(&records, 2);
@@ -371,4 +423,3 @@ fn records_after_keeps_only_the_tail() {
     assert_eq!(records_after(&records, 4).len(), 0);
     assert_eq!(records_after(&records, 0).len(), 4);
 }
-

chusql-interface/src/ChuSQL/Interface/Actions.hs

@@ -32,13 +32,13 @@ module ChuSQL.Interface.Actions (
     revokeRoleSql,
 ) where
 
-import Control.Monad (zipWithM)
 import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
 import qualified ChuSQL.Core.Model as M
-import ChuSQL.Core.Runtime
 import ChuSQL.Core.Protocol (valueFromJSON)
-import Data.Aeson.Types (parseEither)
+import ChuSQL.Core.Runtime
+import Control.Monad (zipWithM)
 import qualified Data.Aeson as A
+import Data.Aeson.Types (parseEither)
 import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
 import Data.List (intercalate)
 import Data.Scientific (floatingOrInteger)
@@ -71,7 +71,7 @@ isIdentifier t =
             (c : cs) -> (isAsciiLower c || isAsciiUpper c || c == '_') && all restChar cs
             [] -> False
   where
-    -- | 标识符里其余字符的合法集
+    -- \| 标识符里其余字符的合法集
     restChar c = isAsciiLower c || isAsciiUpper c || isDigit c || c == '_'
 
 -- | 检查一个标识符，不合法就报错（带上"是表名还是列名"）
@@ -177,7 +177,7 @@ createTableSql spec = do
     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)
@@ -258,7 +258,7 @@ updateRowSql table key assigns = do
     sets <- mapM assignment cols
     pure ("UPDATE " ++ T.unpack tbl ++ " SET " ++ intercalate ", " sets ++ " WHERE id = " ++ show key)
   where
-    -- | 校验列名并编码赋值
+    -- \| 校验列名并编码赋值
     assignment (name, value) = do
         column <- checkIdent "column" (T.pack name)
         literal <- sqlLiteral value
@@ -286,7 +286,7 @@ whereClause filters = case filters of
         terms <- mapM term filters
         pure (" WHERE " ++ intercalate " AND " terms)
   where
-    -- | 一个等值条件
+    -- \| 一个等值条件
     term (column, value) = do
         col <- checkIdent "column" column
         literal <- sqlLiteral value
@@ -306,7 +306,7 @@ accountName name
     | 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)
 
 -- | 单引号字符串字面量
@@ -342,7 +342,7 @@ roleName name
     | not (T.all allowed name) = Left ("role 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)
 
 -- | 授权对象：`*`，或长度不超过 128 的裸表名/`库.表`
@@ -355,7 +355,7 @@ grantObject object
     | not (T.all allowed object) = Left ("object name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack object)
     | otherwise = Right object
   where
-    -- | 授权对象允许的字符集
+    -- \| 授权对象允许的字符集
     allowed c = isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("_.-" :: String)
 
 -- | 权限清单：词要纯字母，认不认由 server 定
@@ -364,7 +364,7 @@ privilegeWords privileges
     | null privileges = Left "at least one privilege is required"
     | otherwise = mapM word privileges
   where
-    -- | 单个权限词
+    -- \| 单个权限词
     word one
         | T.null one || not (T.all (\c -> isAsciiLower c || isAsciiUpper c) one) = Left ("not a privilege keyword: " ++ T.unpack one)
         | otherwise = Right one
@@ -388,11 +388,16 @@ grantPrivilegesSql privileges object role withOption = do
     target <- grantObject object
     who <- roleName role
     pure
-        ( "GRANT " ++ T.unpack (T.intercalate ", " words') ++ " ON " ++ T.unpack target
-            ++ " TO " ++ T.unpack who ++ tailText
+        ( "GRANT "
+            ++ T.unpack (T.intercalate ", " words')
+            ++ " ON "
+            ++ T.unpack target
+            ++ " TO "
+            ++ T.unpack who
+            ++ tailText
         )
   where
-    -- | 转授权后缀
+    -- \| 转授权后缀
     tailText
         | withOption = " WITH GRANT OPTION"
         | otherwise = ""

chusql-interface/src/ChuSQL/Interface/Auth.hs

@@ -34,9 +34,9 @@ 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 qualified Data.ByteString as BS
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (isJust)

chusql-interface/src/ChuSQL/Interface/Config.hs

@@ -79,7 +79,7 @@ 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)
 
 -- | 设置键别名：非权威写法到权威写法（多数写连字符）
@@ -171,7 +171,7 @@ staticDirCandidates given =
 resolveStaticDir :: FilePath -> IO (Maybe FilePath)
 resolveStaticDir given = go (staticDirCandidates given)
   where
-    -- | 逐个试
+    -- \| 逐个试
     go [] = pure Nothing
     go (d : ds) = do
         ok <- doesDirectoryExist d
@@ -195,11 +195,12 @@ defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000 ""
 loadServerConfigAt :: FilePath -> IO ServerConfig
 loadServerConfigAt path = do
     values <- readSection path "server"
-    let -- | 取一个键的非空字符串值
+    let
+        -- \| 取一个键的非空字符串值
         textOf key fallback = case Map.lookup key values of
             Just value | not (T.null (T.strip value)) -> T.unpack (T.strip value)
             _ -> fallback
-        -- | 取一个键的整数值
+        -- \| 取一个键的整数值
         intOf key fallback = fromMaybe fallback (Map.lookup key values >>= readMaybe . T.unpack . T.strip)
     pure
         defaultServerConfig

chusql-interface/src/ChuSQL/Interface/Link.hs

@@ -17,10 +17,8 @@ module ChuSQL.Interface.Link (
     clientReloadPolicy,
 ) where
 
-import ChuSQL.Interface.Normalization (NormalizationRequest)
-import qualified Data.Aeson as A
-import ChuSQL.Interface.Sudo (SudoCredential, sudoProof, isLocalPeer)
 import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo (..))
+import ChuSQL.Interface.Normalization (NormalizationRequest)
 import ChuSQL.Interface.Protocol (
     ClientRequest (..),
     RoleView,
@@ -29,11 +27,13 @@ import ChuSQL.Interface.Protocol (
     encodeRequest,
     protocolVersion,
  )
+import ChuSQL.Interface.Sudo (SudoCredential, isLocalPeer, sudoProof)
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Control.Exception (IOException, try)
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Char8 as BLC
-import qualified Data.ByteString.Char8 as BSC
 import Data.Text (Text)
 import qualified Data.Text as T
 import Network.Socket (
@@ -75,7 +75,8 @@ connectClient host port = do
                 Right (RespHello version)
                     | version == protocolVersion -> pure (Right client)
                     | otherwise ->
-                        giveUp handle
+                        giveUp
+                            handle
                             ( "server "
                                 <> T.pack (address host port)
                                 <> " speaks protocol "
@@ -87,7 +88,7 @@ connectClient host port = do
                 Right _ -> giveUp handle "unexpected response to hello"
                 Left message -> giveUp handle message
   where
-    -- | 对不上就关连接并回错误
+    -- \| 对不上就关连接并回错误
     giveUp handle message = do
         _ <- try (hClose handle) :: IO (Either IOException ())
         pure (Left message)

chusql-interface/src/ChuSQL/Interface/Normalization.hs

@@ -4,7 +4,7 @@ module ChuSQL.Interface.Normalization where
 
 import ChuSQL.Core.Protocol (SchemaColumn)
 import Control.Monad (unless, when)
-import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.!=), (.=))
+import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), (.=))
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as K
 import qualified Data.Aeson.KeyMap as KM
@@ -13,25 +13,32 @@ import qualified Data.ByteString.Lazy as BL
 import Data.Char (isAlpha, isAlphaNum, isDigit, isHexDigit, isSpace)
 import Data.List (nub)
 import Data.Scientific (base10Exponent, toBoundedInteger)
-import Data.Word (Word64)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
+import Data.Word (Word64)
 import Text.ParserCombinators.ReadP
 
 -- 范式入口的版本化声明、对象身份与严格 JSON 校验。
 
 data NormalizationDependency = NormalizationDependency [String] [String] deriving (Eq, Show)
 data NormalizationDeclaration = NormalizationDeclaration
-    { ndKeys :: [[String]], ndDependencies :: [NormalizationDependency]
-    , ndComplete :: Bool, ndAtomic :: Maybe Bool
-    } deriving (Eq, Show)
+    { ndKeys :: [[String]]
+    , ndDependencies :: [NormalizationDependency]
+    , ndComplete :: Bool
+    , ndAtomic :: Maybe Bool
+    }
+    deriving (Eq, Show)
 data ObjectIdentity = ObjectIdentity Integer Integer deriving (Eq, Show)
 data NormalizationRequest = NormalizationRequest
-    { nrVersion :: Int, nrDatabase :: Text, nrTable :: Text
+    { nrVersion :: Int
+    , nrDatabase :: Text
+    , nrTable :: Text
     , nrDeclaration :: NormalizationDeclaration
-    , nrExpectedObject :: Maybe ObjectIdentity, nrExpectedSchema :: Maybe Text
-    } deriving (Eq, Show)
+    , nrExpectedObject :: Maybe ObjectIdentity
+    , nrExpectedSchema :: Maybe Text
+    }
+    deriving (Eq, Show)
 
 -- 拒绝对象中未定义的字段。
 onlyFields :: [Text] -> A.Object -> AT.Parser ()
@@ -58,8 +65,13 @@ instance FromJSON NormalizationDeclaration where
         NormalizationDeclaration keys deps <$> o .:? "dependencies_complete" .!= False <*> o .:? "atomic_attributes"
 instance ToJSON NormalizationDeclaration where
     -- 编码全部声明标志。
-    toJSON d = object ["declared_keys" .= ndKeys d, "dependencies" .= ndDependencies d,
-        "dependencies_complete" .= ndComplete d, "atomic_attributes" .= ndAtomic d]
+    toJSON d =
+        object
+            [ "declared_keys" .= ndKeys d
+            , "dependencies" .= ndDependencies d
+            , "dependencies_complete" .= ndComplete d
+            , "atomic_attributes" .= ndAtomic d
+            ]
 instance FromJSON ObjectIdentity where
     -- 校验稳定对象的正整数编号。
     parseJSON = withObject "object identity" $ \o -> do
@@ -68,6 +80,7 @@ instance FromJSON ObjectIdentity where
         table <- o .: "object_id" >>= identityNumber
         when (db <= 0 || table <= 0) (fail "normalization: invalid object identity")
         pure (ObjectIdentity db table)
+
 -- 兼容目录数值并保留浏览器中的完整编号。
 identityNumber :: A.Value -> AT.Parser Integer
 identityNumber (A.String text)
@@ -90,13 +103,21 @@ instance FromJSON NormalizationRequest where
         when (version /= (1 :: Int)) (fail "normalization: unsupported api_version")
         db <- o .: "database"
         table <- o .: "table"
-        unless (plainName db && case T.splitOn "." table of [name] -> plainName name; [scope, name] -> scope == db && plainName name; _ -> False)
+        unless
+            (plainName db && case T.splitOn "." table of [name] -> plainName name; [scope, name] -> scope == db && plainName name; _ -> False)
             (fail "normalization: invalid or cross-database table name")
         NormalizationRequest version db table <$> o .: "declaration" <*> o .:? "expected_object" <*> o .:? "expected_schema_fingerprint"
 instance ToJSON NormalizationRequest where
     -- 编码专用分析请求。
-    toJSON r = object ["api_version" .= nrVersion r, "database" .= nrDatabase r, "table" .= nrTable r,
-        "declaration" .= nrDeclaration r, "expected_object" .= nrExpectedObject r, "expected_schema_fingerprint" .= nrExpectedSchema r]
+    toJSON r =
+        object
+            [ "api_version" .= nrVersion r
+            , "database" .= nrDatabase r
+            , "table" .= nrTable r
+            , "declaration" .= nrDeclaration r
+            , "expected_object" .= nrExpectedObject r
+            , "expected_schema_fingerprint" .= nrExpectedSchema r
+            ]
 
 -- 校验与 SQL 一致的裸标识符。
 plainName :: Text -> Bool
@@ -157,10 +178,12 @@ jsonString = do
     -- 保留 JSON 字符串转义。
     piece = ((\c -> ['\\', c]) <$> (char '\\' *> get)) <++ munch1 (\c -> c /= '"' && c /= '\\')
 
-
 -- 拒绝缺字段或未知标签的线上报告。
 parseNormalizationReport :: A.Value -> AT.Parser A.Value
-parseNormalizationReport value = withObject "normalization report" (\o -> do
+parseNormalizationReport value =
+    withObject
+        "normalization report"
+        ( \o -> do
             version <- o .: "api_version"
             conditional <- o .: "conditional"
             unless (version == (1 :: Int) && conditional) (fail "normalization: invalid report version or condition")
@@ -176,7 +199,9 @@ parseNormalizationReport value = withObject "normalization report" (\o -> do
             unless (forms == (["1nf", "2nf", "3nf", "bcnf"] :: [Text])) (fail "normalization: invalid findings")
             _ <- (o .: "suggestions" :: AT.Parser [A.Value])
             _ <- (o .: "condition" :: AT.Parser Text)
-    pure value) value
+            pure value
+        )
+        value
   where
     -- 核对每项结论与证据的稳定形状。
     parseFinding = withObject "normalization finding" $ \o -> do

chusql-interface/src/ChuSQL/Interface/Policy.hs

@@ -33,10 +33,12 @@ passwordKeys = ["password-min-length", "password-classes"]
 
 -- | 策略值：缺项或空值回落到内置默认
 policyFromValues :: PasswordPolicy -> Map.Map Text Text -> PasswordPolicy
-policyFromValues before values = PasswordPolicy
-    (number "password-min-length" (ppMinLength before)) (number "password-classes" (ppClasses before))
+policyFromValues before values =
+    PasswordPolicy
+        (number "password-min-length" (ppMinLength before))
+        (number "password-classes" (ppClasses before))
   where
-    -- | 取一个键的数值，缺项或空值回落到给定默认
+    -- \| 取一个键的数值，缺项或空值回落到给定默认
     number key fallback = case Map.lookup key values of
         Nothing -> fallback
         Just value -> fromMaybe fallback (readMaybe (T.unpack (if T.null value then defaultOf key else value)))

chusql-interface/src/ChuSQL/Interface/Protocol.hs

@@ -13,13 +13,13 @@ module ChuSQL.Interface.Protocol (
     RoleView (..),
 ) where
 
-import ChuSQL.Interface.Normalization
-import Data.Aeson.Types (parseEither)
 import ChuSQL.Core.Protocol (Account (..), QueryResult (..), TableInfo (..), queryResultJson)
-import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.:?), (.!=), (.=))
+import ChuSQL.Interface.Normalization
+import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.!=), (.:), (.:?), (.=))
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as AK
 import qualified Data.Aeson.KeyMap as KM
+import Data.Aeson.Types (parseEither)
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as BL
 import Data.Maybe (fromMaybe)
@@ -233,7 +233,7 @@ decodeResponse raw = case A.eitherDecode raw of
         _ -> Left "response is missing status"
     Right _ -> Left "response is not a JSON object"
   where
-    -- | 按 status 字段分派
+    -- \| 按 status 字段分派
     decodeStatus status fields = case status of
         "hello" -> Right (RespHello (intOf "protocol" fields))
         "ok" -> Right (RespLogin (textOf "user" fields) (boolOf "admin" fields))
@@ -257,23 +257,23 @@ decodeResponse raw = case A.eitherDecode raw of
         "policy" -> Right (RespPolicy (intOf "minLength" fields) (intOf "classes" fields))
         other -> Left ("unexpected status: " <> other)
 
-    -- | 取一个字段解成目标类型
-    fromField :: A.FromJSON a => Text -> (a -> ServerResponse) -> A.Object -> Either Text ServerResponse
+    -- \| 取一个字段解成目标类型
+    fromField :: (A.FromJSON a) => Text -> (a -> ServerResponse) -> A.Object -> Either Text ServerResponse
     fromField key wrap fields = case A.fromJSON (fromMaybe A.Null (KM.lookup (AK.fromText key) fields)) of
         A.Success value -> Right (wrap value)
         A.Error message -> Left (T.pack message)
 
-    -- | 取一个整数字段
+    -- \| 取一个整数字段
     intOf key fields = case KM.lookup key fields of
         Just (A.Number number) -> truncate number
         _ -> 0
 
-    -- | 取一个文本字段
+    -- \| 取一个文本字段
     textOf key fields = case KM.lookup key fields of
         Just (A.String text) -> text
         _ -> ""
 
-    -- | 取一个布尔字段
+    -- \| 取一个布尔字段
     boolOf key fields = case KM.lookup key fields of
         Just (A.Bool flag) -> flag
         _ -> False

chusql-interface/src/ChuSQL/Interface/Session.hs

@@ -17,24 +17,24 @@ module ChuSQL.Interface.Session (
     accounts,
 ) where
 
-import Data.Foldable (for_)
-import ChuSQL.Interface.Normalization
-import qualified Data.Aeson as A
 import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo)
 import ChuSQL.Interface.Link (
     Client,
-    clientNormalization,
     clientAccounts,
     clientCatalog,
     clientDatabases,
     clientLogin,
-    clientSudoLogin,
+    clientNormalization,
     clientQuery,
     clientRoles,
+    clientSudoLogin,
  )
-import ChuSQL.Interface.Sudo (SudoCredential)
+import ChuSQL.Interface.Normalization
 import ChuSQL.Interface.Protocol (RoleView)
+import ChuSQL.Interface.Sudo (SudoCredential)
+import qualified Data.Aeson as A
 import Data.Char (isAlpha, isAlphaNum)
+import Data.Foldable (for_)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -94,7 +94,7 @@ switchDatabase session rawName
             Left message -> pure (Left message)
             Right _ -> pure (Right ())
   where
-    -- | 规范化后的库名
+    -- \| 规范化后的库名
     name = T.toLower (T.strip rawName)
 
 -- | 跑一条语句；结果集里带回的当前库口径跟着一起更新
@@ -105,7 +105,8 @@ runStatement session sql = do
         Left message -> pure (Left message)
         Right result -> do
             for_
-              (qrDatabase result) (writeIORef (ssCurrent session))
+                (qrDatabase result)
+                (writeIORef (ssCurrent session))
             pure (Right result)
 
 -- | 数据字典（\\dt 与 \\d 用）
@@ -128,5 +129,6 @@ accounts session = clientAccounts (ssClient session)
 analyzeNormalization :: Session -> NormalizationRequest -> IO (Either Text A.Value)
 analyzeNormalization session payload = do
     current <- sessionDatabase session
-    if current /= nrDatabase payload then pure (Left "bad_request: normalization database differs from the selected database")
+    if current /= nrDatabase payload
+        then pure (Left "bad_request: normalization database differs from the selected database")
         else clientNormalization (ssClient session) payload

chusql-interface/src/ChuSQL/Interface/Settings.hs

@@ -67,7 +67,7 @@ settingCatalogue =
     , owned "tcp-max-rows" "TCP rows per result" "network" "int" "1000" "server" "max_rows"
     ]
   where
-    -- | web 自己的键：分区写死 [web]
+    -- \| web 自己的键：分区写死 [web]
     item k l g kind def rootOnly restart =
         SettingItem
             { siKey = k
@@ -94,7 +94,7 @@ settingCatalogue =
             , siTomlKey = tomlKey
             }
 
-    -- | 换掉落盘用的键名：界面键与 TOML 键不同名时用
+    -- \| 换掉落盘用的键名：界面键与 TOML 键不同名时用
     withTomlKey key spec = spec{siTomlKey = key}
 
 -- | web 自己的分区名
@@ -130,7 +130,8 @@ isRestartRequired key = maybe False siRestart (findItem key)
 -- | 改完立刻生效的配置键
 liveKeys :: [Text]
 liveKeys =
-    [ "password-min-length", "password-classes"
+    [ "password-min-length"
+    , "password-classes"
     , "body-limit"
     , "session-idle"
     , "session-max"
@@ -146,7 +147,7 @@ liveKeys =
 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
@@ -163,7 +164,7 @@ readSettingsFile path = fmap Map.unions (mapM readSectionOf catalogueSections)
 writeSettingsFile :: FilePath -> Map.Map Text Text -> IO (Either String ())
 writeSettingsFile path values = writeSections catalogueSections
   where
-    -- | 各分区依次写回
+    -- \| 各分区依次写回
     writeSections [] = pure (Right ())
     writeSections (section : rest) = do
         let entries =
@@ -185,7 +186,7 @@ writeSettingsFile path values = writeSections catalogueSections
 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
@@ -234,8 +235,8 @@ effectiveSettings cfg =
         , ("log-files", T.pack (wcLogFiles cfg))
         ]
   where
-    -- | 数值转文本
+    -- \| 数值转文本
     tshow = T.pack . show
-    -- | 布尔转 "1"/"0"
+    -- \| 布尔转 "1"/"0"
     boolText True = "1"
     boolText False = "0"

chusql-interface/src/ChuSQL/Interface/Sudo.hs

@@ -2,9 +2,17 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module ChuSQL.Interface.Sudo (
-    SudoCredential, createSudoCredential, removeSudoCredential,
-    readSudoCredential, sudoProof, verifySudoProof, sudoChallenge, sudoPrivileged,
-    newSudoCredential, isLocalPeer, validSudoChallenge,
+    SudoCredential,
+    createSudoCredential,
+    removeSudoCredential,
+    readSudoCredential,
+    sudoProof,
+    verifySudoProof,
+    sudoChallenge,
+    sudoPrivileged,
+    newSudoCredential,
+    isLocalPeer,
+    validSudoChallenge,
 ) where
 
 import Crypto.Hash (SHA256)
@@ -21,7 +29,7 @@ import Data.Time.Clock (UTCTime, diffUTCTime)
 import Foreign.C.String (CString)
 import Foreign.C.Types (CInt (..))
 import Foreign.Marshal.Alloc (allocaBytes)
-import Network.Socket (SockAddr (..), hostAddressToTuple, hostAddress6ToTuple)
+import Network.Socket (SockAddr (..), hostAddress6ToTuple, hostAddressToTuple)
 
 -- 用系统保护凭据与一次性挑战验证本机提升身份。
 
@@ -33,10 +41,13 @@ instance Show SudoCredential where
 
 -- 检查当前进程的操作系统提升身份。
 foreign import ccall unsafe "chusql_sudo_privileged" nativePrivileged :: IO CInt
+
 -- 创建操作系统保护的本机凭据。
 foreign import ccall safe "chusql_sudo_create" nativeCreate :: CInt -> CString -> IO CInt
+
 -- 读取操作系统保护的本机凭据。
 foreign import ccall safe "chusql_sudo_read" nativeRead :: CInt -> CString -> IO CInt
+
 -- 清理本次服务启动的凭据。
 foreign import ccall safe "chusql_sudo_remove" nativeRemove :: CInt -> IO CInt
 
@@ -53,7 +64,8 @@ createSudoCredential :: Int -> IO SudoCredential
 createSudoCredential port = do
     credential@(SudoCredential secret) <- newSudoCredential
     status <- BS.useAsCString secret (nativeCreate (fromIntegral port))
-    if status == 0 then pure credential
+    if status == 0
+        then pure credential
         else ioError (userError (T.unpack (nativeError "create" status)))
 
 -- 生成独立服务实例的随机凭据。
@@ -72,7 +84,9 @@ isLocalPeer _ = False
 -- 校验挑战有效期及其账号绑定证明。
 validSudoChallenge :: SudoCredential -> UTCTime -> Maybe (Text, UTCTime) -> Text -> Text -> Bool
 validSudoChallenge credential now challenge user proof = case challenge of
-    Just (nonce, issued) -> diffUTCTime now issued >= 0 && diffUTCTime now issued <= 60
+    Just (nonce, issued) ->
+        diffUTCTime now issued >= 0
+            && diffUTCTime now issued <= 60
             && verifySudoProof credential nonce user proof
     Nothing -> False
 
@@ -86,10 +100,14 @@ removeSudoCredential port = do
 readSudoCredential :: Int -> IO (Either Text SudoCredential)
 readSudoCredential port = allocaBytes 64 $ \buffer -> do
     status <- nativeRead (fromIntegral port) buffer
-    if status /= 0 then pure (Left (nativeError "read" status)) else do
+    if status /= 0
+        then pure (Left (nativeError "read" status))
+        else do
             secret <- BS.packCStringLen (buffer, 64)
-        pure $ if BS.all (isHexDigit . toEnum . fromIntegral) secret
-            then Right (SudoCredential secret) else Left "invalid sudo credential"
+            pure $
+                if BS.all (isHexDigit . toEnum . fromIntegral) secret
+                    then Right (SudoCredential secret)
+                    else Left "invalid sudo credential"
 
 -- 计算绑定挑战与目标账号的认证证明。
 sudoProof :: SudoCredential -> Text -> Text -> Text
@@ -99,10 +117,15 @@ sudoProof (SudoCredential secret) challenge user = TE.decodeUtf8 (convertToBase
 
 -- 按固定长度常量时间比对认证证明。
 verifySudoProof :: SudoCredential -> Text -> Text -> Text -> Bool
-verifySudoProof credential challenge user proof = T.length proof == 64
+verifySudoProof credential challenge user proof =
+    T.length proof == 64
         && BA.constEq (TE.encodeUtf8 (sudoProof credential challenge user)) (TE.encodeUtf8 proof)
 
 -- 将原生错误转换为明确诊断。
 nativeError :: Text -> CInt -> Text
-nativeError operation status = "sudo credential " <> operation <> " failed (OS error "
-    <> T.pack (show status) <> "); requires root or an elevated administrator; stale credential directories must be removed after stopping the server"
+nativeError operation status =
+    "sudo credential "
+        <> operation
+        <> " failed (OS error "
+        <> T.pack (show status)
+        <> "); requires root or an elevated administrator; stale credential directories must be removed after stopping the server"

chusql-interface/src/ChuSQL/Interface/TOML.hs

@@ -1,16 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Interface.TOML
-    ( readSection
-    , writeSection
-    , defaultConfigFile
-    , resolveConfigPath
-    ) where
+module ChuSQL.Interface.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.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -36,15 +36,18 @@ writeSection path section values = do
     prepared <- prepareDirectory
     case prepared of
         Left err -> pure (Left err)
-        Right () -> do exists <- doesFileExist path
-                       raw <- if exists then
+        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))
             tryWrite (TE.encodeUtf8 updated)
   where
-    -- | 目录不存在就先建
+    -- \| 目录不存在就先建
     prepareDirectory = do
         let dir = takeDirectory path
         if null dir
@@ -52,7 +55,7 @@ writeSection path section values = do
             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)
@@ -61,7 +64,7 @@ writeSection path section values = do
 sectionEntries :: Text -> [Text] -> [(Text, Text)]
 sectionEntries wanted = go ""
   where
-    -- | 走到目标分区后收键值对
+    -- \| 走到目标分区后收键值对
     go _ [] = []
     go current (line : rest)
         | Just name <- sectionName line = go name rest
@@ -92,7 +95,7 @@ assignment line = case T.breakOn "=" (stripComment line) of
 stripComment :: Text -> Text
 stripComment = T.pack . go False . T.unpack
   where
-    -- | 引号外遇到 # 就到此为止
+    -- \| 引号外遇到 # 就到此为止
     go _ [] = []
     go inString ('#' : rest)
         | not inString = []
@@ -111,11 +114,11 @@ unquote value
 rewrite :: Text -> Map Text Text -> [Text] -> [Text]
 rewrite section values = addMissing . replaceInSection . dropEmpties
   where
-    -- | 删掉空值的键
+    -- \| 删掉空值的键
     dropEmpties = filter (maybe True (not . T.null . snd) . assignment)
-    -- | 在目标分区里就地换行
+    -- \| 在目标分区里就地换行
     replaceInSection = go ""
-    -- | 走到目标分区后逐行替换
+    -- \| 走到目标分区后逐行替换
     go _ [] = []
     go current (line : rest)
         | Just name <- sectionName line = line : go name rest
@@ -123,7 +126,7 @@ rewrite section values = addMissing . replaceInSection . dropEmpties
         | 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)]
@@ -139,14 +142,14 @@ 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
@@ -160,7 +163,8 @@ appendSection :: Text -> [(Text, Text)] -> [Text] -> [Text]
 appendSection section entries lines' =
     lines'
         ++ (["" | null lines' || not (T.null (last lines'))])
-        ++ ("[" <> section <> "]") : [assignmentLine key value | (key, value) <- entries]
+        ++ ("[" <> section <> "]")
+        : [assignmentLine key value | (key, value) <- entries]
 
 -- | 全局配置文件的固定路径，跟随系统惯例
 defaultConfigFile :: IO FilePath

chusql-server/app/Main.hs

@@ -2,7 +2,6 @@
 
 module Main (main) where
 
-import Control.Monad (when)
 import ChuSQL.Core.Engine.Storage.FFI (storageVersion)
 import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, setStorageLink)
 import ChuSQL.Interface.Config (
@@ -23,7 +22,8 @@ import ChuSQL.Server.TCP (
     newServerEnv,
     runServer,
  )
-import Control.Exception (IOException, try, bracket_)
+import Control.Exception (IOException, bracket_, try)
+import Control.Monad (when)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.KeyMap as KM
 import Data.Text (Text)
@@ -64,7 +64,7 @@ emptyOptions =
 parseArgs :: [String] -> Either String Options
 parseArgs = go emptyOptions
   where
-    -- | 逐条消费参数列表
+    -- \| 逐条消费参数列表
     go opts [] = Right opts
     go opts ("--help" : rest) = go opts{optHelp = True} rest
     go opts ("-h" : rest) = go opts{optHelp = True} rest
@@ -76,7 +76,7 @@ parseArgs = go emptyOptions
     go opts ("--max-rows" : v : rest) = withInt "--max-rows" v (\n -> go opts{optMaxRows = Just n} 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)
 
@@ -179,7 +179,9 @@ run opts = do
             env <- newServerEnv backend rootName configPath config limiter
             let announce port = putStrLn ("listening:    tcp://" ++ scHost config ++ ":" ++ show port)
             bracket_
-              (pure link) closeConnection (serve env announce)
+                (pure link)
+                closeConnection
+                (serve env announce)
 
 -- | 起 TCP 服务并处理绑定失败
 serve :: ServerEnv -> (Int -> IO ()) -> IO ()
@@ -205,7 +207,7 @@ checkInitialized backend = do
             putStrLn "!! For a damaged existing system catalog, stop all processes and try csql-bootstrap repair or recover."
             exitFailure
   where
-    -- | 应答里的 initialized 是不是 true
+    -- \| 应答里的 initialized 是不是 true
     statusInitialized (A.Object fields) = KM.lookup "initialized" fields == Just (A.Bool True)
     statusInitialized _ = False
 
@@ -213,14 +215,16 @@ checkInitialized backend = do
 reportCredential :: Backend -> Text -> Bool -> IO ()
 reportCredential backend rootName legacy = do
     putStrLn ("administrator: " ++ T.unpack rootName)
-    when legacy
-      $ do putStrLn
+    when legacy $
+        do
+            putStrLn
                 "  !! the [web] section still carries a plaintext password key; it is ignored now"
             putStrLn
                 "  !! remove it: the administrator password lives in the __system_users system table"
     passwordless <- administratorPasswordless backend rootName
-    when passwordless
-      $ do putStrLn
+    when passwordless $
+        do
+            putStrLn
                 "  !! the administrator has no password yet: sign in with an empty password, then set one"
             putStrLn
                 "  !!   ALTER USER root IDENTIFIED BY '...'   (or use the account page in the Web UI)"

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

@@ -1,11 +1,29 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module ChuSQL.Server.Accounts (
-    Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
-    newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
-    ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot, principalIsCatalogManager,
-    authenticate, authenticateSudo, currentPrincipal,
-    listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
+    Accounts,
+    AccountError (..),
+    Principal (..),
+    PasswordPolicy (..),
+    defaultPasswordPolicy,
+    newAccounts,
+    accountsPolicy,
+    setAccountsPolicy,
+    passwordAllowed,
+    ensureRootAccount,
+    administratorPasswordless,
+    rootUserName,
+    principalName,
+    principalIsRoot,
+    principalIsCatalogManager,
+    authenticate,
+    authenticateSudo,
+    currentPrincipal,
+    listAccounts,
+    findAccount,
+    AccountCommand (..),
+    accountCommand,
+    runAccountCommand,
 ) where
 
 import ChuSQL.Core.Engine.Error (accountErrorCode)
@@ -32,7 +50,7 @@ data Principal
     deriving (Eq)
 
 instance Show Principal where
-    -- | 身份的可读形式
+    -- \| 身份的可读形式
     show (Root name) = "root " ++ show name
     show (Ordinary a) = "account " ++ show (accountUser a)
 
@@ -48,7 +66,8 @@ principalIsRoot (Ordinary a) = accountIsSuperuser a && accountEnabled a && accou
 
 -- | 判断身份是否可管理系统目录
 principalIsCatalogManager :: Principal -> Bool
-principalIsCatalogManager principal = principalIsRoot principal || case principal of
+principalIsCatalogManager principal =
+    principalIsRoot principal || case principal of
         Ordinary a -> accountSystemCatalogManager a && accountEnabled a && accountCanLogin a
         Root _ -> True
 
@@ -94,12 +113,13 @@ passwordAllowed policy password
     | classes < ppClasses policy = bad "password needs more character classes"
     | otherwise = Right ()
   where
-    -- | 构造一条请求错误
+    -- \| 构造一条请求错误
     bad = Left . AccountError "bad_request"
-    -- | 命中的字符类别数
+    -- \| 命中的字符类别数
     classes =
         length
-            ( filter id
+            ( filter
+                id
                 [ T.any isAsciiLower password
                 , T.any isAsciiUpper password
                 , T.any isDigit password
@@ -114,7 +134,7 @@ validateUserName name
         Left (AccountError "bad_request" "invalid account name")
     | otherwise = Right ()
   where
-    -- | 该字符是否允许使用
+    -- \| 该字符是否允许使用
     allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
 
 -- | 校验新身份的名称
@@ -132,7 +152,7 @@ storageResult :: Either String [Account] -> Either AccountError ()
 storageResult (Right _) = Right ()
 storageResult (Left message) = Left (AccountError code text)
   where
-    -- | 认得的码原样用，其余存储细节不外泄
+    -- \| 认得的码原样用，其余存储细节不外泄
     code = T.pack (accountErrorCode message)
     text = if code == failureCode then failureText else T.pack message
     AccountError failureCode failureText = storageFailure
@@ -200,18 +220,18 @@ authenticate service user password = withMVar (acLock service) $ \_ -> do
   where
     name = normalize user
     ordinaryRefused = AccountError "forbidden" "this server only accepts the administrator"
-    -- | 判断是否有已设置口令的登录管理员
+    -- \| 判断是否有已设置口令的登录管理员
     unset accounts = not (any (\a -> accountIsSuperuser a && accountEnabled a && accountCanLogin a && not (T.null (accountHash a))) accounts)
-    -- | 管理员登录
+    -- \| 管理员登录
     signInRoot accounts = case filter ((== name) . accountUser) accounts of
         [a] | T.null (accountHash a) && T.null password -> issue a
         [a] | accountCanLogin a && accountEnabled a && not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
         _ -> pure (Left unauthorized)
-    -- | 普通账号登录
+    -- \| 普通账号登录
     signInOrdinary accounts = case filter ((== name) . accountUser) accounts of
         [a] | accountCanLogin a && accountEnabled a && not (T.null (accountHash a)) && verifyPassword (accountHash a) password -> issue a
         _ -> pure (Left unauthorized)
-    -- | 记一次登录再发会话
+    -- \| 记一次登录再发会话
     issue a = do
         stamp <- currentStamp
         written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp))
@@ -302,7 +322,7 @@ accountCommand _ = Nothing
 runAccountCommand :: Accounts -> Principal -> AccountCommand -> IO (Either AccountError ())
 runAccountCommand service principal command = withMVar (acLock service) $ const run
   where
-    -- | 校验并执行身份管理权限
+    -- \| 校验并执行身份管理权限
     run
         | not (principalIsCatalogManager principal) = pure (Left (AccountError "forbidden" "catalog manager required"))
         | not (principalIsRoot principal) = do
@@ -311,20 +331,21 @@ runAccountCommand service principal command = withMVar (acLock service) $ const
                 Left err -> pure (Left err)
                 Right accounts
                     | any (\a -> accountUser a == normalize (target command) && (accountIsSuperuser a || accountSystemCatalogManager a || accountAllowSudoAuth a)) accounts
-                        || privilegedChange command -> pure (Left (AccountError "forbidden" "superuser required to manage privileged identities"))
+                        || privilegedChange command ->
+                        pure (Left (AccountError "forbidden" "superuser required to manage privileged identities"))
                     | otherwise -> execute
         | otherwise = execute
-    -- | 获取身份管理的目标
+    -- \| 获取身份管理的目标
     target (CreateAccount name _) = name
     target (ResetAccountPassword name _) = name
     target (DropAccount name) = name
     target (AlterAccountAttributes name _) = name
-    -- | 判断是否修改特权属性
+    -- \| 判断是否修改特权属性
     privilegedChange (AlterAccountAttributes _ attributes) = any (\(key, _) -> key `elem` ["superuser", "system_catalog_manager", "allow_sudo_auth"]) attributes
     privilegedChange _ = False
-    -- | 执行已授权的身份命令
+    -- \| 执行已授权的身份命令
     execute = executeWith (if principalIsRoot principal then service else service{acBackend = (acBackend service){beAccounts = beAccounts (acBackend service) . ReqCatalogManage}})
-    -- | 通过受限存储请求执行管理操作
+    -- \| 通过受限存储请求执行管理操作
     executeWith managed = case command of
         CreateAccount name _ | normalize name == "public" -> pure (Left (AccountError "bad_request" "public is reserved for default privileges"))
         CreateAccount name password -> createUser managed name password
@@ -333,5 +354,14 @@ runAccountCommand service principal command = withMVar (acLock service) $ const
         AlterAccountAttributes name attributes
             | length (nub (map fst attributes)) /= length attributes -> pure (Left (AccountError "bad_request" "duplicate identity attribute"))
             | otherwise ->
-                storageResult <$> beAccounts (acBackend managed) (ReqIdentityAlter (normalize name)
-                    (lookup "login" attributes) (lookup "superuser" attributes) (lookup "enabled" attributes) (lookup "system_catalog_manager" attributes) (lookup "allow_sudo_auth" attributes))
+                storageResult
+                    <$> beAccounts
+                        (acBackend managed)
+                        ( ReqIdentityAlter
+                            (normalize name)
+                            (lookup "login" attributes)
+                            (lookup "superuser" attributes)
+                            (lookup "enabled" attributes)
+                            (lookup "system_catalog_manager" attributes)
+                            (lookup "allow_sudo_auth" attributes)
+                        )

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

@@ -1,8 +1,10 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 module ChuSQL.Server.Backend (
     StatementResult (..),
     Backend (..),
+    applyTransactionMemory,
     columnsFromStatement,
     currentStamp,
     exprTables,
@@ -21,11 +23,9 @@ module ChuSQL.Server.Backend (
     tableRefsOf,
 ) where
 
-import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
 import ChuSQL.Core.Engine (runStatement, runStatementM)
-import ChuSQL.Core.Model
 import ChuSQL.Core.Engine.Semantic (prepare)
-import ChuSQL.Core.Engine.Storage (MonadStorage (schema, snapshot))
+import ChuSQL.Core.Engine.Storage (MonadStorage (schema))
 import ChuSQL.Core.Engine.Storage.IPC (
     Account (..),
     Env,
@@ -34,22 +34,27 @@ import ChuSQL.Core.Engine.Storage.IPC (
     Response (..),
     SchemaColumn (..),
     TableInfo (..),
+    databaseSnapshot,
     envForDatabase,
     sendRawRequest,
     sendRequest,
+    snapshotDatabase,
  )
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
+import ChuSQL.Core.Model
 import ChuSQL.Core.Protocol (TxnOp (..))
-import Control.Concurrent.MVar (MVar, modifyMVar)
-import Data.List (nub, isPrefixOf)
-import Data.Text (Text)
-import Data.Time (getCurrentTime)
-import Data.Time.Format (defaultTimeLocale, formatTime)
+import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.List (isPrefixOf, nub)
+import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
+import qualified Data.Set as Set
+import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Time (getCurrentTime)
+import Data.Time.Format (defaultTimeLocale, formatTime)
 
 -- 后端抽象：跑语句、取数据字典与账号，分 IPC（真存储）和内存（测试）两套实现。
 
@@ -59,18 +64,24 @@ data StatementResult = StatementResult
     }
 
 data Backend = Backend
-    { beStatement :: String -> IO (Either String StatementResult)
+    { beConcurrentTransactions :: Bool
+    , beBeginTransaction :: Bool -> IO (Either String (Maybe String, Database))
+    , beStageTransaction :: String -> [TxnOp] -> [String] -> IO (Either String ())
+    , bePreviewTransaction :: String -> IO (Either String (String, Database))
+    , beCommitTransaction :: String -> String -> IO (Either String ())
+    , beRollbackTransaction :: String -> IO (Either String ())
+    , 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])
-    -- | 原样转发一条存储请求
     , beStorage :: A.Value -> IO (Either String A.Value)
-    -- | 取一份整库快照，当事务的起点
+    -- ^ 原样转发一条存储请求
     , beSnapshot :: IO (Either String Database)
-    -- | 事务提交：把一批写操作交给存储层应用
+    -- ^ 取一份整库快照，当事务的起点
     , beApplyTransaction :: [TxnOp] -> IO (Either String ())
+    -- ^ 事务提交：把一批写操作交给存储层应用
     }
 
 -- | 按给定列名取列，固定列顺序
@@ -79,7 +90,7 @@ columnsFromStatement db stmt = case prepare db stmt of
     Left _ -> []
     Right resolved -> columnsOf resolved
   where
-    -- | 从已准备的语句提取输出列名
+    -- \| 从已准备的语句提取输出列名
     columnsOf (SelectDistinct q) = columnsOf q
     columnsOf Select{selectItems = items} = map fst items
     columnsOf ShowDomains = ["domain", "base_type"]
@@ -88,8 +99,26 @@ columnsFromStatement db stmt = case prepare db stmt of
 -- | 走本地存储链路的后端
 ipcBackend :: IO Backend
 ipcBackend = do
-    let backend current = Backend
-            { beStatement = runIpc current
+    snapshots <- newMVar Nothing
+    let backend current =
+            Backend
+                { beConcurrentTransactions = True
+                , beBeginTransaction = \serializable -> do
+                    response <- sendRequest (ReqInDatabase current (ReqMvccBegin serializable))
+                    pure $ case response of
+                        RespMvccSnapshot token infos rows _ -> (,) (Just token) <$> snapshotDatabase infos rows
+                        RespError err -> Left err
+                        _ -> Left "unexpected MVCC begin response"
+                , beStageTransaction = \token ops dependencies -> transactionRequest current (ReqMvccLock token ops dependencies)
+                , bePreviewTransaction = \token -> do
+                    response <- sendRequest (ReqInDatabase current (ReqMvccPreview token))
+                    pure $ case response of
+                        RespDomainSnapshot infos rows checkpoint -> (,) checkpoint <$> snapshotDatabase infos rows
+                        RespError err -> Left err
+                        _ -> Left "unexpected MVCC preview response"
+                , beCommitTransaction = \token checkpoint -> transactionRequest current (ReqMvccCommit token checkpoint)
+                , beRollbackTransaction = transactionRequest current . ReqMvccRollback
+                , beStatement = runIpc current
                 , beCatalog = do
                     response <- sendRequest (ReqInDatabase current ReqListCatalog)
                     pure $ case response of
@@ -113,7 +142,12 @@ ipcBackend = do
                         RespError err -> Left err
                         _ -> Left "unexpected database response"
                 , beStorage = runRaw
-            , beSnapshot = runIPCStorageIn snapshot (sessionEnv current)
+                , beSnapshot = modifyMVar snapshots $ \previous -> do
+                    let cached = case previous of Just (name, version) | name == current -> Just version; _ -> Nothing
+                    result <- databaseSnapshot cached (sessionEnv current)
+                    pure $ case result of
+                        Left err -> (previous, Left err)
+                        Right version -> (Just (current, version), Right (snd version))
                 , beApplyTransaction = \ops -> do
                     response <- sendRequest (ReqInDatabase current (ReqApplyTransaction ops))
                     pure $ case response of
@@ -124,11 +158,16 @@ ipcBackend = do
     -- 没有默认库：没选库时 current 是空串，任何请求都得先选库
     pure (backend "")
   where
-    -- | 会话的存储环境：库名跟这条连接走
+    -- 转发事务生命周期请求并保留存储错误。
+    transactionRequest current request = do
+        response <- sendRequest (ReqInDatabase current request)
+        pure $ case response of RespOk -> Right (); RespError err -> Left err; _ -> Left "unexpected MVCC response"
+
+    -- \| 会话的存储环境：库名跟这条连接走
     sessionEnv :: String -> Env
     sessionEnv current = envForDatabase (if null current then Nothing else Just current)
 
-    -- | 转发一条存储请求并解析响应
+    -- \| 转发一条存储请求并解析响应
     runRaw :: A.Value -> IO (Either String A.Value)
     runRaw payload = do
         response <- sendRawRequest (BL.toStrict (A.encode payload))
@@ -138,7 +177,7 @@ ipcBackend = do
                 Left err -> Left ("storage response is not valid JSON: " ++ err)
                 Right value -> Right value
 
-    -- | 走存储链路跑一条语句：表名不再补当前库前缀
+    -- \| 走存储链路跑一条语句：表名不再补当前库前缀
     -- 引擎侧的数据字典按当前库过滤之后键是裸表名，补前缀会让查表落空；
     -- 库名由 database 字段随请求带走，存储层自己按它分发。
     runIpc :: String -> String -> IO (Either String StatementResult)
@@ -166,7 +205,13 @@ memoryBackend = memoryBackendWith False
 memoryBackendWith :: Bool -> String -> MVar Database -> Backend
 memoryBackendWith trusted name ref =
     Backend
-        { beStatement = \sql -> case parseStatement sql >>= scopeDdl (if trusted then systemDatabaseName else name) of
+        { beConcurrentTransactions = False
+        , beBeginTransaction = \_ -> fmap (fmap (Nothing,)) (beSnapshot (memoryBackend name ref))
+        , beStageTransaction = \_ _ _ -> pure (Left "MVCC unavailable for memory backend")
+        , bePreviewTransaction = \_ -> pure (Left "MVCC unavailable for memory backend")
+        , beCommitTransaction = \_ _ -> pure (Left "MVCC unavailable for memory backend")
+        , beRollbackTransaction = \_ -> pure (Left "MVCC unavailable for memory backend")
+        , beStatement = \sql -> case parseStatement sql >>= scopeDdl (if trusted then systemDatabaseName else name) of
             Left e -> pure (Left e)
             -- 内存夹具也有"库"的概念：USE 只能切到它有的两个名字（自己 + system），
             -- 与 beDatabases 口径一致；引擎的内存存储不实现库管理，所以拦在这里。
@@ -200,31 +245,31 @@ memoryBackendWith trusted name ref =
             Right db' -> pure (mergeScoped db db', Right ())
         }
   where
-    -- | 按视角过滤库里的表
-    scoped db = [(lastTablePart key, table {tableName = lastTablePart key}) | (key, table) <- db, inScope key, domainKey key || not (hidden key)]
-    -- | 限定键只属于指定工作库
+    -- \| 按视角过滤库里的表
+    scoped db = [(lastTablePart key, table{tableName = lastTablePart key}) | (key, table) <- db, inScope key, domainKey key || not (hidden key)]
+    -- \| 限定键只属于指定工作库
     inScope key = case break (== '.') key of
         (_, []) -> True
         (database, _) -> T.toLower (T.pack database) == T.toLower (T.pack (if trusted then systemDatabaseName else name))
-    -- | 该视角下要隐藏的表
+    -- \| 该视角下要隐藏的表
     hidden = (if trusted then blocked else internalTable) . lastTablePart
-    -- | 判断裸名或限定名是否为类型目录
+    -- \| 判断裸名或限定名是否为类型目录
     domainKey = isDomainTable . lastTablePart
-    -- | 回写当前库并保留其他库和内部目录
+    -- \| 回写当前库并保留其他库和内部目录
     mergeScoped original changed =
         filter (\(key, _) -> not (inScope key) || (hidden key && not (domainKey key))) original
             ++ [(storageKey original key, table) | (key, table) <- changed]
-    -- | 保留夹具中的原始数据库限定键
+    -- \| 保留夹具中的原始数据库限定键
     storageKey original key = case [saved | (saved, _) <- original, inScope saved, lastTablePart saved == key] of
         saved : _ -> saved
         [] | any (\(saved, _) -> inScope saved && '.' `elem` saved) original -> (if trusted then systemDatabaseName else name) ++ "." ++ key
         [] -> key
-    -- | 取结果列名，空结果回落到解析
+    -- \| 取结果列名，空结果回落到解析
     colsOf db stmt rows = case rows of
         [] -> columnsFromStatement db stmt
         (r : _) -> map fst r
 
-    -- | 按目标库名挑视角
+    -- \| 按目标库名挑视角
     withDatabase target
         | target == systemDatabaseName = memoryBackendWith True name ref
         | target == name = memoryBackendWith False name ref
@@ -233,7 +278,8 @@ memoryBackendWith trusted name ref =
 
 -- 更新内存夹具的稳定表编号。
 syncMemoryObjects :: String -> Database -> Database
-syncMemoryObjects database db = (registry, Table registry [("name", TStr), ("id", TInt)] records Nothing Nothing Nothing)
+syncMemoryObjects database db =
+    (registry, Table registry [("name", TStr), ("id", TInt)] records Nothing Nothing Nothing)
         : map identify (filter ((/= registry) . fst) db)
   where
     registry = "__system_object_ids"
@@ -242,10 +288,19 @@ syncMemoryObjects database db = (registry, Table registry [("name", TStr), ("id"
     retained = [(key, identifier) | (key, identifier) <- previous, key `elem` keys]
     high = maximum (0 : map snd previous)
     added = zip [key | key <- keys, key `notElem` map fst retained] [high + 1 ..]
-    -- | 将稳定目录编号附到表定义
+    -- \| 将稳定目录编号附到表定义
     identify (key, table) = case lookup (if '.' `elem` key then key else database ++ "." ++ key) (retained ++ added) of
-        Just identifier -> (key, table {tableIdentity = Just (TableIdentity
-            (if "system." `isPrefixOf` key || ('.' `notElem` key && database == "system") then 2 else 1) (fromIntegral identifier))})
+        Just identifier ->
+            ( key
+            , table
+                { tableIdentity =
+                    Just
+                        ( TableIdentity
+                            (if "system." `isPrefixOf` key || ('.' `notElem` key && database == "system") then 2 else 1)
+                            (fromIntegral identifier)
+                        )
+                }
+            )
         Nothing -> (key, table)
     records = [[("name", VStr key), ("id", VInt identifier)] | (key, identifier) <- ("__high_water", high + length added) : retained ++ added]
 
@@ -267,7 +322,9 @@ memorySecurityRequest database ref payload = modifyMVar ref $ \original -> do
     operation db = case field "method" of
         Just "resolve_object" -> do
             selected <- maybe (Left "missing database") Right (field "database")
-            if selected `notElem` [T.pack database, "system"] then Left "unknown database" else do
+            if selected `notElem` [T.pack database, "system"]
+                then Left "unknown database"
+                else do
                     identifier <- case field "table" of
                         Nothing -> Right A.Null
                         Just table -> case [number | row <- maybe [] tableRows (lookup "__system_object_ids" db), lookup "name" row == Just (VStr (T.unpack (selected <> "." <> table))), Just (VInt number) <- [lookup "id" row]] of
@@ -277,7 +334,9 @@ memorySecurityRequest database ref payload = modifyMVar ref $ \original -> do
         Just "object_acl_read" -> Right (db, A.object ["status" A..= ("rows" :: Text), "rows" A..= [A.object ["id" A..= (1 :: Int), "payload" A..= value] | row <- maybe [] tableRows (lookup acl db), Just (VStr value) <- [lookup "payload" row]]])
         Just "object_acl_replace" -> do
             let previous = case lookup acl db of Nothing -> Nothing; Just table -> case tableRows table of [[("payload", VStr value)]] -> Just (T.pack value); _ -> Just "invalid ACL"
-            if previous /= field "expected" then Left "object ACL changed concurrently" else do
+            if previous /= field "expected"
+                then Left "object ACL changed concurrently"
+                else do
                     value <- maybe (Left "missing ACL payload") Right (field "payload")
                     Right ((acl, Table acl [("payload", TStr)] [[("payload", VStr (T.unpack value))]] Nothing Nothing Nothing) : filter ((/= acl) . fst) db, A.object ["status" A..= ("ok" :: Text)])
         _ -> Left "storage is not available in this backend"
@@ -285,7 +344,8 @@ memorySecurityRequest database ref payload = modifyMVar ref $ \original -> do
 
 -- | 把后端的语句与字典都改成同一条错误
 unavailableDatabase :: String -> Backend -> Backend
-unavailableDatabase message backend = backend
+unavailableDatabase message backend =
+    backend
         { beStatement = \_ -> pure (Left message)
         , beCatalog = pure (Left message)
         , beSnapshot = pure (Left message)
@@ -294,7 +354,8 @@ unavailableDatabase message backend = backend
 
 -- | 未选库时的视角：只放行不碰表的语句
 noDatabaseBackend :: Backend -> Backend
-noDatabaseBackend backend = backend
+noDatabaseBackend backend =
+    backend
         { beStatement = \sql -> case parseStatement sql of
             Left e -> pure (Left e)
             Right stmt
@@ -309,36 +370,45 @@ noDatabaseBackend backend = backend
 applyTransactionMemory :: [TxnOp] -> Database -> Either String Database
 applyTransactionMemory ops db = foldl step (Right db) ops
   where
+    -- 顺序预演每个事务操作。
     step acc op = do
         current <- acc
         case op of
             TxnDelete name keys -> do
                 table <- lookupTable current name
-                pure (put (name, table {tableRows = [r | r <- tableRows table, not (doomed keys r)]}) current)
+                pure (put (name, table{tableRows = deleteFirst (Set.fromList keys) (tableRows table)}) current)
             TxnUpsert name rows -> do
                 table <- lookupTable current name
-                pure (put (name, table {tableRows = tableRows table ++ rows}) current)
+                pure (put (name, table{tableRows = tableRows table ++ rows}) current)
             TxnReplace name rows -> do
                 table <- lookupTable current name
-                pure (put (name, table {tableRows = rows}) current)
+                pure (put (name, table{tableRows = rows}) current)
 
-    -- | 换掉一张表，其余保持原顺序
+    -- \| 换掉一张表，其余保持原顺序
     put entry = map (\one@(name, _) -> if name == fst entry then entry else one)
 
-    -- | 这一行要不要删：按行里的 id 列比
-    doomed keys r = case lookup "id" r of
-        Just (VInt k) -> k `elem` keys
-        _ -> False
+    -- 与存储一致，每个删除键只删除首行。
+    deleteFirst _ [] = []
+    deleteFirst keys (row : rows) = case lookup "id" row of
+        Just (VInt key) | Set.member key keys -> deleteFirst (Set.delete key keys) rows
+        _ -> row : deleteFirst keys rows
 
 -- | 语句里出现的表
 statementTables :: Statement -> [Text]
-statementTables stmt = nub (case stmt of
+statementTables stmt =
+    nub
+        ( case stmt of
             SelectDistinct q -> statementTables q
             Select{} ->
                 tableRefsOf (selectFrom stmt)
-            ++ concatMap exprTables (maybeToList (selectWhere stmt) ++ maybeToList (selectHaving stmt)
-                ++ map snd (selectItems stmt) ++ map Col (selectGroupBy stmt)
-                ++ mapMaybe (orderKeyExpression . fst) (selectOrderBy stmt))
+                    ++ concatMap
+                        exprTables
+                        ( maybeToList (selectWhere stmt)
+                            ++ maybeToList (selectHaving stmt)
+                            ++ map snd (selectItems stmt)
+                            ++ map Col (selectGroupBy stmt)
+                            ++ mapMaybe (orderKeyExpression . fst) (selectOrderBy stmt)
+                        )
             Insert table _ rows -> T.pack table : concatMap exprTables (concat rows)
             Update table assigns cond -> T.pack table : concatMap exprTables (map snd assigns ++ maybeToList cond)
             Delete table cond -> T.pack table : concatMap exprTables (maybeToList cond)
@@ -352,7 +422,8 @@ statementTables stmt = nub (case stmt of
             AlterColumnType table _ _ -> [T.pack table]
             AlterColumnDefault table _ _ -> [T.pack table]
             AlterColumnNull table _ _ -> [T.pack table]
-    _ -> [])
+            _ -> []
+        )
 
 -- | 语句需不需要一个当前库：出现的表里有没写库名的就必须要
 statementNeedsDatabase :: Statement -> Bool
@@ -368,6 +439,7 @@ statementNeedsDatabase stmt = case stmt of
     AlterColumnDefault{} -> True
     AlterColumnNull{} -> True
     CreateDomain{} -> True
+    AlterDomain{} -> True
     DropDomain{} -> True
     ShowDomains -> True
     _ -> not (null (statementTables stmt))
@@ -387,14 +459,14 @@ scopeDdl current statement = case statement of
     AlterColumnNull table column nullable -> (\key -> AlterColumnNull key column nullable) <$> target table
     _ -> statement <$ mapM_ checkReadTarget (statementTables statement)
   where
-    -- | 数据引用限定在当前工作库
+    -- \| 数据引用限定在当前工作库
     checkReadTarget table
         | null current = Left "no database selected"
         | otherwise = case T.breakOn "." table of
             (_, suffix) | T.null suffix -> Right ()
             (database, _) | T.toLower database == T.toLower (T.pack current) -> Right ()
             _ -> Left ("table is outside the current database: " ++ T.unpack table)
-    -- | 校验库限定名并取当前库中的表名
+    -- \| 校验库限定名并取当前库中的表名
     target table
         | null current = Left "no database selected"
         | otherwise = case break (== '.') table of
@@ -441,7 +513,7 @@ exprTables expr = case expr of
     MaxOf a -> exprTables a
     _ -> []
   where
-    -- | 两侧都取表名
+    -- \| 两侧都取表名
     both a b = exprTables a ++ exprTables b
 
 -- | 一张表的线上信息（内存实现：没有索引，统计与直方图现算）
@@ -458,10 +530,10 @@ tableInfoOf (name, tbl) =
         , tiHistograms = [(c, h) | (c, _) <- tableCols tbl, Just h <- [histogramOf (columnValues c)]]
         }
   where
-    -- | 一列的所有值
+    -- \| 一列的所有值
     columnValues c = [v | r <- tableRows tbl, Just v <- [lookup c r]]
 
-    -- | 一列的不同值个数
+    -- \| 一列的不同值个数
     distinctOf c = length (nub (columnValues c))
 
 -- | 本地列类型转线上字符串（和 IPC 那边同一套写法）
@@ -551,21 +623,36 @@ memoryAccounts db stamp req = do
                     _ -> Nothing
                 allowed = case command of ReqAccountsList -> True; ReqAccountCreate{} -> True; ReqAccountReset{} -> True; ReqAccountDrop{} -> True; ReqIdentityAlter _ _ Nothing _ Nothing Nothing -> True; _ -> False
             if not allowed || any (\a -> target == Just (accountUser a) && (accountIsSuperuser a || accountSystemCatalogManager a || accountAllowSudoAuth a)) accounts
-                then Left "superuser required to manage privileged identities" else memoryAccounts db stamp command
+                then Left "superuser required to manage privileged identities"
+                else memoryAccounts db stamp command
         ReqAccountsList -> Right accounts
         ReqIdentityInitialize admin
             | any (`elem` map accountUser accounts) legacyNames || length (nub legacyNames) /= length legacyNames -> Left "identity name collision"
-            | otherwise -> Right ([if legacyIdentity a && accountUser a == T.toLower admin then a{accountIsSuperuser = True} else a | a <- accounts] ++
-                [Account (highWater + offset) role "" 1 stamp Nothing False False True False False | (offset, role) <- zip [1..] legacyNames])
+            | otherwise ->
+                Right
+                    ( [if legacyIdentity a && accountUser a == T.toLower admin then a{accountIsSuperuser = True} else a | a <- accounts]
+                        ++ [Account (highWater + offset) role "" 1 stamp Nothing False False True False False | (offset, role) <- zip [1 ..] legacyNames]
+                    )
         ReqRoleCreate u
             | any ((== T.toLower u) . accountUser) accounts -> Left "identity already exists"
             | otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) "" 1 stamp Nothing False False True False False])
         ReqIdentityAlter u login super enabled manager sudo -> case filter ((== T.toLower u) . accountUser) accounts of
-            [_] -> preserveSuper [if accountUser a == T.toLower u then a{accountCanLogin = fromMaybe (accountCanLogin a) login,
-                accountIsSuperuser = fromMaybe (accountIsSuperuser a) super, accountEnabled = fromMaybe (accountEnabled a) enabled,
-                accountSystemCatalogManager = fromMaybe (accountSystemCatalogManager a) manager,
-                accountAllowSudoAuth = fromMaybe (accountAllowSudoAuth a) sudo,
-                accountRevision = accountRevision a + 1} else a | a <- accounts] accounts
+            [_] ->
+                preserveSuper
+                    [ if accountUser a == T.toLower u
+                        then
+                            a
+                                { accountCanLogin = fromMaybe (accountCanLogin a) login
+                                , accountIsSuperuser = fromMaybe (accountIsSuperuser a) super
+                                , accountEnabled = fromMaybe (accountEnabled a) enabled
+                                , accountSystemCatalogManager = fromMaybe (accountSystemCatalogManager a) manager
+                                , accountAllowSudoAuth = fromMaybe (accountAllowSudoAuth a) sudo
+                                , accountRevision = accountRevision a + 1
+                                }
+                        else a
+                    | a <- accounts
+                    ]
+                    accounts
             _ -> Left "unknown account"
         ReqAccountCreate u h
             | any ((== T.toLower u) . accountUser) accounts -> Left "account already exists"
@@ -581,51 +668,51 @@ memoryAccounts db stamp req = do
             _ -> preserveSuper [x | x <- accounts, accountUser x /= T.toLower u] accounts
         _ -> Left "invalid account request"
   where
-    -- | 判断旧格式身份是否缺少属性
+    -- \| 判断旧格式身份是否缺少属性
     legacyIdentity account = any (legacyRow (accountUser account)) (maybe [] tableRows (lookup usersTable db))
-    -- | 检查旧身份的元数据版本
+    -- \| 检查旧身份的元数据版本
     legacyRow user row = case lookup "account" row of
         Just (VStr encoded) -> case A.decode (BL.pack encoded) of
             Just (A.Object fields) -> KM.lookup "user" fields == Just (A.String user) && not (KM.member "is_superuser" fields)
             _ -> False
         _ -> False
-    -- | 读取旧格式账号
+    -- \| 读取旧格式账号
     decodeAccount row = case lookup "account" row of
         Just (VStr encoded) -> A.eitherDecode (BL.pack encoded)
         _ -> Left "invalid account record"
-    -- | 合并身份与口令
+    -- \| 合并身份与口令
     decodeCredential row = do
         identity <- decodeAccount row
         case [hash | credential <- maybe [] tableRows (lookup usersTable db), lookup "id" credential == Just (VInt (fromInteger (accountId identity))), Just (VStr hash) <- [lookup "password_hash" credential]] of
             [hash] -> Right identity{accountHash = T.pack hash}
             _ -> Left "invalid identity credential"
-    -- | 保留启用的登录管理员
+    -- \| 保留启用的登录管理员
     preserveSuper next old
         | any activeSuper old && not (any activeSuper next) = Left "the last enabled login superuser cannot be removed"
         | otherwise = Right next
-    -- | 判断可登录管理员
+    -- \| 判断可登录管理员
     activeSuper a = accountEnabled a && accountCanLogin a && accountIsSuperuser a
 
 -- | 分开保存内存身份与口令并清理授权
 storeMemoryIdentities :: Database -> [Account] -> [Account] -> Database
 storeMemoryIdentities db previous accounts =
-    (usersTable, Table usersTable [("id", TInt), ("password_hash", TStr)] credentials Nothing Nothing Nothing) :
-    ("__system_identities", Table "__system_identities" [("account", TStr)] identities Nothing Nothing Nothing) :
-    ("__system_identity_sequence", Table "__system_identity_sequence" [("id", TInt)] [[("id", VInt highWater)]] Nothing Nothing Nothing) :
-    [(name, clean name table) | (name, table) <- db, name `notElem` [usersTable, "__system_identities", "__system_identity_sequence"]]
+    (usersTable, Table usersTable [("id", TInt), ("password_hash", TStr)] credentials Nothing Nothing Nothing)
+        : ("__system_identities", Table "__system_identities" [("account", TStr)] identities Nothing Nothing Nothing)
+        : ("__system_identity_sequence", Table "__system_identity_sequence" [("id", TInt)] [[("id", VInt highWater)]] Nothing Nothing Nothing)
+        : [(name, clean name table) | (name, table) <- db, name `notElem` [usersTable, "__system_identities", "__system_identity_sequence"]]
   where
-    -- | 保存口令与身份编号
+    -- \| 保存口令与身份编号
     credentials = [[("id", VInt (fromInteger (accountId a))), ("password_hash", VStr (T.unpack (accountHash a)))] | a <- accounts]
-    -- | 保存不含口令的身份记录
+    -- \| 保存不含口令的身份记录
     identities = [[("account", VStr (BL.unpack (A.encode a{accountHash = ""})))] | a <- accounts]
-    -- | 保留已用编号上界
+    -- \| 保留已用编号上界
     highWater = maximum (0 : map (fromInteger . accountId) accounts ++ [n | row <- maybe [] tableRows (lookup "__system_identity_sequence" db), Just (VInt n) <- [lookup "id" row]])
-    -- | 清理旧目录与失效的授权边
+    -- \| 清理旧目录与失效的授权边
     clean name table
         | name == rolesTable = table{tableRows = []}
         | name `elem` [grantsTable, optionsTable, membersTable] = table{tableRows = filter active (tableRows table)}
         | otherwise = table
-    -- | 识别已经删除的身份
+    -- \| 识别已经删除的身份
     removed = [accountUser a | a <- previous, accountUser a `notElem` map accountUser accounts]
-    -- | 排除已删除身份的授权和成员边
+    -- \| 排除已删除身份的授权和成员边
     active row = not (any (\field -> case lookup field row of Just (VStr value) -> T.pack value `elem` removed; _ -> False) ["role", "member"])

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

@@ -1,35 +1,35 @@
-module ChuSQL.Server.Catalog
-    ( Catalog
-    , newCatalog
-    , normalizeRole
-    , normalizeUser
-    , normalizeObject
-    , withCatalog
-    , withCatalogLock
-    , ensureCatalog
-    , eachAction
-    , readRoleNames
-    , readIdentities
-    , insertRole
-    , dropRole
-    , readGrants
-    , addGrant
-    , removeGrant
-    , readGrantOptions
-    , addGrantOption
-    , removeGrantOption
-    , readMembers
-    , addMember
-    , removeMember
-    ) where
+module ChuSQL.Server.Catalog (
+    Catalog,
+    newCatalog,
+    normalizeRole,
+    normalizeUser,
+    normalizeObject,
+    withCatalog,
+    withCatalogLock,
+    ensureCatalog,
+    eachAction,
+    readRoleNames,
+    readIdentities,
+    insertRole,
+    dropRole,
+    readGrants,
+    addGrant,
+    removeGrant,
+    readGrantOptions,
+    addGrantOption,
+    removeGrantOption,
+    readMembers,
+    addMember,
+    removeMember,
+) where
 
-import Control.Monad (void)
 import ChuSQL.Core.Model (Row, Value (..))
 import ChuSQL.Core.Protocol (Account (..), Request (..))
 import ChuSQL.Interface.Actions (escapeStringLiteral)
 import ChuSQL.Interface.Protocol (Grant (..))
 import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, optionsTable, rolesTable)
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
+import Control.Monad (void)
 import Data.List (intercalate, isInfixOf)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -77,7 +77,7 @@ withCatalog catalog action = withCatalogLock catalog $ do
 ensureCatalog :: Catalog -> IO (Either String ())
 ensureCatalog catalog = eachAction tableDefs (createTable catalog)
   where
-    -- | 三张系统表的定义
+    -- \| 三张系统表的定义
     tableDefs =
         [ (rolesTable, "(name VARCHAR(64))")
         , (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
@@ -191,7 +191,7 @@ grantOf row =
 
 -- | 一行带 grant option 的授权记录
 optionOf :: Row -> Grant
-optionOf row = (grantOf row) {grantable = True}
+optionOf row = (grantOf row){grantable = True}
 
 -- | 一行成员关系
 memberOf :: Row -> (Text, Text)
@@ -200,8 +200,14 @@ memberOf row = (normalizeRole (cell "role" row), normalizeUser (cell "member" ro
 -- | 拼一条删授权的语句
 deleteGrantSql :: String -> Text -> Text -> Text -> String
 deleteGrantSql table role privilege object =
-    "DELETE FROM " ++ table ++ " WHERE role = " ++ roleLiteral role
-        ++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object
+    "DELETE FROM "
+        ++ table
+        ++ " WHERE role = "
+        ++ roleLiteral role
+        ++ " AND privilege = "
+        ++ literal privilege
+        ++ " AND object = "
+        ++ literal object
 
 -- | 拼一条插入语句
 insertSql :: String -> [String] -> [Text] -> String

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

@@ -2,7 +2,6 @@
 
 module ChuSQL.Server.Normalization (normalizationBudget, normalizationReport, schemaFingerprint) where
 
-import Data.Maybe (fromMaybe)
 import qualified ChuSQL.Core.Engine.Normalization as N
 import ChuSQL.Core.Model (Column (..), parseColumnType)
 import ChuSQL.Core.Protocol (SchemaColumn (..), valueToJSON)
@@ -11,10 +10,11 @@ import Control.Concurrent.MVar
 import Control.Concurrent.QSem
 import Control.Exception (bracket_, evaluate, mask)
 import Crypto.Hash (Digest, SHA256, hash)
+import Data.Aeson (object, (.=))
 import qualified Data.Aeson as A
-import Data.Aeson ((.=), object)
 import qualified Data.ByteString.Lazy as BL
 import Data.List (nub, sort)
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import System.IO.Unsafe (unsafePerformIO)
@@ -32,8 +32,9 @@ normalizationBudget :: IO (Either (Text, Text) A.Value) -> IO (Either (Text, Tex
 normalizationBudget action = mask $ \restore -> do
     let (queued, slots) = analysisSlots
     admitted <- modifyMVar queued $ \count -> pure (if count < 8 then (count + 1, True) else (count, False))
-    if not admitted then pure (Left ("too_busy", "normalization queue is full")) else
-        bracket_ (pure ()) (modifyMVar_ queued (pure . subtract 1)) $ do
+    if not admitted
+        then pure (Left ("too_busy", "normalization queue is full"))
+        else bracket_ (pure ()) (modifyMVar_ queued (pure . subtract 1)) $ do
             result <- restore $ timeout 5000000 $ bracket_ (waitQSem slots) (signalQSem slots) $ do
                 outcome <- action
                 case outcome of
@@ -45,8 +46,17 @@ normalizationBudget action = mask $ \restore -> do
 
 -- 编码只影响语义的列信息。
 fingerprintColumn :: SchemaColumn -> A.Value
-fingerprintColumn c = A.toJSON [A.toJSON (scName c), A.toJSON (scType c), A.toJSON (scNullable c),
-    maybe A.Null valueToJSON (scDefault c), A.toJSON (scAutoIncrement c), A.toJSON (scPrimaryKey c), A.toJSON (scUnique c), A.toJSON (scCheck c)]
+fingerprintColumn c =
+    A.toJSON
+        [ A.toJSON (scName c)
+        , A.toJSON (scType c)
+        , A.toJSON (scNullable c)
+        , maybe A.Null valueToJSON (scDefault c)
+        , A.toJSON (scAutoIncrement c)
+        , A.toJSON (scPrimaryKey c)
+        , A.toJSON (scUnique c)
+        , A.toJSON (scCheck c)
+        ]
 
 -- 将稳定编号与列结构绑定到 SHA256。
 schemaFingerprint :: ObjectIdentity -> [SchemaColumn] -> Text
@@ -57,16 +67,29 @@ normalizationReport :: ObjectIdentity -> [SchemaColumn] -> Text -> Normalization
 normalizationReport identity columns view payload = do
     let fingerprint = schemaFingerprint identity columns
     if maybe False (/= identity) (nrExpectedObject payload) || maybe False (/= fingerprint) (nrExpectedSchema payload)
-        then Left ("conflict", "normalization object or schema has changed") else Right ()
+        then Left ("conflict", "normalization object or schema has changed")
+        else Right ()
     schema <- mapM column columns
     let declaration = nrDeclaration payload
         axioms = N.Declaration (ndKeys declaration) [N.Dependency a b | NormalizationDependency a b <- ndDependencies declaration] (ndComplete declaration) (ndAtomic declaration)
     analysis <- either (Left . (,) "bad_request" . T.pack) Right (N.analyzeNormalization schema axioms)
-    Right (object ["api_version" .= (1 :: Int), "database" .= nrDatabase payload, "table" .= last (T.splitOn "." (nrTable payload)),
-        "object" .= identity, "schema_fingerprint" .= fingerprint, "view" .= view, "schema" .= columns,
-        "declaration" .= canonicalDeclaration declaration, "candidate_keys" .= N.candidateKeys analysis,
-        "findings" .= map findingJSON (N.findings analysis), "suggestions" .= map decompositionJSON (N.suggestions analysis),
-        "conditional" .= True, "condition" .= ("Analysis is conditional on the declarations; SQL NULL, UNIQUE and bag semantics are not proofs of classical keys or lossless data migration." :: Text)])
+    Right
+        ( object
+            [ "api_version" .= (1 :: Int)
+            , "database" .= nrDatabase payload
+            , "table" .= last (T.splitOn "." (nrTable payload))
+            , "object" .= identity
+            , "schema_fingerprint" .= fingerprint
+            , "view" .= view
+            , "schema" .= columns
+            , "declaration" .= canonicalDeclaration declaration
+            , "candidate_keys" .= N.candidateKeys analysis
+            , "findings" .= map findingJSON (N.findings analysis)
+            , "suggestions" .= map decompositionJSON (N.suggestions analysis)
+            , "conditional" .= True
+            , "condition" .= ("Analysis is conditional on the declarations; SQL NULL, UNIQUE and bag semantics are not proofs of classical keys or lossless data migration." :: Text)
+            ]
+        )
   where
     -- 还原列类型及声明约束而不读取数据。
     column c = case parseColumnType (scType c) of
@@ -75,13 +98,21 @@ normalizationReport identity columns view payload = do
 
 -- 规范化经验证的声明属性集合。
 canonicalDeclaration :: NormalizationDeclaration -> NormalizationDeclaration
-canonicalDeclaration d = d {ndKeys = sort (nub (map N.canonical (ndKeys d))),
-    ndDependencies = [NormalizationDependency a b | (a, b) <- sort (nub [(N.canonical a, N.canonical b) | NormalizationDependency a b <- ndDependencies d])]}
+canonicalDeclaration d =
+    d
+        { ndKeys = sort (nub (map N.canonical (ndKeys d)))
+        , ndDependencies = [NormalizationDependency a b | (a, b) <- sort (nub [(N.canonical a, N.canonical b) | NormalizationDependency a b <- ndDependencies d])]
+        }
 
 -- 编码稳定范式标签及证据。
 findingJSON :: N.Finding -> A.Value
-findingJSON f = object ["normal_form" .= formTag (N.normalForm f), "verdict" .= verdictTag (N.verdict f),
-    "witnesses" .= [NormalizationDependency a b | N.Dependency a b <- N.witnesses f], "condition" .= N.condition f]
+findingJSON f =
+    object
+        [ "normal_form" .= formTag (N.normalForm f)
+        , "verdict" .= verdictTag (N.verdict f)
+        , "witnesses" .= [NormalizationDependency a b | N.Dependency a b <- N.witnesses f]
+        , "condition" .= N.condition f
+        ]
 
 -- 编码一次分解的理论结论。
 decompositionJSON :: N.Decomposition -> A.Value

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

@@ -1,23 +1,34 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Server.ObjectACL
-    ( objectAuthorize, objectGrant, objectRevoke, objectRevokeGrantOption, objectViews, objectClaim
-    , objectSelfViews, objectReconcile, objectAffected, objectOwner, objectConnect, objectPrepareCreate, objectUsers
-    ) where
+module ChuSQL.Server.ObjectACL (
+    objectAuthorize,
+    objectGrant,
+    objectRevoke,
+    objectRevokeGrantOption,
+    objectViews,
+    objectClaim,
+    objectSelfViews,
+    objectReconcile,
+    objectAffected,
+    objectOwner,
+    objectConnect,
+    objectPrepareCreate,
+    objectUsers,
+) where
 
-import Data.Either (fromRight)
-import Control.Monad (void)
 import ChuSQL.Core.Protocol (Account (..), TableInfo (..))
 import ChuSQL.Interface.Protocol (Grant (..))
 import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalName)
 import ChuSQL.Server.Backend (Backend (..))
-import ChuSQL.Server.Catalog (Catalog, readIdentities, readMembers, readGrants, readGrantOptions)
+import ChuSQL.Server.Catalog (Catalog, readGrantOptions, readGrants, readIdentities, readMembers)
+import Control.Monad (void)
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as K
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Either (fromRight)
 import Data.List (nub)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -26,35 +37,40 @@ import GHC.Generics (Generic)
 
 -- 稳定对象权限目录：保存所有者、授予来源并计算有效授权链。
 
-data Target = Target { targetDatabase :: Text, targetTable :: Maybe Text, targetKind :: Text, targetName :: Text }
+data Target = Target {targetDatabase :: Text, targetTable :: Maybe Text, targetKind :: Text, targetName :: Text}
     deriving (Eq, Show, Generic)
 instance ToJSON Target
 instance FromJSON Target
 
-data Edge = Edge { edgeRole :: Text, edgeGrantor :: Text, edgeTarget :: Target, edgePrivilege :: Text, edgeOption :: Bool, edgeRoot :: Bool }
+data Edge = Edge {edgeRole :: Text, edgeGrantor :: Text, edgeTarget :: Target, edgePrivilege :: Text, edgeOption :: Bool, edgeRoot :: Bool}
     deriving (Eq, Show, Generic)
 instance ToJSON Edge
 instance FromJSON Edge
 
-data Owner = Owner { ownerRole :: Text, ownerTarget :: Target }
+data Owner = Owner {ownerRole :: Text, ownerTarget :: Target}
     deriving (Eq, Show, Generic)
 instance ToJSON Owner
 instance FromJSON Owner
 
-data Pending = Pending { pendingRole :: Text, pendingDatabase :: Text, pendingName :: Text }
+data Pending = Pending {pendingRole :: Text, pendingDatabase :: Text, pendingName :: Text}
     deriving (Eq, Show, Generic)
 instance ToJSON Pending
 instance FromJSON Pending
 
-data ACL = ACL { aclVersion :: Int, aclEdges :: [Edge], aclOwners :: [Owner], aclClosed :: [Text], aclPending :: [Pending] }
+data ACL = ACL {aclVersion :: Int, aclEdges :: [Edge], aclOwners :: [Owner], aclClosed :: [Text], aclPending :: [Pending]}
     deriving (Eq, Show, Generic)
 instance ToJSON ACL
 instance FromJSON ACL where
     -- 读取权限快照并兼容无声明的旧记录。
-    parseJSON = A.withObject "ACL" $ \fields -> ACL <$> fields A..: "aclVersion" <*> fields A..: "aclEdges"
-        <*> fields A..: "aclOwners" <*> fields A..: "aclClosed" <*> (fields A..:? "aclPending" A..!= [])
+    parseJSON = A.withObject "ACL" $ \fields ->
+        ACL
+            <$> fields A..: "aclVersion"
+            <*> fields A..: "aclEdges"
+            <*> fields A..: "aclOwners"
+            <*> fields A..: "aclClosed"
+            <*> (fields A..:? "aclPending" A..!= [])
 
-data Context = Context { contextIdentities :: [Account], contextMembers :: [(Text, Text)], contextTargets :: [Target] }
+data Context = Context {contextIdentities :: [Account], contextMembers :: [(Text, Text)], contextTargets :: [Target]}
 
 -- 解析存储响应并保留明确错误。
 request :: Backend -> A.Value -> IO (Either String A.Value)
@@ -90,7 +106,9 @@ resolve backend database raw = do
                 [name] -> (database, Just name, "table", database <> "." <> name)
                 [db, name] -> (db, Just name, "table", object)
                 _ -> ("", Just "", "table", object)
-    if T.null selected then pure (Left "no database selected") else do
+    if T.null selected
+        then pure (Left "no database selected")
+        else do
             result <- request backend (A.object (["method" A..= ("resolve_object" :: Text), "database" A..= selected] ++ maybe [] (\name -> ["table" A..= name]) table))
             pure $ do
                 value <- result
@@ -152,28 +170,33 @@ knownRole env value = value `elem` ["0", "public"] || any (\account -> T.pack (s
 roles :: Context -> Text -> [Text]
 roles env value = nub ("public" : go [value])
   where
-    pairs = [(parent, child) |
-               (parentName, childName) <- contextMembers env,
-               Right parent <- [roleId env parentName],
-               active env parent,
-               Right child <- [roleId env childName],
-               active env child]
+    pairs =
+        [ (parent, child)
+        | (parentName, childName) <- contextMembers env
+        , Right parent <- [roleId env parentName]
+        , active env parent
+        , Right child <- [roleId env childName]
+        , active env child
+        ]
     -- 展开成员关系的向上闭包。
-    go known = let more = [parent | (parent, child) <- pairs, child `elem` known, parent `notElem` known]
+    go known =
+        let more = [parent | (parent, child) <- pairs, child `elem` known, parent `notElem` known]
          in if null more then known else go (nub (known ++ more))
 
 -- 判断一个对象范围是否覆盖目标。
 covers :: Target -> Target -> Bool
-covers source target = targetDatabase source == targetDatabase target &&
-    (targetKind source == "tables" && targetKind target `elem` ["tables", "table"] || targetKind source == targetKind target && targetTable source == targetTable target)
+covers source target =
+    targetDatabase source == targetDatabase target
+        && (targetKind source == "tables" && targetKind target `elem` ["tables", "table"] || targetKind source == targetKind target && targetTable source == targetTable target)
 
 -- 判断稳定对象当前是否存在。
 exists :: Context -> Target -> Bool
 exists env target = any same (contextTargets env)
   where
     -- 核对数据库或表的稳定编号。
-    same current = targetDatabase current == targetDatabase target &&
-        (targetKind target == "tables" && targetKind current == "database" || targetKind current == targetKind target && targetTable current == targetTable target)
+    same current =
+        targetDatabase current == targetDatabase target
+            && (targetKind target == "tables" && targetKind current == "database" || targetKind current == targetKind target && targetTable current == targetTable target)
 
 -- 判断身份是否拥有指定对象。
 owns :: Context -> ACL -> Text -> Target -> Bool
@@ -181,13 +204,14 @@ owns env acl identity target = any (\owner -> ownerRole owner `elem` roles env i
 
 -- 计算仍有合法授予来源的授权闭包。
 effective :: Context -> ACL -> ACL
-effective env acl = acl {aclOwners = owners, aclEdges = grow roots, aclClosed = [value | value <- aclClosed acl, any (\target -> targetKind target == "database" && targetDatabase target == value) (contextTargets env)]}
+effective env acl = acl{aclOwners = owners, aclEdges = grow roots, aclClosed = [value | value <- aclClosed acl, any (\target -> targetKind target == "database" && targetDatabase target == value) (contextTargets env)]}
   where
     owners = [owner | owner <- aclOwners acl, knownRole env (ownerRole owner), exists env (ownerTarget owner)]
     candidates = [edge | edge <- aclEdges acl, knownRole env (edgeRole edge), knownRole env (edgeGrantor edge), exists env (edgeTarget edge)]
     roots = [edge | edge <- candidates, edgeRoot edge]
     -- 从独立授予根展开转授权链。
-    grow known = let more = [edge | edge <- candidates, edge `notElem` known, supported known edge]
+    grow known =
+        let more = [edge | edge <- candidates, edge `notElem` known, supported known edge]
          in if null more then known else grow (known ++ more)
     -- 检查授予者的所有权或有效转授权。
     supported known edge = active env (edgeGrantor edge) && (owns env acl{aclOwners = owners} (edgeGrantor edge) (edgeTarget edge) || any (\source -> active env (edgeRole source) && edgeOption source && edgeRole source `elem` roles env (edgeGrantor edge) && edgePrivilege source == edgePrivilege edge && covers (edgeTarget source) (edgeTarget edge)) known)
@@ -230,7 +254,9 @@ migrate backend catalog env = do
     one options grant = case roleId env (grantRole grant) of
         Left _ -> pure (Right [])
         Right identity -> do
-            objects <- if grantObject grant == "*" then pure (Right [target | target <- contextTargets env, targetKind target == "table"])
+            objects <-
+                if grantObject grant == "*"
+                    then pure (Right [target | target <- contextTargets env, targetKind target == "table"])
                     else fmap (fmap (: [])) (resolve backend "" (grantObject grant))
             let option = any (\row -> grantRole row == grantRole grant && grantPrivilege row == grantPrivilege grant && grantObject row == grantObject grant) options
             pure $ case objects of
@@ -248,8 +274,14 @@ load backend catalog = do
         Left err -> pure (Left err)
         Right (current, (previous, Just acl)) | null (aclPending acl) -> pure (Right (current, previous, effective current acl))
         Right (current, (previous, Just acl)) -> do
-            let recovered = [Owner (pendingRole pending) target | pending <- aclPending acl, target <- contextTargets current,
-                    targetKind target == "table", targetDatabase target == pendingDatabase pending, targetName target == pendingName pending]
+            let recovered =
+                    [ Owner (pendingRole pending) target
+                    | pending <- aclPending acl
+                    , target <- contextTargets current
+                    , targetKind target == "table"
+                    , targetDatabase target == pendingDatabase pending
+                    , targetName target == pendingName pending
+                    ]
                 next = acl{aclPending = [], aclOwners = recovered ++ [owner | owner <- aclOwners acl, ownerTarget owner `notElem` map ownerTarget recovered]}
             written <- writeACL backend previous (effective current next)
             case written of Left err -> pure (Left err); Right () -> load backend catalog
@@ -266,9 +298,10 @@ load backend catalog = do
 
 -- 检查作用域权限或所有权。
 allowed :: Context -> ACL -> Text -> Target -> Text -> Bool -> Bool
-allowed env acl identity target privilege option = owns env acl identity target ||
-    (not option && privilege == "connect" && targetKind target == "database" && targetDatabase target `notElem` aclClosed acl) ||
-    any (\edge -> active env (edgeRole edge) && edgeRole edge `elem` roles env identity && edgePrivilege edge == privilege && covers (edgeTarget edge) target && (not option || edgeOption edge)) (aclEdges acl)
+allowed env acl identity target privilege option =
+    owns env acl identity target
+        || (not option && privilege == "connect" && targetKind target == "database" && targetDatabase target `notElem` aclClosed acl)
+        || any (\edge -> active env (edgeRole edge) && edgeRole edge `elem` roles env identity && edgePrivilege edge == privilege && covers (edgeTarget edge) target && (not option || edgeOption edge)) (aclEdges acl)
 
 -- 按对象类型展开和校验权限名称。
 privileges :: Target -> [Text] -> Either String [Text]
@@ -276,10 +309,14 @@ privileges target names =
     if all (`elem` supported) expanded then Right expanded else Left "invalid privilege for object scope"
   where
     supported = if targetKind target == "database" then ["connect", "create"] else ["select", "insert", "update", "delete"]
-    expanded = nub (concatMap
-                      ((\ name -> if name == "all" then supported else [name])
-                         . T.toLower)
-                      names)
+    expanded =
+        nub
+            ( concatMap
+                ( (\name -> if name == "all" then supported else [name])
+                    . T.toLower
+                )
+                names
+            )
 
 -- 检查一组稳定对象上的业务权限。
 objectAuthorize :: Backend -> Catalog -> Principal -> Text -> [(Text, Text)] -> IO (Either String ())
@@ -310,17 +347,18 @@ objectGrant backend catalog principal database names object role option = do
             recipient <- roleId env role
             items <- privileges target names
             grantor <- if principalIsRoot principal then Right (fromRight "0" (roleId env (principalName principal))) else roleId env (principalName principal)
-            case [item |
-                    not (principalIsRoot principal),
-                    item <- items,
-                    not (allowed env acl grantor target item True)] of
+            case [ item
+                 | not (principalIsRoot principal)
+                 , item <- items
+                 , not (allowed env acl grantor target item True)
+                 ] of
                 item : _ -> Left ("grant option required: " ++ T.unpack (T.toUpper item <> " ON " <> object))
                 [] -> Right (recipient, grantor, items) of
             Left err -> pure (Left err)
             Right (recipient, grantor, items) -> do
                 let edges = [Edge recipient grantor target item option (principalIsRoot principal) | item <- items]
                     remaining = [edge | edge <- aclEdges acl, not (any (same edge) edges)]
-                            promoted = [edge {edgeOption = edgeOption edge || any (\old -> same old edge && edgeOption old) (aclEdges acl)} | edge <- edges]
+                    promoted = [edge{edgeOption = edgeOption edge || any (\old -> same old edge && edgeOption old) (aclEdges acl)} | edge <- edges]
                 writeACL backend previous acl{aclEdges = remaining ++ promoted, aclClosed = if recipient == "public" && "connect" `elem` items then filter (/= targetDatabase target) (aclClosed acl) else aclClosed acl}
   where
     -- 比较同一授予来源的授权键。
@@ -350,7 +388,8 @@ revokeObject optionOnly backend catalog principal database names object role = d
                     next = acl{aclEdges = if optionOnly then map removeOption (aclEdges acl) else filter (not . matches) (aclEdges acl), aclClosed = if not optionOnly && recipient == "public" && "connect" `elem` items then nub (targetDatabase target : aclClosed acl) else aclClosed acl}
                     -- 保留基础权限并移除匹配来源的转授权。
                     removeOption edge = if matches edge then edge{edgeOption = False} else edge
-                if recipient == "public" && "connect" `elem` items && not manager then pure (Left "administrator required")
+                if recipient == "public" && "connect" `elem` items && not manager
+                    then pure (Left "administrator required")
                     else writeACL backend previous (effective env next)
 
 -- 返回公开名称形式的有效授权。
@@ -373,10 +412,12 @@ objectSelfViews backend catalog principal = do
         if active env identity then Right () else Left "permission denied: disabled identity"
         -- 使用当前权限闭包判断普通及转授权权限。
         let permitted target privilege option = principalIsRoot principal || allowed env acl identity target privilege option
-        Right [Grant (principalName principal) privilege (targetName target) (permitted target privilege True)
+        Right
+            [ Grant (principalName principal) privilege (targetName target) (permitted target privilege True)
             | target <- contextTargets env
             , privilege <- if targetKind target == "database" then ["connect", "create"] else ["select", "insert", "update", "delete"]
-            , permitted target privilege False]
+            , permitted target privilege False
+            ]
 
 -- 登记新对象的创建者为所有者。
 objectClaim :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
@@ -400,7 +441,8 @@ objectPrepareCreate backend catalog principal database raw = do
             Left err -> pure (Left err)
             Right identity -> do
                 let name = if "." `T.isInfixOf` raw then T.toLower raw else database <> "." <> T.toLower raw
-                if any ((== name) . targetName) (contextTargets env) then pure (Right ())
+                if any ((== name) . targetName) (contextTargets env)
+                    then pure (Right ())
                     else writeACL backend previous acl{aclPending = [Pending identity (targetDatabase target) name]}
 
 -- 清理失效身份、成员来源和已删除对象。
@@ -417,7 +459,8 @@ objectAffected backend catalog names = do
         (env, _, acl) <- loaded
         let edges = [(roleName env (edgeGrantor edge), roleName env (edgeRole edge)) | edge <- aclEdges acl] ++ contextMembers env
             -- 展开成员和转授权的受影响身份。
-            walk seen = let more = [child | (parent, child) <- edges, parent `elem` seen, child `notElem` seen, not (T.null child)]
+            walk seen =
+                let more = [child | (parent, child) <- edges, parent `elem` seen, child `notElem` seen, not (T.null child)]
                  in if null more then seen else walk (nub (seen ++ more))
         let normalized = map (T.toLower . T.strip) names
         Right (if "public" `elem` normalized then nub (walk normalized ++ map accountUser (filter (not . accountIsSuperuser) (contextIdentities env))) else walk normalized)
@@ -441,7 +484,8 @@ objectUsers backend catalog database object = do
     case (,) <$> loaded <*> resolved of
         Left err -> pure (Left err)
         Right ((env, _, acl), target) -> do
-            let related = [edgeRole edge | edge <- aclEdges acl, if targetKind target == "database" then targetDatabase (edgeTarget edge) == targetDatabase target else covers (edgeTarget edge) target]
+            let related =
+                    [edgeRole edge | edge <- aclEdges acl, if targetKind target == "database" then targetDatabase (edgeTarget edge) == targetDatabase target else covers (edgeTarget edge) target]
                         ++ [ownerRole owner | owner <- aclOwners acl, ownerTarget owner == target]
             result <- objectAffected backend catalog (nub (map (roleName env) related))
             pure (fmap (filter (\name -> not (any (\account -> accountUser account == name && accountIsSuperuser account) (contextIdentities env)))) result)

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

@@ -1,5 +1,3 @@
-
-
 module ChuSQL.Server.Policy (
     configurePasswordPolicy,
     policyFromValues,

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

@@ -1,31 +1,55 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Server.Privileges
-    ( Grant (..), Membership (..), PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView (..)
-    , affectedAccounts, authorize, authorizeTables, authorizeConnect, filterTables, listRoleViews, listSelfGrants
-    , newPrivileges, normalizeObject, privilegeCommand, runPrivilegeCommand, claimObject, prepareObject, reconcileObjects, affectedObject
-    ) where
+module ChuSQL.Server.Privileges (
+    Grant (..),
+    Membership (..),
+    PrivilegeCommand (..),
+    PrivilegeError (..),
+    Privileges,
+    RoleView (..),
+    affectedAccounts,
+    authorize,
+    authorizeTables,
+    authorizeConnect,
+    filterTables,
+    listRoleViews,
+    listSelfGrants,
+    newPrivileges,
+    normalizeObject,
+    privilegeCommand,
+    runPrivilegeCommand,
+    claimObject,
+    prepareObject,
+    reconcileObjects,
+    affectedObject,
+) where
 
-import Data.Maybe (maybeToList)
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Protocol (Account (..))
 import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
-import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalIsCatalogManager)
+import ChuSQL.Server.Accounts (Principal, principalIsCatalogManager, principalIsRoot)
 import ChuSQL.Server.Backend (Backend (..), exprTables, statementTables, systemDatabaseName)
 import ChuSQL.Server.Catalog
 import qualified ChuSQL.Server.ObjectACL as OA
 import Data.List (nub, sort)
+import Data.Maybe (maybeToList)
 import Data.Text (Text)
 import qualified Data.Text as T
 
 -- 权限服务：稳定对象授权、角色继承与受影响会话展开。
 
 data PrivilegeError = PrivilegeError Text Text deriving (Show, Eq)
-data Membership = Membership { memberRole :: Text, memberUser :: Text } deriving (Show, Eq, Ord)
-data PrivilegeCommand = CreateRoleCommand Text | DropRoleCommand Text
-    | GrantPrivilegesCommand [Text] Text Text Bool | RevokePrivilegesCommand [Text] Text Text | RevokeGrantOptionCommand [Text] Text Text
-    | GrantRoleCommand Text [Text] | RevokeRoleCommand Text [Text] deriving (Show, Eq)
-data Privileges = Privileges { pvCatalog :: Catalog, pvBackend :: Backend }
+data Membership = Membership {memberRole :: Text, memberUser :: Text} deriving (Show, Eq, Ord)
+data PrivilegeCommand
+    = CreateRoleCommand Text
+    | DropRoleCommand Text
+    | GrantPrivilegesCommand [Text] Text Text Bool
+    | RevokePrivilegesCommand [Text] Text Text
+    | RevokeGrantOptionCommand [Text] Text Text
+    | GrantRoleCommand Text [Text]
+    | RevokeRoleCommand Text [Text]
+    deriving (Show, Eq)
+data Privileges = Privileges {pvCatalog :: Catalog, pvBackend :: Backend}
 
 -- 创建权限目录服务。
 newPrivileges :: Backend -> IO Privileges
@@ -56,7 +80,8 @@ runPrivilegeCommand service principal database command = withTables service $ ca
             known <- catalog (readRoleNames directory)
             case known of
                 Left err -> pure (Left err)
-                Right names | normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
+                Right names
+                    | normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
                     | normalizeRole role == "public" -> pure (Left (PrivilegeError "bad_request" "public is reserved for default privileges"))
                     | otherwise -> catalog (insertRole directory role)
     DropRoleCommand role
@@ -94,11 +119,13 @@ validateMembers names pairs role members
     foldMembers edges (member : rest)
         | child `elem` closureUp edges [parent] = Left (PrivilegeError "conflict" ("role membership would create a cycle: " <> parent <> " and " <> child))
         | otherwise = foldMembers ((parent, child) : edges) rest
-      where child = normalizeUser member
+      where
+        child = normalizeUser member
 
 -- 展开角色的继承闭包。
 closureUp :: [(Text, Text)] -> [Text] -> [Text]
-closureUp edges known = let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
+closureUp edges known =
+    let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
      in if null more then known else closureUp edges (nub (known ++ more))
 
 -- 展开成员和转授权变更影响的全部身份。
@@ -173,12 +200,13 @@ listRoleViews service = withTables service $ do
     members <- catalog (readMembers (pvCatalog service))
     case (,) <$> names <*> members of
         Left err -> pure (Left err)
-        Right (identities, pairs) -> sequence
-                                       <$>
-                                         mapM
+        Right (identities, pairs) ->
+            sequence
+                <$> mapM
                     (view pairs)
-                                           (sort
-                                              (map accountUser (filter (not . accountCanLogin) identities)))
+                    ( sort
+                        (map accountUser (filter (not . accountCanLogin) identities))
+                    )
   where
     -- 组装一个角色的公开权限视图。
     view members name = do
@@ -228,7 +256,8 @@ catalog = fmap (either (Left . storageError) Right)
 storageError :: String -> PrivilegeError
 storageError message = PrivilegeError code (T.pack message)
   where
-    code | message == "no database selected" = "no_database"
+    code
+        | message == "no database selected" = "no_database"
         | any (`T.isPrefixOf` T.pack message) ["permission denied:", "grant option required:", "object owner required", "administrator required", "system objects cannot be granted"] = "forbidden"
         | any (`T.isPrefixOf` T.pack message) ["unknown role:", "unknown table", "unknown database"] = "not_found"
         | message == "object ACL changed concurrently" = "conflict"

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

@@ -1,25 +1,31 @@
-module ChuSQL.Server.Security (readSecurity, writeSecurity) where
+module ChuSQL.Server.Security (readSecurity, writeSecurity, databaseSecurity, commitSecurity) where
 
-import Control.Monad (when)
 import Control.Concurrent.MVar
-import Control.Exception (bracket_, mask_)
+import Control.Exception (bracket, bracket_, mask_)
+import Control.Monad (when)
+import qualified Data.Map.Strict as Map
 import System.IO.Unsafe (unsafePerformIO)
 
--- 共享权限门：查询并行读取，权限和对象变更独占执行。
+-- 权限变更独占全局门，业务按库排序取门，允许不同库并行写。
+
+data Gate = Gate (MVar ()) (MVar ()) (MVar Int)
+
+-- 创建公平的共享读写门。
+newGate :: IO Gate
+newGate = Gate <$> newMVar () <*> newMVar () <*> newMVar 0
 
 {-# NOINLINE securityGate #-}
-securityGate :: (MVar (), MVar (), MVar Int)
-securityGate = unsafePerformIO $ do
-    turn <- newMVar ()
-    room <- newMVar ()
-    readers <- newMVar 0
-    pure (turn, room, readers)
+securityGate :: Gate
+securityGate = unsafePerformIO newGate
 
--- 并行执行权限稳定期间的查询。
-readSecurity :: IO a -> IO a
-readSecurity = bracket_ enter leave
+{-# NOINLINE databaseGates #-}
+databaseGates :: MVar (Map.Map String (Gate, Int))
+databaseGates = unsafePerformIO (newMVar Map.empty)
+
+-- 在共享门内执行并保证取消时归还计数。
+readGate :: Gate -> IO a -> IO a
+readGate (Gate turn room readers) = bracket_ enter leave
   where
-    (turn, room, readers) = securityGate
     -- 登记共享读取者。
     enter = withMVar turn $ \_ -> modifyMVar_ readers $ \count -> do
         when (count == 0) $ takeMVar room
@@ -29,8 +35,46 @@ readSecurity = bracket_ enter leave
         when (count == 1) $ putMVar room ()
         pure (count - 1)
 
--- 独占执行权限或对象变更。
+-- 独占执行写入及提交的校验与发布。
+writeGate :: Gate -> IO a -> IO a
+writeGate (Gate turn room _) action = withMVar turn $ \_ -> withMVar room (const action)
+
+-- 并行执行权限稳定期间的查询。
+readSecurity :: IO a -> IO a
+readSecurity = readGate securityGate
+
+-- 全局排除权限与对象变更期间的数据请求。
 writeSecurity :: IO a -> IO a
-writeSecurity action = withMVar turn $ \_ -> withMVar room (const action)
+writeSecurity = writeGate securityGate
+
+-- 按名称取库门，固定顺序避免跨库等待环。
+databaseSecurity :: [(String, Bool)] -> IO a -> IO a
+databaseSecurity accesses action = readSecurity (keyedSecurity accesses action)
+
+-- 只排序短暂提交检查，不阻塞行锁等待与准备。
+commitSecurity :: String -> IO a -> IO a
+commitSecurity database = keyedSecurity [("\0commit:" ++ database, True)]
+
+-- 管理有序键门及引用生命周期。
+keyedSecurity :: [(String, Bool)] -> IO a -> IO a
+keyedSecurity accesses action = bracket register unregister $ \gates -> lock gates action
   where
-    (turn, room, _) = securityGate
+    names = Map.toAscList (Map.fromListWith (||) (filter (not . null . fst) accesses))
+    -- 先登记所有等待者，防止等待中的门被释放。
+    register = modifyMVar databaseGates $ \existing -> do
+        entries <- mapM (entry existing) names
+        let updated = foldr (\(name, gate, count, _) -> Map.insert name (gate, count)) existing entries
+        pure (updated, entries)
+    -- 复用活跃门或创建首次访问的门。
+    entry existing (name, exclusive) = case Map.lookup name existing of
+        Just (gate, count) -> pure (name, gate, count + 1, exclusive)
+        Nothing -> do
+            gate <- newGate
+            pure (name, gate, 1, exclusive)
+    -- 最后一个持有者或等待者离开时回收门。
+    unregister entries = modifyMVar_ databaseGates $ \existing -> pure (foldr release existing entries)
+    -- 使用当前引用计数，避免覆盖并发登记。
+    release (name, _, _, _) = Map.update (\(gate, count) -> if count == 1 then Nothing else Just (gate, count - 1)) name
+    -- 递归持有有序门并在异常时逆序释放。
+    lock [] body = body
+    lock ((_, gate, _, exclusive) : rest) body = (if exclusive then writeGate else readGate) gate (lock rest body)

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

@@ -1,68 +1,73 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
-module ChuSQL.Server.Session
-    ( QueryResult (..)
-    , Session
-    , SessionError (..)
-    , engineErrorCode
-    , newSession
-    , newSessionWith
-    , sessionUser
-    , sessionIsAdmin
-    , sessionDatabase
-    , isPlainIdentifier
-    , authenticateSession
-    , authenticateSessionCoded
-    , authenticateSudoSessionCoded
-    , switchDatabase
-    , runStatement
-    , runStatementCoded
-    , runStorageCoded
-    , analyzeNormalizationCoded
-    , catalog
-    , accounts
-    , roleViews
-    , databases
-    , policyOf
-    , reloadPolicy
-    , queryResultJson
-    ) where
+module ChuSQL.Server.Session (
+    QueryResult (..),
+    Session,
+    SessionError (..),
+    engineErrorCode,
+    newSession,
+    closeSession,
+    newSessionWith,
+    sessionUser,
+    sessionIsAdmin,
+    sessionDatabase,
+    isPlainIdentifier,
+    authenticateSession,
+    authenticateSessionCoded,
+    authenticateSudoSessionCoded,
+    switchDatabase,
+    runStatement,
+    runStatementCoded,
+    runStorageCoded,
+    analyzeNormalizationCoded,
+    catalog,
+    accounts,
+    roleViews,
+    databases,
+    policyOf,
+    reloadPolicy,
+    queryResultJson,
+) where
 
-import ChuSQL.Core.Model (Database, Row, Table (..), Value (..), Column (..), typeName)
-import ChuSQL.Core.Protocol
-    ( SchemaColumn(..),
-      Account(..),
-      Request(..),
-      QueryResult(..),
-      TxnOp(..),
-      queryResultJson )
-import ChuSQL.Interface.Normalization
-import ChuSQL.Server.Normalization (normalizationBudget, normalizationReport)
-import Data.Aeson.Types (parseEither)
-import qualified Data.ByteString.Lazy as BL
-import ChuSQL.Core.Engine.Storage.IPC (TableInfo (..))
 import qualified ChuSQL.Core.Engine as Engine
 import qualified ChuSQL.Core.Engine.Error as E
+import ChuSQL.Core.Engine.Runtime.Dependencies (domainDependencies, queryTables, validateDependencies)
+import ChuSQL.Core.Engine.Storage.IPC (TableInfo (..))
 import ChuSQL.Core.Engine.Syntax.AST (Statement (..))
 import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
+import ChuSQL.Core.Model (Column (..), Database, Row, Table (..), Value (..), lastTablePart, typeName)
+import ChuSQL.Core.Protocol (
+    Account (..),
+    QueryResult (..),
+    Request (..),
+    SchemaColumn (..),
+    TxnOp (..),
+    queryResultJson,
+ )
 import ChuSQL.Interface.AccountTable (systemTableInfo)
 import ChuSQL.Interface.Auth (defaultSessionPolicy, newSessionStore)
+import ChuSQL.Interface.Normalization
 import ChuSQL.Server.Accounts
-import ChuSQL.Server.Backend (Backend (..), StatementResult (..), columnsFromStatement, scopeDdl)
+import ChuSQL.Server.Backend (Backend (..), StatementResult (..), applyTransactionMemory, columnsFromStatement, scopeDdl)
+import ChuSQL.Server.Normalization (normalizationBudget, normalizationReport)
 import ChuSQL.Server.Policy (configurePasswordPolicy)
-import ChuSQL.Server.Privileges (PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, Grant (..), affectedAccounts, affectedObject, authorize, authorizeTables, authorizeConnect, claimObject, prepareObject, reconcileObjects, filterTables, listRoleViews, listSelfGrants, newPrivileges, privilegeCommand, runPrivilegeCommand)
-import ChuSQL.Server.Security (readSecurity, writeSecurity)
+import ChuSQL.Server.Privileges (Grant (..), PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, affectedAccounts, affectedObject, authorize, authorizeConnect, authorizeTables, claimObject, filterTables, listRoleViews, listSelfGrants, newPrivileges, prepareObject, privilegeCommand, reconcileObjects, runPrivilegeCommand)
+import ChuSQL.Server.Security (commitSecurity, databaseSecurity, readSecurity, writeSecurity)
 import Control.Exception (IOException, try)
-import Data.Bifunctor (first)
-import Data.Char (isAlpha, isAlphaNum)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Maybe (isJust, fromMaybe)
-import qualified Data.IntMap.Strict as IM
-import qualified Data.IntSet as IS
-import Data.Text (Text)
-import qualified Data.Text as T
 import qualified Data.Aeson as A
 import qualified Data.Aeson.KeyMap as KM
+import Data.Aeson.Types (parseEither)
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Lazy as BL
+import Data.Char (isAlpha, isAlphaNum)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
+import Data.List (nub)
+import Data.Maybe (fromMaybe, isJust)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
 
 -- SQL 会话：Web、命令行与 TCP 服务器共用的账号、权限与语句执行入口。
@@ -97,6 +102,8 @@ data Transaction = Transaction
     , txSavepoints :: [(String, Database, [Statement])]
     , txStatements :: [Statement]
     , txObjects :: [(String, A.Value)]
+    , txToken :: Maybe String
+    , txSerializable :: Bool
     }
 
 -- | 开一个会话：账号与角色服务、配置策略都和 Web 端一致
@@ -117,6 +124,18 @@ newSessionWith backend name settingsFile changed = do
     transaction <- newIORef Nothing
     pure (Session backend accountsService privileges current principal identityStamp settingsFile transaction changed)
 
+-- 关闭连接时归还存储事务、版本引用与行锁。
+closeSession :: Session -> IO ()
+closeSession session = do
+    existing <- readIORef (ssTransaction session)
+    writeIORef (ssTransaction session) Nothing
+    case existing >>= txToken of
+        Nothing -> pure ()
+        Just token -> do
+            backend <- currentBackend session
+            result <- beRollbackTransaction backend token
+            either (ioError . userError) pure result
+
 -- | 当前生效的口令策略（只有管理员能看）
 policyOf :: Session -> IO (Either Text PasswordPolicy)
 policyOf session = do
@@ -195,7 +214,7 @@ storePrincipal session principal = do
         Right account -> do
             writeIORef (ssPrincipal session) (Just principal)
             writeIORef (ssIdentityStamp session) (Just (accountId account, accountRevision account))
-            writeIORef (ssTransaction session) Nothing
+            closeSession session
             writeIORef (ssCurrent session) ""
             pure (Right ())
 
@@ -216,7 +235,7 @@ switchDatabaseCoded session rawName
     | otherwise = go
   where
     name = T.toLower (T.strip rawName)
-    -- | 真的切库并记下当前库
+    -- \| 真的切库并记下当前库
     go = do
         who <- readIORef (ssPrincipal session)
         allowed <- case who of
@@ -237,17 +256,35 @@ runStatement session sql = fmap (first sessMessage) (runStatementCoded session s
 
 -- | 跑一条语句（带错误码）
 runStatementCoded :: Session -> Text -> IO (Either SessionError QueryResult)
-runStatementCoded session sql = gate $ do
+runStatementCoded session sql = do
+    current <- readIORef (ssCurrent session)
+    gate current $ do
         valid <- validatePrincipal session
         case valid of Left err -> pure (Left err); Right () -> runStatementUnlocked session sql
   where
-    gate = case parseStatement (T.unpack sql) of
+    -- 对象及权限变更独占，数据请求按来源库排序。
+    gate current = case parseStatement (T.unpack sql) of
+        Right CommitTransaction -> databaseSecurity [(T.unpack current, not (beConcurrentTransactions (ssBackend session)))]
         Right statement | transactionDdl statement || isJust (accountCommand statement) || isJust (privilegeCommand statement) -> writeSecurity
-        _ -> readSecurity
+        Right statement -> databaseSecurity (accesses current statement)
+        Left _ -> readSecurity
+    -- 当前库写入独占，跨库查询依赖共享。
+    accesses current statement =
+        (T.unpack current, writing statement && not (beConcurrentTransactions (ssBackend session))) : [(source name, False) | name <- queryTables statement]
+      where
+        -- 无限定表使用当前工作库。
+        source name = case break (== '.') name of
+            (database, '.' : _) -> T.unpack (T.toLower (T.pack database))
+            _ -> T.unpack current
+    -- 只有数据写语句需要独占目标库。
+    writing Insert{} = True
+    writing Update{} = True
+    writing Delete{} = True
+    writing _ = False
 
 -- 在权限门内检查并执行管理员存储请求。
 runStorageCoded :: Session -> A.Value -> IO (Either SessionError A.Value)
-runStorageCoded session payload = writeSecurity $ do
+runStorageCoded session payload = gate $ do
     valid <- validatePrincipal session
     who <- readIORef (ssPrincipal session)
     case valid of
@@ -256,6 +293,11 @@ runStorageCoded session payload = writeSecurity $ do
             Nothing -> pure (Left (SessionError "unauthorized" "sign in first"))
             Just principal | not (principalIsRoot principal) -> pure (Left (SessionError "forbidden" "administrator required"))
             Just _ -> fmap (first (SessionError "storage_error" . T.pack)) (beStorage (ssBackend session) payload)
+  where
+    -- 在线整理期间允许普通数据语句进入。
+    gate = case payload of
+        A.Object object | KM.lookup "method" object == Just (A.String "compact") -> readSecurity
+        _ -> writeSecurity
 
 -- 检查登录身份的当前版本和启用状态。
 validatePrincipal :: Session -> IO (Either SessionError ())
@@ -285,7 +327,8 @@ runStatementUnlocked session sql = case parseStatement (T.unpack sql) of
                     Right () -> do
                         current <- readIORef (ssCurrent session)
                         pure (Right (emptyResult (Just current)))
-    Right BeginTransaction -> beginTransaction session
+    Right BeginTransaction -> beginTransaction session False
+    Right BeginSerializableTransaction -> beginTransaction session True
     Right CommitTransaction -> commitTransaction session
     Right RollbackTransaction -> rollbackTransaction session
     Right (Savepoint name) -> savepointTransaction session (T.pack name)
@@ -306,6 +349,7 @@ runStatementUnlocked session sql = case parseStatement (T.unpack sql) of
                         Left err -> pure (Left err)
                         Right ()
                             | isJust transaction && transactionData statement -> runInTransaction session statement
+                            | beConcurrentTransactions (ssBackend session) && transactionData statement -> runAutocommit session statement
                             | otherwise -> runObjectStatement session statement sql
     Left _ -> runPlain session sql
 
@@ -314,6 +358,7 @@ transactionDdl :: Statement -> Bool
 transactionDdl statement = case statement of
     CreateTable{} -> True
     CreateDomain{} -> True
+    AlterDomain{} -> True
     DropDomain{} -> True
     DropTable{} -> True
     CreateIndex{} -> True
@@ -339,14 +384,14 @@ transactionData statement = case statement of
     _ -> False
 
 -- | 开事务：把当前库整库做一份快照当起点
-beginTransaction :: Session -> IO (Either SessionError QueryResult)
-beginTransaction session = do
+beginTransaction :: Session -> Bool -> IO (Either SessionError QueryResult)
+beginTransaction session serializable = do
     allowed <- sessionConnectAllowed session
-    case allowed of Left err -> pure (Left err); Right () -> beginAuthorized session
+    case allowed of Left err -> pure (Left err); Right () -> beginAuthorized session serializable
 
 -- 在连接权限复核后建立事务快照。
-beginAuthorized :: Session -> IO (Either SessionError QueryResult)
-beginAuthorized session = do
+beginAuthorized :: Session -> Bool -> IO (Either SessionError QueryResult)
+beginAuthorized session serializable = do
     current <- readIORef (ssCurrent session)
     existing <- readIORef (ssTransaction session)
     case existing of
@@ -355,15 +400,20 @@ beginAuthorized session = do
             | T.null current -> pure (Left (SessionError "no_database" "no database selected"))
             | otherwise -> do
                 backend <- currentBackend session
-                snapshotResult <- beSnapshot backend
+                snapshotResult <-
+                    if beConcurrentTransactions backend
+                        then beBeginTransaction backend serializable
+                        else fmap (fmap (Nothing,)) (beSnapshot backend)
                 case snapshotResult of
                     Left err -> pure (Left (engineErrorCode err))
-                    Right db -> do
+                    Right (token, db) -> do
                         objects <- snapshotObjectIds session (map fst db)
                         case objects of
-                            Left err -> pure (Left err)
+                            Left err -> do
+                                released <- maybe (pure (Right ())) (beRollbackTransaction backend) token
+                                pure (either (Left . engineErrorCode) (const (Left err)) released)
                             Right ids -> do
-                                writeIORef (ssTransaction session) (Just (Transaction db db [] [] ids))
+                                writeIORef (ssTransaction session) (Just (Transaction db db [] [] ids token serializable))
                                 pure (Right (emptyResult (Just current)))
 
 -- | 提交：把快照差分交给存储层应用，成功才结束事务
@@ -379,25 +429,84 @@ commitTransaction session = do
             identities <- snapshotObjectIds session (map fst (txBase transaction))
             case connected >> sequence permissions >> identities of
                 Left err -> pure (Left err)
-                Right ids | ids /= txObjects transaction -> pure (Left (SessionError "serialization_failure" "transaction object identity changed"))
+                Right ids
+                    | ids /= txObjects transaction -> pure (Left (SessionError "serialization_failure" "transaction object identity changed"))
                     | otherwise -> commitAuthorized session current transaction
 
 -- 对象和权限复核后提交事务差分。
 commitAuthorized :: Session -> Text -> Transaction -> IO (Either SessionError QueryResult)
-commitAuthorized session current transaction = do
+commitAuthorized session current transaction
+    | Just token <- txToken transaction = commitSecurity (T.unpack current) (commitMvcc session current transaction token)
+    | otherwise = commitLegacy session current transaction
+
+-- 在短提交门内校验最新合并行集并发布版本。
+commitMvcc :: Session -> Text -> Transaction -> String -> IO (Either SessionError QueryResult)
+commitMvcc session current transaction token = do
+    backend <- currentBackend session
+    preview <- bePreviewTransaction backend token
+    case preview of
+        Left err -> pure (Left (engineErrorCode err))
+        Right (checkpoint, candidate) -> do
+            let modified = changedTables (txBase transaction) (txStaged transaction)
+                names = modified ++ domainDependencies (txBase transaction) modified
+                dependencies = [(name, table) | (name, table) <- txBase transaction, name `elem` names]
+                checked = validateDependencies dependencies candidate >> mapM_ (validateFinal candidate) modified
+            case checked of
+                Left err -> pure (Left (SessionError "serialization_failure" (T.pack err)))
+                Right () -> do
+                    result <- beCommitTransaction backend token checkpoint
+                    case result of
+                        Left err -> pure (Left (engineErrorCode err))
+                        Right () -> do
+                            writeIORef (ssTransaction session) Nothing
+                            pure (Right (emptyResult (Just current)))
+  where
+    -- 复用 SQL 最终行集约束，避免存储重复规则。
+    validateFinal candidate name = maybe (Left "transaction table missing") (Engine.validateTableRows candidate) (lookup name candidate)
+
+-- 内存后端保留原差分提交与冲突行为。
+commitLegacy :: Session -> Text -> Transaction -> IO (Either SessionError QueryResult)
+commitLegacy session current transaction = do
     backend <- currentBackend session
     liveResult <- beSnapshot backend
     case liveResult of
         Left err -> pure (Left (engineErrorCode err))
-                Right live -> let diffs = transactionDiffs (txBase transaction) (txStaged transaction) live in case transactionConflict diffs of
-                    Just msg -> pure (Left (SessionError "serialization_failure" (T.pack msg)))
-                    Nothing -> do
-                        applied <- beApplyTransaction backend (transactionOps diffs)
+        Right live -> do
+            let base = txBase transaction
+                diffs = transactionDiffs base (txStaged transaction) live
+                modified =
+                    [ name
+                    | (name, diff) <- diffs
+                    , not (null (tdDeletes diff) && null (tdWrites diff)) || isJust (tdReplace diff)
+                    ]
+                readTables = if txSerializable transaction && not (null modified) then nub (map lastTablePart (concatMap queryTables (txStatements transaction))) else []
+                names = modified ++ readTables ++ domainDependencies base (modified ++ readTables)
+                dependencies = [(name, table) | (name, table) <- base, name `elem` names]
+                ops = transactionOps diffs
+                checked = do
+                    validateDependencies dependencies live
+                    maybe (Right ()) Left (transactionConflict diffs)
+                    mapM_ (validateRead base live) readTables
+                    candidate <- applyTransactionMemory ops live
+                    mapM_ (validateFinal candidate) modified
+            case checked of
+                Left msg -> pure (Left (SessionError "serialization_failure" (T.pack msg)))
+                Right () -> do
+                    applied <- beApplyTransaction backend ops
                     case applied of
                         Left err -> pure (Left (engineErrorCode err))
                         Right () -> do
                             writeIORef (ssTransaction session) Nothing
                             pure (Right (emptyResult (Just current)))
+  where
+    -- 拒绝读过的表出现数据变化或幻行。
+    validateRead base live name = case (lookup name base, lookup name live) of
+        (Just before, Just after) | tableRows before == tableRows after -> Right ()
+        _ -> Left ("serializable transaction read changed: " ++ name)
+    -- 复用引擎规则检查合并后的最终行集。
+    validateFinal candidate name = case lookup name candidate of
+        Nothing -> Left ("transaction table missing: " ++ name)
+        Just table -> Engine.validateTableRows candidate table
 
 -- 检查当前数据库连接权限。
 sessionConnectAllowed :: Session -> IO (Either SessionError ())
@@ -412,7 +521,9 @@ sessionConnectAllowed session = do
 snapshotObjectIds :: Session -> [String] -> IO (Either SessionError [(String, A.Value)])
 snapshotObjectIds session names = do
     database <- readIORef (ssCurrent session)
-    if database == "system" then pure (Right []) else do
+    if database == "system"
+        then pure (Right [])
+        else do
             results <- mapM (one database) (filter (not . T.isPrefixOf "__system_" . T.pack) names)
             pure (sequence results)
   where
@@ -431,7 +542,12 @@ rollbackTransaction session = do
     existing <- readIORef (ssTransaction session)
     case existing of
         Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
-        Just _ -> do
+        Just transaction -> do
+            backend <- currentBackend session
+            result <- maybe (pure (Right ())) (beRollbackTransaction backend) (txToken transaction)
+            case result of
+                Left err -> pure (Left (engineErrorCode err))
+                Right () -> do
                     writeIORef (ssTransaction session) Nothing
                     pure (Right (emptyResult (Just current)))
 
@@ -444,7 +560,7 @@ savepointTransaction session name = do
         Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
         Just transaction -> do
             let stack = txSavepoints transaction ++ [(T.unpack name, txStaged transaction, txStatements transaction)]
-            writeIORef (ssTransaction session) (Just transaction {txSavepoints = stack})
+            writeIORef (ssTransaction session) (Just transaction{txSavepoints = stack})
             pure (Right (emptyResult (Just current)))
 
 -- | 回滚到保存点：事务状态退回保存点，该保存点保留
@@ -458,9 +574,12 @@ rollbackToSavepoint session name = do
             Nothing -> pure (Left (SessionError "query_error" ("no such savepoint: " <> name)))
             Just index -> do
                 let (_, staged, statements) = txSavepoints transaction !! index
-                writeIORef
-                    (ssTransaction session)
-                    (Just transaction {txStaged = staged, txStatements = statements, txSavepoints = take (index + 1) (txSavepoints transaction)})
+                let next = transaction{txStaged = staged, txStatements = statements, txSavepoints = take (index + 1) (txSavepoints transaction)}
+                stagedResult <- stageMvcc session next
+                case stagedResult of
+                    Left err -> pure (Left err)
+                    Right () -> do
+                        writeIORef (ssTransaction session) (Just next)
                         pure (Right (emptyResult (Just current)))
 
 -- | 释放保存点：该保存点与它之后的保存点一起丢掉
@@ -473,7 +592,7 @@ releaseSavepoint session name = do
         Just transaction -> case savepointIndex name (txSavepoints transaction) of
             Nothing -> pure (Left (SessionError "query_error" ("no such savepoint: " <> name)))
             Just index -> do
-                writeIORef (ssTransaction session) (Just transaction {txSavepoints = take index (txSavepoints transaction)})
+                writeIORef (ssTransaction session) (Just transaction{txSavepoints = take index (txSavepoints transaction)})
                 pure (Right (emptyResult (Just current)))
 
 -- | 最近一次同名保存点的下标
@@ -483,7 +602,7 @@ savepointIndex name entries =
         [] -> Nothing
         hits -> Just (last hits)
 
--- | 事务里跑一条数据语句：只动内存快照，不碰存储层
+-- | 执行事务数据语句并取得修改行锁
 runInTransaction :: Session -> Statement -> IO (Either SessionError QueryResult)
 runInTransaction session statement = do
     existing <- readIORef (ssTransaction session)
@@ -493,9 +612,49 @@ runInTransaction session statement = do
         Just transaction -> case scopeDdl (T.unpack current) statement >>= Engine.runStatement (txStaged transaction) of
             Left err -> pure (Left (engineErrorCode err))
             Right (staged, rows) -> do
-                writeIORef (ssTransaction session) (Just transaction {txStaged = staged, txStatements = statement : txStatements transaction})
+                let next = transaction{txStaged = staged, txStatements = statement : txStatements transaction}
+                locked <- stageMvcc session next
+                case locked of
+                    Left err -> pure (Left err)
+                    Right () -> do
+                        writeIORef (ssTransaction session) (Just next)
                         pure (Right (resultOfStaged (txStaged transaction) statement rows))
 
+-- 自动提交语句同样拥有快照和原子提交边界。
+runAutocommit :: Session -> Statement -> IO (Either SessionError QueryResult)
+runAutocommit session statement = do
+    begun <- beginTransaction session False
+    case begun of
+        Left err -> pure (Left err)
+        Right _ -> do
+            executed <- runInTransaction session statement
+            case executed of
+                Left err -> do
+                    rolled <- rollbackTransaction session
+                    pure (const (Left err) =<< rolled)
+                Right rows -> do
+                    committed <- commitTransaction session
+                    case committed of
+                        Right _ -> pure (Right rows)
+                        Left err -> do
+                            rolled <- rollbackTransaction session
+                            pure (const (Left err) =<< rolled)
+
+-- 比较事务最终行集，保留原表顺序。
+changedTables :: Database -> Database -> [String]
+changedTables base staged = [name | (name, table) <- staged, fmap tableRows (lookup name base) /= Just (tableRows table)]
+
+-- 获取本事务实际修改行的锁并更新读依赖。
+stageMvcc :: Session -> Transaction -> IO (Either SessionError ())
+stageMvcc session transaction = case txToken transaction of
+    Nothing -> pure (Right ())
+    Just token -> do
+        backend <- currentBackend session
+        let modified = changedTables (txBase transaction) (txStaged transaction)
+            ops = [TxnReplace name (tableRows table) | (name, table) <- txStaged transaction, name `elem` modified]
+            dependencies = nub (map lastTablePart (concatMap queryTables (txStatements transaction)))
+        fmap (first engineErrorCode) (beStageTransaction backend token ops dependencies)
+
 -- | 事务内的结果集：空结果回落到解析出来的列名
 resultOfStaged :: Database -> Statement -> [Row] -> QueryResult
 resultOfStaged db statement rows = resultOf (StatementResult cols rows)
@@ -516,7 +675,7 @@ data TableDiff = TableDiff
 transactionOps :: [(String, TableDiff)] -> [TxnOp]
 transactionOps = concatMap opsOf
   where
-    -- | 一张表的请求：先删后写
+    -- \| 一张表的请求：先删后写
     opsOf (name, diff) =
         [TxnDelete name (tdDeletes diff) | not (null (tdDeletes diff))]
             ++ [TxnUpsert name (tdWrites diff) | not (null (tdWrites diff))]
@@ -533,16 +692,16 @@ transactionConflict diffs =
 transactionDiffs :: Database -> Database -> Database -> [(String, TableDiff)]
 transactionDiffs base staged live = [(name, diffFor name) | name <- names]
   where
-    -- | 事务里碰得着的表：数据语句不增删表
+    -- \| 事务里碰得着的表：数据语句不增删表
     names = nubKeys (map fst base ++ map fst staged)
 
-    -- | 一张表的差异
+    -- \| 一张表的差异
     diffFor name
         | stagedRows == baseRows = emptyDiff
         | all (isJust . rowKey) (baseRows ++ stagedRows) = keyedDiff
         -- 动过，库里还是基线：整表替换
-        | liveRows == baseRows = emptyDiff {tdReplace = Just stagedRows}
-        | otherwise = emptyDiff {tdConflict = Just ("write conflict on table " ++ name)}
+        | liveRows == baseRows = emptyDiff{tdReplace = Just stagedRows}
+        | otherwise = emptyDiff{tdConflict = Just ("write conflict on table " ++ name)}
       where
         baseRows = rowsOf name base
         stagedRows = rowsOf name staged
@@ -577,13 +736,13 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
                     [] -> Nothing
                 }
 
-    -- | 没有差异的空结果
+    -- \| 没有差异的空结果
     emptyDiff = TableDiff [] [] Nothing Nothing
 
-    -- | 表名去重但保持顺序
+    -- \| 表名去重但保持顺序
     nubKeys = foldr (\name acc -> if name `elem` acc then acc else name : acc) []
 
-    -- | 库里某张表的行
+    -- \| 库里某张表的行
     rowsOf name db = maybe [] tableRows (lookup name db)
 
 -- | 按整数 id 建立保留首行的查找表
@@ -759,14 +918,31 @@ currentBackend session = do
 showIdentities :: Session -> IO (Either SessionError QueryResult)
 showIdentities session = do
     admin <- maybe False principalIsCatalogManager <$> readIORef (ssPrincipal session)
-    if not admin then pure (Left (SessionError "forbidden" "catalog manager required")) else do
+    if not admin
+        then pure (Left (SessionError "forbidden" "catalog manager required"))
+        else do
             result <- beAccounts (ssBackend session) ReqAccountsList
             pure $ case result of
                 Left err -> Left (SessionError "storage_error" (T.pack err))
-            Right identities -> Right (QueryResult ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "allow_sudo_auth", "created_at"]
-                [[VInt (fromInteger (accountId a)), VStr (T.unpack (accountUser a)), VBool (accountCanLogin a),
-                    VBool (accountIsSuperuser a), VBool (accountEnabled a), VBool (accountSystemCatalogManager a), VBool (accountAllowSudoAuth a), VStr (T.unpack (accountRegisteredAt a))] | a <- identities]
-                (length identities) False Nothing)
+                Right identities ->
+                    Right
+                        ( QueryResult
+                            ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "allow_sudo_auth", "created_at"]
+                            [ [ VInt (fromInteger (accountId a))
+                              , VStr (T.unpack (accountUser a))
+                              , VBool (accountCanLogin a)
+                              , VBool (accountIsSuperuser a)
+                              , VBool (accountEnabled a)
+                              , VBool (accountSystemCatalogManager a)
+                              , VBool (accountAllowSudoAuth a)
+                              , VStr (T.unpack (accountRegisteredAt a))
+                              ]
+                            | a <- identities
+                            ]
+                            (length identities)
+                            False
+                            Nothing
+                        )
 
 -- | 执行身份管理并通知受影响会话
 runAccount :: Session -> AccountCommand -> IO (Either SessionError QueryResult)
@@ -849,10 +1025,9 @@ resultOf result =
         , qrDatabase = Nothing
         }
   where
-    -- | 按列名取单元格
+    -- \| 按列名取单元格
     cellOf row name = fromMaybe VNull (lookup name row)
 
-
 -- 展示当前登录身份自己的有效权限。
 showSelfGrants :: Session -> IO (Either SessionError QueryResult)
 showSelfGrants session = do
@@ -863,10 +1038,15 @@ showSelfGrants session = do
             grants <- listSelfGrants (ssPrivileges session) principal
             pure $ case grants of
                 Left err -> Left (privilegeErrorOf err)
-                Right rows -> Right (QueryResult ["identity", "privilege", "object", "grant_option"]
+                Right rows ->
+                    Right
+                        ( QueryResult
+                            ["identity", "privilege", "object", "grant_option"]
                             [[VStr (T.unpack (grantRole grant)), VStr (T.unpack (grantPrivilege grant)), VStr (T.unpack (grantObject grant)), VBool (grantable grant)] | grant <- rows]
-                    (length rows) False Nothing)
-
+                            (length rows)
+                            False
+                            Nothing
+                        )
 
 -- 在连接视图及权限稳定期间分析范式。
 analyzeNormalizationCoded :: Session -> NormalizationRequest -> IO (Either SessionError A.Value)
@@ -902,7 +1082,8 @@ normalizationView session table payload = do
             Left message -> pure (Left ("storage_error", message))
             Right identity -> case transaction of
                 Just tx -> case (lookup (T.unpack table) (txStaged tx), lookup (T.unpack table) (txObjects tx)) of
-                    (Just relation, Just oldObject) | objectIdentity oldObject == Right identity ->
+                    (Just relation, Just oldObject)
+                        | objectIdentity oldObject == Right identity ->
                             pure (normalizationReport identity (map normalizationColumn (tableCols relation)) "transaction_snapshot" payload)
                     _ -> pure (Left ("conflict", "normalization snapshot object has changed"))
                 Nothing -> do

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

@@ -1,6 +1,6 @@
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 module ChuSQL.Server.TCP (
     ServerConfig (..),
@@ -16,18 +16,17 @@ module ChuSQL.Server.TCP (
     isLocalPeer,
 ) where
 
+import qualified ChuSQL.Core.Engine.Error as E
+import ChuSQL.Core.Protocol (Account (..), Request (ReqIdentityInitialize))
 import ChuSQL.Interface.Config (ServerConfig (..), defaultServerConfig, loadServerConfigAt)
-import ChuSQL.Interface.Sudo (SudoCredential, createSudoCredential, removeSudoCredential, sudoChallenge, validSudoChallenge, isLocalPeer)
-import Data.Time.Clock (UTCTime, getCurrentTime)
 import ChuSQL.Interface.Policy (PasswordPolicy (..))
 import ChuSQL.Interface.Protocol (ClientRequest (..), ServerResponse (..), decodeRequest, encodeResponse, protocolVersion)
 import ChuSQL.Interface.RateLimit (RateLimiter, rateLimitBlock, rateLimitClear, rateLimitRecord)
-import qualified ChuSQL.Core.Engine.Error as E
-import ChuSQL.Core.Protocol (Account (..), Request (ReqIdentityInitialize))
+import ChuSQL.Interface.Sudo (SudoCredential, createSudoCredential, isLocalPeer, removeSudoCredential, sudoChallenge, validSudoChallenge)
 import ChuSQL.Server.Backend (Backend (..))
-import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, authenticateSudoSessionCoded, isPlainIdentifier, catalog, databases, newSessionWith, policyOf, reloadPolicy, roleViews, analyzeNormalizationCoded, runStatementCoded, runStorageCoded, sessionIsAdmin, sessionUser)
-import ChuSQL.Server.Security (writeSecurity)
 import ChuSQL.Server.Privileges (newPrivileges, reconcileObjects)
+import ChuSQL.Server.Security (writeSecurity)
+import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, analyzeNormalizationCoded, authenticateSessionCoded, authenticateSudoSessionCoded, catalog, closeSession, databases, isPlainIdentifier, newSessionWith, policyOf, reloadPolicy, roleViews, runStatementCoded, runStorageCoded, sessionIsAdmin, sessionUser)
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
 import Control.Exception (IOException, bracket, finally, onException, try)
@@ -39,6 +38,7 @@ import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Time.Clock (UTCTime, getCurrentTime)
 import Network.Socket (
     AddrInfo (..),
     AddrInfoFlag (AI_PASSIVE),
@@ -54,8 +54,8 @@ import Network.Socket (
     defaultHints,
     defaultProtocol,
     getAddrInfo,
-    getSocketName,
     getPeerName,
+    getSocketName,
     listen,
     setSocketOption,
     socket,
@@ -106,11 +106,11 @@ dropConnectionsOf live names = do
     mapM_ markDropped hits
     pure (length hits)
   where
-    -- | 这条连接登录的账号在名单里吗
+    -- \| 这条连接登录的账号在名单里吗
     isOf wanted entry = do
         current <- readIORef (leWho entry)
         pure (maybe False (\name -> T.toLower name `elem` wanted) current)
-    -- | 只做标记：连接在下一次请求应答后收工
+    -- \| 只做标记：连接在下一次请求应答后收工
     markDropped entry = writeIORef (leDropped entry) True
 
 -- 服务器
@@ -163,10 +163,12 @@ runServer :: ServerEnv -> (Int -> IO ()) -> IO ()
 runServer env announce = bracket (listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))) close $ \sock -> do
     port <- actualPort sock
     enableSudo env port
-    (do
+    ( do
             announce port
             stopped <- newMVar False
-        acceptLoop env sock stopped) `finally` disableSudo env
+            acceptLoop env sock stopped
+        )
+        `finally` disableSudo env
 
 -- 为显式配置的本机身份映射创建凭据。
 enableSudo :: ServerEnv -> Int -> IO ()
@@ -174,10 +176,11 @@ enableSudo env port
     | T.null user = pure ()
     | not (isPlainIdentifier user) = ioError (userError "sudo_auth_user must be a plain identity name")
     | otherwise = modifyMVar_ (srvSudo env) $ \case
-                                                Just _
-                                                  -> ioError (userError "sudo authentication is already running")
-                                                Nothing
-                                                  -> do credential <- createSudoCredential port
+        Just _ ->
+            ioError (userError "sudo authentication is already running")
+        Nothing ->
+            do
+                credential <- createSudoCredential port
                 hPutStrLn
                     stderr
                     ("sudo_auth enabled: local elevated identity -> " ++ T.unpack user)
@@ -227,7 +230,7 @@ actualPort sock = do
 acceptLoop :: ServerEnv -> Socket -> MVar Bool -> IO ()
 acceptLoop env sock stopped = loop
   where
-    -- | 等下一个连接
+    -- \| 等下一个连接
     loop = do
         stop <- readMVar stopped
         if stop
@@ -260,13 +263,13 @@ serveConnection env conn = do
     entry <- newLiveEntry (isLocalPeer peer)
     unregister <- registerConnection (srvLive env) entry
     session <- newSessionWith (srvBackend env) (srvRootName env) (srvSettingsFile env) (void . dropConnectionsOf (srvLive env))
-    outcome <- try (loop h session entry BSC.empty `finally` unregister) :: IO (Either IOException ())
+    outcome <- try (loop h session entry BSC.empty `finally` (closeSession session `finally` unregister)) :: IO (Either IOException ())
     case outcome of
         Left err | not (isEOFError err) -> hPutStrLn stderr ("connection error: " ++ show err)
         _ -> pure ()
     void (try (hClose h) :: IO (Either IOException ()))
   where
-    -- | 逐行读请求并应答
+    -- \| 逐行读请求并应答
     loop h session entry pending = do
         frame <- readRequestLine h (scMaxMessage (srvConfig env)) pending
         case frame of
@@ -281,7 +284,7 @@ serveConnection env conn = do
                             (response, keepGoing) <- dispatch env session entry request
                             send h response
                             when keepGoing $ loop h session entry remaining
-    -- | 发一条响应并冲缓冲
+    -- \| 发一条响应并冲缓冲
     send h response = do
         BLC.hPutStr h (encodeResponse response)
         BLC.hPutStr h "\n"
@@ -291,7 +294,7 @@ serveConnection env conn = do
 readRequestLine :: Handle -> Int -> BSC.ByteString -> IO (Maybe (BSC.ByteString, BSC.ByteString))
 readRequestLine handle limit = collect [] 0
   where
-    -- | 按块读取至换行、超限或 EOF
+    -- \| 按块读取至换行、超限或 EOF
     collect parts total bytes = case BSC.elemIndex '\n' bytes of
         Just offset -> finish (BSC.take offset bytes : parts) (BSC.drop (offset + 1) bytes)
         Nothing
@@ -299,13 +302,14 @@ readRequestLine handle limit = collect [] 0
             | otherwise -> do
                 next <- BSC.hGetSome handle (max 1 (min 4094 (limit - used) + 2))
                 if BSC.null next
-                    then if used == 0
+                    then
+                        if used == 0
                             then ioError (mkIOError eofErrorType "read request" (Just handle) Nothing)
                             else finish (bytes : parts) BSC.empty
                     else collect (bytes : parts) used next
           where
             used = total + BSC.length bytes
-    -- | 合并并校验一行的有效长度
+    -- \| 合并并校验一行的有效长度
     finish parts remaining = do
         let line = BSC.dropWhileEnd (== '\r') (BSC.concat (reverse parts))
         pure (if BSC.length line > limit then Nothing else Just (line, remaining))
@@ -387,7 +391,10 @@ sudoLogin env session entry user proof = do
     who <- sessionUser session
     let key = T.toLower (T.strip user)
         mapped = maybe "" (\(_, name, _) -> name) configured
-        valid = leLocal entry && isNothing who && key == mapped
+        valid =
+            leLocal entry
+                && isNothing who
+                && key == mapped
                 && case configured of
                     Just (_, _, credential) -> validSudoChallenge credential now challenge key proof
                     Nothing -> False
@@ -408,8 +415,15 @@ sudoLogin env session entry user proof = do
                     writeIORef (leWho entry) (Just key)
                     admin <- sessionIsAdmin session
                     pure (RespLogin key admin)
-    hPutStrLn stderr ("sudo_auth attempt: mapped_user=" ++ T.unpack mapped
-        ++ " local=" ++ show (leLocal entry) ++ " result=" ++ auditResult response)
+    hPutStrLn
+        stderr
+        ( "sudo_auth attempt: mapped_user="
+            ++ T.unpack mapped
+            ++ " local="
+            ++ show (leLocal entry)
+            ++ " result="
+            ++ auditResult response
+        )
     pure response
   where
     -- 提取不包含凭据的认证审计结果。
@@ -463,5 +477,5 @@ trimResult limit result
     | otherwise = result
 
 -- | show 成 Text
-tshow :: Show a => a -> Text
+tshow :: (Show a) => a -> Text
 tshow = T.pack . show

chusql-server/test/Spec.hs

@@ -3,7 +3,6 @@
 
 module Main (main) where
 
-import Data.Either (lefts)
 import ChuSQL.Core.Engine.Storage.IPC (
     Account (..),
     Request (ReqAccountCreate, ReqAccountReset, ReqAccountsList, ReqIdentityAlter),
@@ -13,20 +12,28 @@ import ChuSQL.Core.Engine.Storage.IPC (
     setStorageLink,
  )
 import ChuSQL.Core.Engine.Syntax.AST (Statement)
-import ChuSQL.Interface.Normalization
-import ChuSQL.Server.Normalization (normalizationBudget, normalizationReport, schemaFingerprint)
-import ChuSQL.Core.Protocol (SchemaColumn (..))
-import Data.IORef (newIORef, readIORef, writeIORef)
 import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
 import ChuSQL.Core.Model (Database, Histogram (..), Row, Table (..), TableIdentity (..), Value (..), pattern TInt, pattern TStr)
+import ChuSQL.Core.Protocol (SchemaColumn (..), TxnOp (..))
 import ChuSQL.Interface.Auth (hashPasswordWith)
-import ChuSQL.Interface.Protocol (ClientRequest (..), Grant (..), RoleView (..), ServerResponse (..), decodeRequest, encodeResponse, encodeRequest, decodeResponse)
+import ChuSQL.Interface.Link (clientQuery, clientSudoLogin, closeClient, connectClient)
+import ChuSQL.Interface.Normalization
+import ChuSQL.Interface.Protocol (ClientRequest (..), Grant (..), RoleView (..), ServerResponse (..), decodeRequest, decodeResponse, encodeRequest, encodeResponse)
 import ChuSQL.Interface.RateLimit (newRateLimiter)
-import ChuSQL.Interface.Link (connectClient, closeClient, clientSudoLogin, clientQuery)
-import ChuSQL.Interface.Sudo (SudoCredential, newSudoCredential, sudoProof, verifySudoProof, validSudoChallenge,
-    createSudoCredential, removeSudoCredential, readSudoCredential, sudoPrivileged)
+import ChuSQL.Interface.Sudo (
+    SudoCredential,
+    createSudoCredential,
+    newSudoCredential,
+    readSudoCredential,
+    removeSudoCredential,
+    sudoPrivileged,
+    sudoProof,
+    validSudoChallenge,
+    verifySudoProof,
+ )
 import ChuSQL.Server.Accounts (Principal (..), ensureRootAccount)
-import ChuSQL.Server.Backend (Backend (..), StatementResult (..), ipcBackend, memoryBackend)
+import ChuSQL.Server.Backend (Backend (..), StatementResult (..), applyTransactionMemory, ipcBackend, memoryBackend)
+import ChuSQL.Server.Normalization (normalizationBudget, normalizationReport, schemaFingerprint)
 import ChuSQL.Server.Privileges (
     PrivilegeCommand (..),
     PrivilegeError (..),
@@ -35,29 +42,28 @@ import ChuSQL.Server.Privileges (
     authorize,
     authorizeConnect,
     claimObject,
-    prepareObject,
     listRoleViews,
     listSelfGrants,
     newPrivileges,
+    prepareObject,
     runPrivilegeCommand,
  )
-import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), newSession, runStatementCoded, runStorageCoded, authenticateSessionCoded)
+import ChuSQL.Server.Security (databaseSecurity, writeSecurity)
+import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), authenticateSessionCoded, newSession, runStatementCoded, runStorageCoded)
 import ChuSQL.Server.TCP (
     ServerConfig (..),
     ServerEnv (..),
     ServerHandle (..),
     defaultServerConfig,
+    isLocalPeer,
     loadServerConfigAt,
     newServerEnv,
     startServer,
-    isLocalPeer,
  )
-import Control.Concurrent (forkIO, forkFinally, killThread, threadDelay)
+import Control.Concurrent (forkFinally, forkIO, killThread, threadDelay)
 import Control.Concurrent.MVar (MVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar)
-import System.Timeout (timeout)
-import Control.Exception (IOException, bracket, finally, try)
-import Control.Monad (replicateM_, void, (>=>), when)
-import Data.List (sort)
+import Control.Exception (IOException, bracket, evaluate, finally, try)
+import Control.Monad (forM_, replicateM_, void, when, (>=>))
 import Data.Aeson (decode)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as K
@@ -65,16 +71,17 @@ import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as BL
+import Data.Either (lefts)
+import Data.IORef (atomicModifyIORef', newIORef, readIORef, writeIORef)
+import Data.List (sort)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Vector as V
 import Data.Time.Clock (addUTCTime, diffUTCTime, getCurrentTime)
+import qualified Data.Vector as V
 import Network.Socket (
     AddrInfo (..),
     SockAddr (..),
-    tupleToHostAddress,
-    tupleToHostAddress6,
     SocketType (Stream),
     addrAddress,
     addrFamily,
@@ -84,6 +91,8 @@ import Network.Socket (
     getAddrInfo,
     socket,
     socketToHandle,
+    tupleToHostAddress,
+    tupleToHostAddress6,
     withSocketsDo,
  )
 import System.Directory (createDirectoryIfMissing, doesFileExist, getTemporaryDirectory, removeFile, removePathForcibly)
@@ -99,6 +108,8 @@ import System.IO (
     hSetNewlineMode,
     noNewlineTranslation,
  )
+import System.Mem.StableName (makeStableName)
+import System.Timeout (timeout)
 import Test.Hspec hiding (after, before)
 
 -- TCP 服务器测试：协议编解码、配置读取与真连服务器的端到端用例。
@@ -129,16 +140,19 @@ spec = do
                 connected <- connectClient "127.0.0.1" (shPort handle)
                 case connected of
                     Left message -> expectationFailure (T.unpack message)
-                    Right client -> (do
+                    Right client ->
+                        ( do
                             clientSudoLogin client credential "local_user" >>= (`shouldBe` Right False)
                             result <- clientQuery client "select 1"
-                        result `shouldSatisfy` isRightResult) `finally` closeClient client
+                            result `shouldSatisfy` isRightResult
+                        )
+                            `finally` closeClient client
         it "only treats kernel loopback addresses as local" $ do
             isLocalPeer (SockAddrInet 7777 (tupleToHostAddress (127, 0, 0, 1))) `shouldBe` True
             isLocalPeer (SockAddrInet 7777 (tupleToHostAddress (192, 168, 1, 2))) `shouldBe` False
-            isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0,0,0,0,0,0,0,1)) 0) `shouldBe` True
-            isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0,0,0,0,0,65535,32512,1)) 0) `shouldBe` True
-            isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0,0,0,0,0,65535,49320,1)) 0) `shouldBe` False
+            isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0, 0, 0, 0, 0, 0, 0, 1)) 0) `shouldBe` True
+            isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0, 0, 0, 0, 0, 65535, 32512, 1)) 0) `shouldBe` True
+            isLocalPeer (SockAddrInet6 7777 0 (tupleToHostAddress6 (0, 0, 0, 0, 0, 65535, 49320, 1)) 0) `shouldBe` False
         it "binds proofs to the instance, challenge, account and expiration" $ do
             credential <- newSudoCredential
             other <- newSudoCredential
@@ -153,7 +167,8 @@ spec = do
             validSudoChallenge credential now Nothing "local_user" proof `shouldBe` False
         it "requires an OS elevated identity to provision or read credentials" $ do
             privileged <- sudoPrivileged
-            if privileged then do
+            if privileged
+                then do
                     bracket (createSudoCredential 65534) (const (removeSudoCredential 65534)) $ \credential -> do
                         stored <- readSudoCredential 65534
                         case stored of
@@ -202,7 +217,8 @@ spec = do
         it "rejects disabled and NOLOGIN identities" $
             withTestSudo $ \_ handle credential -> withConnection handle $ \admin -> do
                 _ <- tcpLogin admin testRootName testRootPassword
-                mapM_ (checkSudoDisabled admin handle credential)
+                mapM_
+                    (checkSudoDisabled admin handle credential)
                     ["alter user local_user disabled", "alter user local_user enabled nologin"]
         it "does not inherit sudo authentication from a role" $
             withTestSudo $ \_ handle credential -> withConnection handle $ \admin -> do
@@ -224,6 +240,7 @@ spec = do
     tcpServerSpec
     privilegeSpec
     objectPrivilegeSpec
+    databaseGateSpec
     transactionSpec
     ipcConcurrencySpec
     identitySpec
@@ -245,9 +262,10 @@ identitySpec = describe "unified identities" $ do
             asText (at "status" shown) `shouldBe` "result"
             switched <- tcpQuery manager "use system"
             asText (at "status" switched) `shouldBe` "result"
-            mapM_ (tcpQuery manager
-                     >=>
-                       (\ reply -> asText (at "code" reply) `shouldBe` "forbidden"))
+            mapM_
+                ( tcpQuery manager
+                    >=> (\reply -> asText (at "code" reply) `shouldBe` "forbidden")
+                )
                 ["alter user manager superuser", "alter user managed system_catalog_manager", "alter user managed allow_sudo_auth", "alter user admin identified by 'Another-Pass123!'", "create database forbidden"]
     it "does not inherit catalog management through role membership" $ withTcpServer defaultServerConfig $ \_ handle ->
         withConnection handle $ \admin -> withConnection handle $ \worker -> do
@@ -312,9 +330,10 @@ identitySpec = describe "unified identities" $ do
     it "protects the last enabled login superuser" $ withTcpServer defaultServerConfig $ \_ handle ->
         withConnection handle $ \h -> do
             _ <- tcpLogin h "admin" "s3cret"
-            mapM_ (tcpQuery h
-                     >=>
-                       (\ reply -> asText (at "code" reply) `shouldBe` "bad_request"))
+            mapM_
+                ( tcpQuery h
+                    >=> (\reply -> asText (at "code" reply) `shouldBe` "bad_request")
+                )
                 ["alter user admin disabled", "alter role admin nologin", "alter user admin nosuperuser", "drop user admin", "drop role admin"]
             shown <- tcpQuery h "show roles"
             asText (at "status" shown) `shouldBe` "result"
@@ -383,21 +402,27 @@ testDatabaseName = "test"
 -- | users 5 行 + orders 1 行
 testDb :: Database
 testDb =
-    [ ( "users"
+    [
+        ( "users"
         , Table
             "users"
             [("id", TInt), ("name", TStr), ("age", TInt)]
             [ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (20 + i))]
             | i <- [1 .. 5]
             ]
-            Nothing Nothing Nothing
+            Nothing
+            Nothing
+            Nothing
         )
-    , ( "orders"
+    ,
+        ( "orders"
         , Table
             "orders"
             [("id", TInt), ("user_id", TInt)]
             [[("id", VInt 1), ("user_id", VInt 1)]]
-            Nothing Nothing Nothing
+            Nothing
+            Nothing
+            Nothing
         )
     ]
 
@@ -466,8 +491,8 @@ tempSettingsPath name = do
 removeIfExists :: FilePath -> IO ()
 removeIfExists path = do
     there <- doesFileExist path
-    when there
-      $ void (try (removeFile path) :: IO (Either IOException ()))
+    when there $
+        void (try (removeFile path) :: IO (Either IOException ()))
 
 -- | 起一台内存后端的测试服务器：管理员已设口令 `s3cret`
 withTcpServer :: ServerConfig -> (ServerEnv -> ServerHandle -> IO a) -> IO a
@@ -493,11 +518,11 @@ withTcpServerAs password config body = do
 withConnection :: ServerHandle -> (Handle -> IO a) -> IO a
 withConnection handle = bracket open closeQuietly
   where
-    -- | 关连接，忽略异常
+    -- \| 关连接，忽略异常
     closeQuietly h = do
         _ <- try (hClose h) :: IO (Either IOException ())
         pure ()
-    -- | 建连接并配成行缓冲句柄
+    -- \| 建连接并配成行缓冲句柄
     open = withSocketsDo $ do
         infos <- getAddrInfo (Just defaultHints{addrSocketType = Stream}) (Just "127.0.0.1") (Just (show (shPort handle)))
         info <- case infos of
@@ -1023,6 +1048,9 @@ privilegeSpec = describe "server privileges" $ do
 
     it "requires administrator privileges for domain commands" $ withPrivileges $ \service root -> do
         authorizeSql service root "CREATE DOMAIN code AS INT" `shouldReturn` Right ()
+        authorizeSql service root "ALTER DOMAIN code SET NOT NULL" `shouldReturn` Right ()
+        authorizeSql service (Ordinary testAccount) "ALTER DOMAIN code SET NOT NULL"
+            `shouldReturn` Left (PrivilegeError "forbidden" "administrator required")
         authorizeSql service (Ordinary testAccount) "CREATE DOMAIN code AS INT"
             `shouldReturn` Left (PrivilegeError "forbidden" "administrator required")
 
@@ -1071,8 +1099,11 @@ privilegeSpec = describe "server privileges" $ do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
         _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
-        mapM_ (\sql -> authorizeSql service (Ordinary testAccount) sql
-            `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON orders"))
+        mapM_
+            ( \sql ->
+                authorizeSql service (Ordinary testAccount) sql
+                    `shouldReturn` Left (PrivilegeError "forbidden" "permission denied: SELECT ON orders")
+            )
             [ "SELECT COUNT(*) FROM users HAVING COUNT(*) > (SELECT COUNT(*) FROM orders)"
             , "SELECT name FROM users ORDER BY (SELECT COUNT(*) FROM orders) + id"
             ]
@@ -1172,7 +1203,8 @@ objectPrivilegeSpec = describe "stable object privileges" $ do
         mustRun (beStatement (beWithDatabase backend "test") "CREATE TABLE personal_owned (id INT)")
         claimObject service (Ordinary testAccount) testDatabase "personal_owned" `shouldReturn` Right ()
         grants <- listSelfGrants service (Ordinary testAccount)
-        fmap (filter ((== "test.personal_owned") . grantObject)) grants `shouldBe` Right
+        fmap (filter ((== "test.personal_owned") . grantObject)) grants
+            `shouldBe` Right
                 [Grant "alice" privilege "test.personal_owned" True | privilege <- ["select", "insert", "update", "delete"]]
         grants `shouldSatisfy` either (const False) (not . any ((== "test.users") . grantObject))
 
@@ -1217,10 +1249,16 @@ objectPrivilegeSpec = describe "stable object privileges" $ do
         release <- newEmptyMVar
         finished <- newEmptyMVar
         revoked <- newEmptyMVar
-        let slow = backend{beWithDatabase = \name -> (beWithDatabase backend name){beStatement = \sql -> do
-                when (sql == "SELECT * FROM users")
-                  $ putMVar started () >> takeMVar release
-                beStatement (beWithDatabase backend name) sql}}
+        let slow =
+                backend
+                    { beWithDatabase = \name ->
+                        (beWithDatabase backend name)
+                            { beStatement = \sql -> do
+                                when (sql == "SELECT * FROM users") $
+                                    putMVar started () >> takeMVar release
+                                beStatement (beWithDatabase backend name) sql
+                            }
+                    }
         settings <- tempSettingsPath "permission-race"
         reader <- newSession slow testRootName settings
         admin <- newSession backend testRootName settings
@@ -1528,9 +1566,159 @@ failureCode = either sessCode (const "")
 intValues :: [[Value]] -> [Int]
 intValues rows = [n | row <- rows, Just (VInt n) <- [nth 0 row]]
 
+-- 数据库执行门的并行、等待与取消回归。
+databaseGateSpec :: Spec
+databaseGateSpec = describe "database execution gates" $ do
+    it "lets another database write while preserving same-database exclusion" $ do
+        entered <- newEmptyMVar
+        release <- newEmptyMVar
+        done <- newEmptyMVar
+        bracket (forkFinally (databaseSecurity [("gate_a", True)] (putMVar entered () >> takeMVar release)) (putMVar done)) killThread $ \_ -> do
+            takeMVar entered
+            timeout 1000000 (databaseSecurity [("gate_b", True)] (pure ())) `shouldReturn` Just ()
+            timeout 50000 (databaseSecurity [("gate_a", False)] (pure ())) `shouldReturn` Nothing
+            timeout 50000 (writeSecurity (pure ())) `shouldReturn` Nothing
+            putMVar release ()
+            result <- timeout 1000000 (takeMVar done)
+            case result of Just (Right ()) -> pure (); _ -> expectationFailure "database writer failed to finish"
+        timeout 1000000 (databaseSecurity [("gate_a", True)] (pure ())) `shouldReturn` Just ()
+        timeout 1000000 (writeSecurity (pure ())) `shouldReturn` Just ()
+
+    it "orders opposite dependency lists and releases cancelled waiters" $ do
+        entered <- newEmptyMVar
+        release <- newEmptyMVar
+        done <- newEmptyMVar
+        bracket (forkFinally (databaseSecurity [("gate_y", True), ("gate_x", False)] (putMVar entered () >> takeMVar release)) (putMVar done)) killThread $ \_ -> do
+            takeMVar entered
+            timeout 50000 (databaseSecurity [("gate_x", True), ("gate_y", False)] (pure ())) `shouldReturn` Nothing
+            putMVar release ()
+            result <- timeout 1000000 (takeMVar done)
+            case result of Just (Right ()) -> pure (); _ -> expectationFailure "ordered writer failed to finish"
+        timeout 1000000 (databaseSecurity [("gate_x", True), ("gate_y", True)] (pure ())) `shouldReturn` Just ()
+
 -- | 显式事务用例
 transactionSpec :: Spec
 transactionSpec = describe "server transactions" $ do
+    it "previews legacy duplicate deletion exactly as storage does" $ do
+        let old = Table "legacy" [("id", TInt), ("name", TStr)] [[("id", VInt 1), ("name", VStr "first")], [("id", VInt 1), ("name", VStr "second")]] Nothing Nothing Nothing
+        case applyTransactionMemory [TxnDelete "legacy" [1, 1]] [("legacy", old)] of
+            Left err -> expectationFailure err
+            Right db -> fmap tableRows (lookup "legacy" db) `shouldBe` Just [[("id", VInt 1), ("name", VStr "second")]]
+
+    it "rechecks UNIQUE on merged rows before publishing any table" $ withTwoSessions $ \first second -> do
+        _ <- mustSql first "CREATE TABLE registrations (id INT PRIMARY KEY, username TEXT UNIQUE)"
+        _ <- mustSql first "BEGIN"
+        _ <- mustSql second "BEGIN"
+        _ <- mustSql first "INSERT INTO registrations (id, username) VALUES (1, 'same')"
+        _ <- mustSql second "INSERT INTO registrations (id, username) VALUES (2, 'same')"
+        _ <- mustSql second "UPDATE users SET age = 99 WHERE id = 1"
+        _ <- mustSql first "COMMIT"
+        denied <- runStatementCoded second "COMMIT"
+        failureCode denied `shouldBe` "serialization_failure"
+        failureMessage denied `shouldBe` "UNIQUE: duplicate value in column username"
+        _ <- mustSql second "ROLLBACK"
+        sessionAge first 1 `shouldReturn` Just 21
+        rows <- mustSql first "SELECT id FROM registrations"
+        qrRows rows `shouldBe` [[VInt 1]]
+
+    it "allows distinct unique values and multiple NULLs after merging" $ withTwoSessions $ \first second -> do
+        _ <- mustSql first "CREATE TABLE registrations (id INT PRIMARY KEY, username TEXT UNIQUE)"
+        forM_ [first, second] $ \session -> void (mustSql session "BEGIN")
+        _ <- mustSql first "INSERT INTO registrations (id, username) VALUES (1, 'one'), (3, NULL)"
+        _ <- mustSql second "INSERT INTO registrations (id, username) VALUES (2, 'two'), (4, NULL)"
+        _ <- mustSql first "COMMIT"
+        _ <- mustSql second "COMMIT"
+        rows <- mustSql first "SELECT COUNT(*) FROM registrations"
+        qrRows rows `shouldBe` [[VInt 4]]
+
+    forM_ ["SELECT id FROM test.users WHERE id = 1", "SELECT id FROM users WHERE EXISTS (SELECT id FROM users WHERE age > 0)"] $ \readSql ->
+        it ("protects serializable read dependencies: " ++ T.unpack readSql) $ withTwoSessions $ \first second -> do
+            _ <- mustSql first "CREATE TABLE actions (id INT PRIMARY KEY)"
+            _ <- mustSql first "BEGIN TRANSACTION ISOLATION LEVEL SERIALIZABLE"
+            _ <- mustSql first readSql
+            _ <- mustSql first "INSERT INTO actions (id) VALUES (1)"
+            _ <- mustSql second "INSERT INTO users (id, name, age) VALUES (7, 'new', 20)"
+            denied <- runStatementCoded first "COMMIT"
+            failureCode denied `shouldBe` "serialization_failure"
+            _ <- mustSql first "ROLLBACK"
+            rows <- mustSql second "SELECT COUNT(*) FROM actions"
+            qrRows rows `shouldBe` [[VInt 0]]
+
+    it "forgets rolled-back reads and ignores unrelated table changes" $ withTwoSessions $ \first second -> do
+        _ <- mustSql first "CREATE TABLE actions (id INT PRIMARY KEY)"
+        _ <- mustSql first "START TRANSACTION ISOLATION LEVEL SERIALIZABLE"
+        _ <- mustSql first "SAVEPOINT before_read"
+        _ <- mustSql first "SELECT * FROM users"
+        _ <- mustSql first "ROLLBACK TO before_read"
+        _ <- mustSql first "INSERT INTO actions (id) VALUES (1)"
+        _ <- mustSql second "UPDATE users SET age = 99 WHERE id = 1"
+        _ <- mustSql first "COMMIT"
+        rows <- mustSql second "SELECT COUNT(*) FROM actions"
+        qrRows rows `shouldBe` [[VInt 1]]
+
+    it "allows a serializable read-only snapshot to finish" $ withTwoSessions $ \first second -> do
+        _ <- mustSql first "BEGIN ISOLATION LEVEL SERIALIZABLE"
+        _ <- mustSql first "SELECT * FROM users"
+        _ <- mustSql second "UPDATE users SET age = 99 WHERE id = 1"
+        void (mustSql first "COMMIT")
+
+    forM_ [("another commit", True), ("an autocommit update", False)] $ \(label, transactional) ->
+        it ("excludes " ++ label ++ " between conflict checking and publication") $ do
+            db <- newMVar testDb
+            settings <- tempSettingsPath "transaction-publication"
+            removeIfExists settings
+            armed <- newIORef False
+            snapshots <- newIORef (0 :: Int)
+            captured <- newEmptyMVar
+            release <- newEmptyMVar
+            secondSnapshot <- newEmptyMVar
+            let
+                -- 在首次提交取得快照后暂停发布。
+                pausedBackend original =
+                    original
+                        { beWithDatabase = pausedBackend . beWithDatabase original
+                        , beStatement = \sql -> do
+                            enabled <- readIORef armed
+                            when (enabled && not transactional && sql == "UPDATE users SET age = 32 WHERE id = 1") (putMVar secondSnapshot ())
+                            beStatement original sql
+                        , beSnapshot = do
+                            result <- beSnapshot original
+                            enabled <- readIORef armed
+                            when enabled $ do
+                                n <- atomicModifyIORef' snapshots (\count -> (count + 1, count))
+                                when (n == 0) (putMVar captured () >> takeMVar release)
+                                when (n == 1) (putMVar secondSnapshot ())
+                            pure result
+                        }
+                backend = pausedBackend (memoryBackend testDatabaseName db)
+            first <- newSession backend (T.pack testDatabaseName) settings
+            second <- newSession backend (T.pack testDatabaseName) settings
+            mapM_ (`mustSql` "USE test") [first, second]
+            _ <- mustSql first "BEGIN"
+            when transactional $ do
+                _ <- mustSql second "BEGIN"
+                void (mustSql second "UPDATE users SET age = 32 WHERE id = 1")
+            _ <- mustSql first "UPDATE users SET age = 31 WHERE id = 1"
+            writeIORef armed True
+            firstDone <- newEmptyMVar
+            secondDone <- newEmptyMVar
+            bracket (forkFinally (runStatementCoded first "COMMIT") (putMVar firstDone)) killThread $ \_ -> do
+                timeout 2000000 (takeMVar captured) `shouldReturn` Just ()
+                bracket (forkFinally (runStatementCoded second (if transactional then "COMMIT" else "UPDATE users SET age = 32 WHERE id = 1")) (putMVar secondDone)) killThread $ \_ -> do
+                    entered <- timeout 200000 (takeMVar secondSnapshot)
+                    putMVar release ()
+                    firstResult <- timeout 2000000 (takeMVar firstDone)
+                    secondResult <- timeout 2000000 (takeMVar secondDone)
+                    entered `shouldBe` Nothing
+                    case firstResult of
+                        Just (Right result) -> failureCode result `shouldBe` ""
+                        _ -> expectationFailure "first commit did not complete"
+                    case secondResult of
+                        Just (Right result) -> failureCode result `shouldBe` (if transactional then "serialization_failure" else "")
+                        _ -> expectationFailure "second commit did not complete"
+            when transactional $ void (mustSql second "ROLLBACK")
+            sessionAge first 1 `shouldReturn` Just (if transactional then 31 else 32)
+
     it "executes DISTINCT against the connection snapshot with output columns" $ withMemorySession $ \session -> do
         _ <- mustSql session "CREATE TABLE distinct_values (id INT, value INT)"
         _ <- mustSql session "INSERT INTO distinct_values (id,value) VALUES (1,7),(2,7),(3,8)"
@@ -1575,7 +1763,7 @@ transactionSpec = describe "server transactions" $ do
         updated <- beStatement backend "UPDATE users SET id = 3"
         void updated `shouldBe` Right ()
         snapshot <- beSnapshot (memoryBackend "other" ref)
-        fmap (map (tableRows . snd)) snapshot `shouldBe` Right [[[ ("id", VInt 2) ]]]
+        fmap (map (tableRows . snd)) snapshot `shouldBe` Right [[[("id", VInt 2)]]]
     it "keeps catalog and snapshot identities stable across system views and replacements" $ do
         ref <- newMVar [("test.users", Table "users" [("id", TInt)] [] Nothing Nothing Nothing)]
         let backend = memoryBackend "test" ref
@@ -1601,9 +1789,11 @@ transactionSpec = describe "server transactions" $ do
         fmap (map tiSchemaVersion) current `shouldBe` Right [Just 3]
         fmap (map (tableSchemaVersion . snd)) snapshot `shouldBe` Right [Just 3]
     it "rejects cross-database reads and writes including nested queries" $ withMemorySession $ \session -> do
-        mapM_ (\query -> do
+        mapM_
+            ( \query -> do
                 result <- runStatementCoded session query
-            failureMessage result `shouldSatisfy` T.isInfixOf "outside the current database")
+                failureMessage result `shouldSatisfy` T.isInfixOf "outside the current database"
+            )
             [ "SELECT DISTINCT age FROM other.users"
             , "SELECT * FROM other.users"
             , "UPDATE other.users SET age = 1"
@@ -1632,6 +1822,8 @@ transactionSpec = describe "server transactions" $ do
         _ <- mustSql session "create domain code as int"
         _ <- mustSql session "create table typed (id code)"
         _ <- mustSql session "begin"
+        alterDenied <- runStatementCoded session "alter domain code set not null"
+        failureMessage alterDenied `shouldBe` "DDL is not allowed in a transaction"
         denied <- runStatementCoded session "drop domain code"
         failureMessage denied `shouldBe` "DDL is not allowed in a transaction"
         _ <- mustSql session "insert into typed (id) values (7)"
@@ -1639,6 +1831,24 @@ transactionSpec = describe "server transactions" $ do
         rows <- mustSql session "select id from typed"
         intValues (qrRows rows) `shouldBe` [7]
 
+    it "rejects stale transaction writes after a domain constraint changes" $ withTwoSessions $ \writer administrator -> do
+        void (mustSql administrator "CREATE DOMAIN quantity AS INT")
+        void (mustSql administrator "CREATE DOMAIN nested AS quantity")
+        void (mustSql administrator "CREATE TABLE domain_items (id INT, qty nested)")
+        void (mustSql writer "BEGIN")
+        void (mustSql writer "INSERT INTO domain_items (id, qty) VALUES (1, 0)")
+        void (mustSql administrator "ALTER DOMAIN quantity ADD CHECK (VALUE > 0)")
+        refused <- runStatementCoded writer "COMMIT"
+        failureCode refused `shouldBe` "serialization_failure"
+        void (mustSql writer "ROLLBACK")
+        rows <- mustSql administrator "SELECT qty FROM domain_items"
+        qrRows rows `shouldBe` []
+        void (mustSql writer "BEGIN")
+        void (mustSql writer "INSERT INTO domain_items (id, qty) VALUES (2, 2)")
+        void (mustSql writer "COMMIT")
+        saved <- mustSql administrator "SELECT qty FROM domain_items"
+        intValues (qrRows saved) `shouldBe` [2]
+
     it "keeps uncommitted rows invisible to other sessions until COMMIT" $ withTwoSessions $ \writer reader -> do
         _ <- mustSql writer "begin"
         _ <- mustSql writer "insert into users (id, name, age) values (6, 'six', 26)"
@@ -1684,8 +1894,9 @@ transactionSpec = describe "server transactions" $ do
         ref <- newMVar testDb
         settings <- tempSettingsPath "snapshot-failure"
         let base = memoryBackend testDatabaseName ref
-            -- | 保留测试后端并让快照读取失败
-            failing name = (beWithDatabase base name)
+            -- \| 保留测试后端并让快照读取失败
+            failing name =
+                (beWithDatabase base name)
                     { beSnapshot = pure (Left "data page unreadable")
                     , beWithDatabase = failing
                     }
@@ -1708,12 +1919,15 @@ transactionSpec = describe "server transactions" $ do
         _ <- mustSql session "CREATE TABLE constrained_updates (id INT PRIMARY KEY, qty INT NOT NULL UNIQUE)"
         _ <- mustSql session "INSERT INTO constrained_updates (id, qty) VALUES (1, 2), (2, 3)"
         _ <- mustSql session "BEGIN"
-        mapM_ (\(query, marker) -> do
+        mapM_
+            ( \(query, marker) -> do
                 result <- runStatementCoded session query
-            failureMessage result `shouldSatisfy` T.isInfixOf marker)
-            [("UPDATE constrained_updates SET qty = NULL WHERE id = 1", "NOT NULL")
+                failureMessage result `shouldSatisfy` T.isInfixOf marker
+            )
+            [ ("UPDATE constrained_updates SET qty = NULL WHERE id = 1", "NOT NULL")
             , ("UPDATE constrained_updates SET qty = 3 WHERE id = 1", "UNIQUE")
-            , ("UPDATE constrained_updates SET id = 2 WHERE id = 1", "UNIQUE")]
+            , ("UPDATE constrained_updates SET id = 2 WHERE id = 1", "UNIQUE")
+            ]
         unchanged <- mustSql session "SELECT qty FROM constrained_updates ORDER BY id"
         intValues (qrRows unchanged) `shouldBe` [2, 3]
         _ <- mustSql session "UPDATE constrained_updates SET qty = qty + 1"
@@ -2005,6 +2219,26 @@ ipcConcurrencySpec = describe "server backend on the real storage" $ do
         intColumn "id" rowsA `shouldMatchList` [1 .. 20]
         intColumn "id" rowsB `shouldMatchList` [101 .. 120]
 
+    it "shares a committed snapshot and keeps old versions immutable" $ withIpcStorage $ do
+        base <- ipcBackend
+        mustRun (beStatement base "CREATE DATABASE alpha")
+        let alpha = beWithDatabase base "alpha"
+        mustRun (beStatement alpha "CREATE TABLE versions (id INT PRIMARY KEY, value INT)")
+        mustRun (beStatement alpha "INSERT INTO versions (id, value) VALUES (1, 10)")
+        first <- beSnapshot alpha >>= either fail pure
+        second <- beSnapshot alpha >>= either fail pure
+        firstName <- evaluate first >>= makeStableName
+        secondName <- evaluate second >>= makeStableName
+        (firstName == secondName) `shouldBe` True
+        mustRun (beStatement alpha "UPDATE versions SET value = 20 WHERE id = 1")
+        latest <- beSnapshot alpha >>= either fail pure
+        fmap tableRows (lookup "versions" first) `shouldBe` Just [[("id", VInt 1), ("value", VInt 10)]]
+        fmap tableRows (lookup "versions" latest) `shouldBe` Just [[("id", VInt 1), ("value", VInt 20)]]
+        mustRun (beStatement base "DROP DATABASE alpha")
+        mustRun (beStatement base "CREATE DATABASE alpha")
+        recreated <- beSnapshot alpha >>= either fail pure
+        map fst recreated `shouldNotContain` ["versions"]
+
     it "commits an explicit transaction to the real storage" $ withIpcStorage $ do
         base <- ipcBackend
         mustRun (beStatement base "CREATE DATABASE alpha")
@@ -2042,6 +2276,29 @@ ipcConcurrencySpec = describe "server backend on the real storage" $ do
         rows <- rowsOf (beStatement alpha "SELECT id FROM t")
         intColumn "id" rows `shouldBe` [1]
 
+    it "merges disjoint row writes while retaining the old snapshot" $ withIpcStorage $ do
+        base <- ipcBackend
+        mustRun (beStatement base "CREATE DATABASE alpha")
+        let alpha = beWithDatabase base "alpha"
+        mustRun (beStatement alpha "CREATE TABLE items (id int, value int)")
+        mustRun (beStatement alpha "INSERT INTO items (id, value) VALUES (1, 10), (2, 20)")
+        settings <- tempSettingsPath "transaction-ipc-rows"
+        removeIfExists settings
+        first <- newSession alpha "alpha" settings
+        second <- newSession alpha "alpha" settings
+        _ <- mustSql first "use alpha"
+        _ <- mustSql second "use alpha"
+        _ <- mustSql first "begin"
+        _ <- mustSql second "begin"
+        _ <- mustSql first "update items set value = 11 where id = 1"
+        _ <- mustSql second "update items set value = 22 where id = 2"
+        _ <- mustSql first "commit"
+        old <- mustSql second "select value from items where id = 1"
+        intValues (qrRows old) `shouldBe` [10]
+        _ <- mustSql second "commit"
+        rows <- rowsOf (beStatement alpha "SELECT value FROM items ORDER BY id")
+        intColumn "value" rows `shouldBe` [11, 22]
+
     it "refuses the second COMMIT on the real storage" $ withIpcStorage $ do
         base <- ipcBackend
         mustRun (beStatement base "CREATE DATABASE alpha")
@@ -2057,17 +2314,15 @@ ipcConcurrencySpec = describe "server backend on the real storage" $ do
         _ <- mustSql first "begin"
         _ <- mustSql second "begin"
         _ <- mustSql first "update users set age = 31 where id = 1"
-        _ <- mustSql second "update users set age = 42 where id = 1"
         _ <- mustSql first "commit"
-        denied <- runStatementCoded second "commit"
+        denied <- runStatementCoded second "update users set age = 42 where id = 1"
         failureCode denied `shouldBe` "serialization_failure"
-        failureMessage denied `shouldBe` "write conflict on table users, id 1"
+        failureMessage denied `shouldSatisfy` T.isInfixOf "row version changed"
         _ <- mustSql second "rollback"
         rows <- rowsOf (beStatement alpha "SELECT id, age FROM users")
         intColumn "id" rows `shouldBe` [1]
         intColumn "age" rows `shouldBe` [31]
 
-
 -- 判断明确错误返回。
 isLeftResult :: Either a b -> Bool
 isLeftResult (Left _) = True
@@ -2094,8 +2349,16 @@ tcpSudo client credential user = do
 
 -- 发送本机认证证明。
 tcpSudoProof :: Handle -> Text -> Text -> IO A.Value
-tcpSudoProof client user proof = tcpTalk client (BL.toStrict (A.encode (A.object
-    ["method" A..= ("sudo_login" :: Text), "user" A..= user, "proof" A..= proof])))
+tcpSudoProof client user proof =
+    tcpTalk
+        client
+        ( BL.toStrict
+            ( A.encode
+                ( A.object
+                    ["method" A..= ("sudo_login" :: Text), "user" A..= user, "proof" A..= proof]
+                )
+            )
+        )
 
 -- 验证身份禁用或取消登录后拒绝本机认证。
 checkSudoDisabled :: Handle -> ServerHandle -> SudoCredential -> Text -> IO ()
@@ -2111,7 +2374,6 @@ isRightResult :: Either a b -> Bool
 isRightResult (Right _) = True
 isRightResult _ = False
 
-
 -- 专用范式协议、权限、快照与预算回归。
 normalizationSpec :: Spec
 normalizationSpec = describe "normalization endpoint" $ do
@@ -2127,8 +2389,9 @@ normalizationSpec = describe "normalization endpoint" $ do
         let response = RespNormalization report
         decodeResponse (encodeResponse response) `shouldBe` Right response
         decodeResponse (encodeResponse (RespNormalization (A.object ["conditional" A..= True]))) `shouldSatisfy` either (const True) (const False)
-        mapM_ (\raw -> decodeNormalizationJSON raw `shouldSatisfy` either (T.isInfixOf "duplicate") (const False))
-            [ "{\"a\":1,\"a\":2}", "{\"a\":1,\"\\u0061\":2}", "{\"a\":[{\"b\":1,\"b\":2}]}" ]
+        mapM_
+            (\raw -> decodeNormalizationJSON raw `shouldSatisfy` either (T.isInfixOf "duplicate") (const False))
+            ["{\"a\":1,\"a\":2}", "{\"a\":1,\"\\u0061\":2}", "{\"a\":[{\"b\":1,\"b\":2}]}"]
         let unknown = A.object ["api_version" A..= (1 :: Int), "database" A..= ("test" :: Text), "table" A..= ("users" :: Text), "declaration" A..= nrDeclaration normalizationPayload, "ignored" A..= True]
         (A.fromJSON unknown :: A.Result NormalizationRequest) `shouldSatisfy` isJSONFailure
         decodeRequest (BL.toStrict (encodeRequest (ReqNormalization normalizationPayload{nrVersion = 2}))) `shouldSatisfy` either (const True) (const False)
@@ -2222,8 +2485,14 @@ normalizationSpec = describe "normalization endpoint" $ do
 
 -- 共用明确声明的用户表请求。
 normalizationPayload :: NormalizationRequest
-normalizationPayload = NormalizationRequest 1 "test" "users"
-    (NormalizationDeclaration [["id"]] [NormalizationDependency ["id"] ["name", "age"]] True (Just True)) Nothing Nothing
+normalizationPayload =
+    NormalizationRequest
+        1
+        "test"
+        "users"
+        (NormalizationDeclaration [["id"]] [NormalizationDependency ["id"] ["name", "age"]] True (Just True))
+        Nothing
+        Nothing
 
 -- 判断 JSON 类型校验失败。
 isJSONFailure :: A.Result a -> Bool