推进

修复部分问题，优化性能，进一步推进类型系统

.agents/README.md

@@ -0,0 +1,13 @@
+# AI agent 协作资料
+
+按任务读取，不将全部资料作为每次工作的上下文。
+
+- 根目录 `AGENTS.md`：开发规则和测试入口。
+- `context/progress.txt`：唯一进度、测试计数和验收来源。
+- `context/known-issues.txt`：未解决限制；`design-decisions.txt`：现有设计约束。
+- `context/main-roadmap.txt`：长期阶段；`side-branch-plan.txt`：近期任务及依赖。
+- `skills/chusql-*/`：类型、存储、跨组件边界三个项目专用技能。
+
+通用技能、安装锁文件及技能生成提示词仅保留在本地，不纳入版本控制。
+`gate-check/` 为开发者和 CI 共用的门禁工具；`logs/` 为忽略的本地产物。
+这些协作资料不参与应用构建、运行或发行打包。

.agents/context/design-decisions.txt

@@ -0,0 +1,113 @@
+# ChuSQL 当前设计决策
+进度见 progress.txt，限制见 known-issues.txt，用户操作见 docs/。
+
+## 架构与接口
+- 用户文档按主题记录于 docs/commands.md、docs/types.md、docs/architecture.md 和 docs/install.md；只读范式入口已提供。后续实施 bound IR / DOMAIN，再推进物化、递归、MVCC、compact 和并行写；规划不代表现有能力。
+- 范式迁移首版保留来源，拒绝 NULL、重复行与依赖不保持；发布目标须验证约束、完整重建并使用独立原子结构 WAL 组，不能复用禁止 DDL 的会话事务拼接执行。
+- 发布真实性采用 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。
+- 兼容值与类型语义集中于 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 确认写守卫能力，再发送实际写入；存储按库名排序取门，在目标库独占门及其他依赖共享门内复查后执行，不改变单次请求之间的数据隔离语义。
+- 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 左值），非空集合保持三值逻辑。
+- 每次查询执行用独立状态物化成功行集，子查询按已解析定义和具名外层绑定值共享，原始名称调用保守包含整个外层行；派生表按执行子树和外层行缓存，先共享再应用别名。各消费者独立处理标量基数与三值逻辑，失败仍明确返回，保持既有求值顺序；不跨执行保留，也不提供整条查询快照或磁盘溢出。
+- WAL 提交组落盘后、首次应用前进入 recovery_required；任何应用、刷盘或检查点错误都保持该状态，完整落盘与截断成功后才解除。
+- 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，不物化；多次引用重复执行，以减少实现改动面。
+- 比较及 ANY / ALL 使用独立 AST 节点，量词复用三值逻辑，空集 ANY=false、ALL=true。
+- 子查询在 Filter / Compute 中按外层绑定分组复用，暂不引入半连接；扫描按页分片，至少 1000 行、最多 8 线程，结果保序，safe FFI 释放执行能力。
+
+## 会话、事务与存储
+- 每连接独立会话及工作库；短锁取得库句柄后执行，每库读写门控制可见性，表锁保护页，在用库不强行删除。
+- BEGIN 物化当前库快照，事务内走内存执行，COMMIT 提交相对基线差分，ROLLBACK 丢弃快照。
+- COMMIT 先跳过数据未修改的表，整数 id 用 IntMap / IntSet 查找差异与冲突；保留原行顺序及重复 id 的首行查找语义，冲突检查和提交操作共享一次差分。
+- 有整数 id 时按键提交及检查写写冲突，无整数 id 时整表比对；未修改表不回写，冲突保留事务并返回 serialization_failure。
+- 保存点保存不可变快照引用，同名取最近一层，回退 / 释放丢弃之后的点，结束清空；事务命令由会话层执行。
+- WAL 先记录操作及提交标记，再应用、刷数据与 catalog、写检查点、截断；仅重放已提交且超过检查点的记录。
+- WAL 帧保留长度、LSN、类型码、表名及 JSON payload，兼容旧记录；恢复按内容、schema 和文件存在性判断幂等。
+- 检查点按库 LSN，前缀截断用同目录临时文件原子替换，未提交尾部直接截短；失败保留 WAL 并进入 recovery_required。
+- 检查点采用同目录临时文件替换，长度必须为 8 字节；完整 WAL 帧损坏明确报错，尾部不完整帧保留撕裂处理。刷盘或检查点失败后封闭请求，重启重放已提交组。
+- distinct 在封顶前按值引用计数维护，列封顶不清除其他列状态；直方图独立累计与递减，桶重映射导致删除目标为空时扣最近非空桶以保持总量。rebuild_stats 先扫描数值范围，再按固定边界计数，消除重建过程的桶重映射偏差并保持输入顺序无关。
+- 表 / 索引 DDL 进 WAL，删表不重取已移除句柄；库建删不进 WAL，删除以墓碑目录收敛。
+- 页内 compact 保持槽号及索引位置，死空间达到四分之一时自动整理；无隐藏列逐页整理，有隐藏列整表重写，不跨页填空以保留行序。
+
+## 身份、权限与引导
+- 对象标识使用数据库编号与库内表编号组合；数据库编号从 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。
+- 授权链从独立管理来源及所有权展开固定点；撤销清理无来源下游，保留独立来源，循环不能自持。禁用保留所有权和管理来源授权，停止权限贡献并清理失效下游。
+- 旧名称授权仅迁移一次到现存稳定对象；旧全局 * 固定为当时现存表，缺失对象或身份清理，旧记录无授予者时使用管理来源。
+- 权限快照按字符分块存储，比较旧快照后以同一 WAL 组替换；跨页及 Unicode 不受单行上限限制。普通存储入口隐藏并拒绝访问权限快照表。
+- 服务端共享公平读写锁排序查询与权限变更；事务提交复查身份、权限和稳定对象。建表前写入创建者声明，启动时依据现存对象恢复所有权或清理未完成声明。
+- 口令 / 属性推进 revision，权限变更预先展开受影响身份；TCP 只标记连接失效，下一请求回 unauthorized 后关闭，避免 Windows 阻塞句柄异步中断；登记在 finally 清理。
+- 系统表统一 __system_ 前缀并分层保护，内部目录按白名单访问；旧名按文件先、catalog 后迁移，崩溃后可重复收敛。
+- 安装先 bootstrap：建立 system、默认 root（LOGIN / SUPERUSER / ENABLED）、18 个内置名称，再起服务；引导请求不开放 TCP。
+- 清单编入引导并与解析器测试比对；system.__system_types 保存名称、基础表示、参数能力、编号。重复引导保留口令并补齐类型，冲突或身份降权失败；类型建表与写入用同组 WAL。
+
+- sudo 认证用独立 allow_sudo_auth 属性和显式 sudo_auth_user 映射；默认关闭，只有 SUPERUSER 能管理，不继承、不隐含权限。目录管理者不得管理启用该属性的身份。
+- 选择操作系统保护的随机本机凭据与 TCP 一次性 HMAC 挑战，以复用三平台既有会话协议；Unix 只信任有效 UID 0，Windows 只信任提升 Administrators 令牌。双方校验内核回环地址，不接受客户端自报 OS 用户或 SUDO_USER。
+- 本机凭据只存放于系统保护的端口专属目录，原生入口校验提升身份；实例重启重新生成，现存目录拒绝覆盖。此方案要求服务端也提升运行，以保证创建凭据时的操作系统保护边界。
+- 挑战绑定账号、连接及实例，60 秒过期并在每次尝试时消费；证明常量时间比对，凭据不经网络发送。成功登录复用身份版本、登录时间及连接失效机制，审计不含凭据或证明。
+- sudo 属性由 Accounts WAL 持久化，旧目录缺列触发身份快照重写，旧记录缺属性默认 false，已有的错误类型明确拒绝。
+
+## 自定义类型
+ - 范式检查采用阿姆斯特朗属性闭包与子集枚举，候选键声明转为决定全关系的依赖；完整覆盖声明与领域原子性分别控制可证明结论，不从样本推断。二元 BCNF 建议按违反依赖无损拆分，投影依赖之并用于验证依赖保持。
+- DOMAIN 命名基础类型，列编码 domain(名称,基础类型) 保留引用，值及索引沿用底层语义。
+- 各库 __system_domain_<名称> 空目录表的 base 列保存定义，复用 catalog / DDL WAL；普通 SQL 隐藏并保护目录。
+- 嵌套只引用当前库已有类型，语义层从 schema 递归解析并拒绝循环，存储写锁内逐层校验；删除检查类型间及间接列依赖。
+- 类型 DDL 要求管理员、事务内禁止；约束与默认值后续扩展，暂不引入自定义函数 / 运算符。
+- 运行时类型使用稳定构造器编号与结构化 TypeId，逻辑类型与 PhysicalType 分离；递归值使用版本 1 标签编码，读取时校验类型、形状及载荷。
+- TypedExpression / TypedPlan 仅使用 schema 绑定，SQL BoundQuery 通过既有 RelOp 执行并按输出位置验证；输出类型保留嵌套 DOMAIN 名称，基础日期、时间戳及 Blob 保留兼容类型，函数结果不继承参数领域。
+- TypedExpression 列引用保存输入 schema 槽位与诊断名称；独立求值要求行顺序匹配，TypedPlan 扫描边界校验并按 schema 排序，每层投影绑定到子计划输出。SQL RelOp 在优化后绑定表达式列槽位，投影单向转为 Compute，排序/分组转为 BoundSort/BoundAggregate，存储结果按算子布局排列；子查询局部列在前、外层绑定在后。绑定算子不参与后续投影下推；独立作用域身份仍待迁移。
+- SQL 局部引用使用 ColumnSlot，外层引用使用 OuterColumnSlot 的相对位置及局部布局宽度。重新绑定外层引用只查询外层布局，避免同名局部捕获；语义输入拒绝执行槽位。外层行仍扁平化，多级词法作用域/来源编号另行迁移。
+- BoundQuery 执行前重新取得 schema 并比较依赖对象身份、schema 版本及列定义，依赖覆盖全部嵌套子查询及来源列的传递 DOMAIN 定义。IPC 将依赖守卫限定在本次执行环境；扫描、分片、点查及范围读均在相关库读锁内复查全部依赖后读取，跨库读锁按库名排序，持有库引用防止删除。数据、统计和无关对象不参与比较；旧目录缺失版本时仍比较列定义，已知身份或版本丢失则拒绝。守卫响应必须明确确认，旧二进制忽略字段时拒绝；未实现守卫的后端明确报错，纯内存视图可直接执行。守卫不改变既有多请求查询的数据隔离语义。
+- 内建函数先解析为稳定 FunctionId 并验证签名，再执行；SQL NULL 保留三值语义。缺少能力字典的运行时类型拒绝比较、排序、分组、极值、索引及唯一键声明。
+- SQL 字面量生成返回明确错误，先验证运行时值与有限浮点；复合值在 Web 使用 SQL 修改。
+
+## 配置、构建与发行
+- 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、工作目录候选查找。
+- 预编译包优先，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 同样递增并拒绝耗尽。
+- 注释以 AGENTS.md 为准；原因写本文件，限制写 known-issues.txt，进度及计数只以 progress.txt 为准。

.agents/context/known-issues.txt

@@ -0,0 +1,56 @@
+# ChuSQL 当前限制与风险
+进度见 progress.txt，设计见 design-decisions.txt；仅记录未解决的限制。
+
+## 事务、恢复与并发
+- 事务是整库内存快照，不是行版本 MVCC；每会话一个事务，无嵌套事务，事务内禁止 DDL / USE。
+- BEGIN / COMMIT 仍有整库快照传输与修改表比较成本，复测见 docs/performance.md。
+- Web 首次加载业务表即固定编辑快照，同一登录会话只允许一个页面持有编辑事务；系统身份表只读，通过 SQL 管理。
+- 页面关闭的回滚请求可能因断线未送达；此时按会话空闲 / 最长寿命过期清理，后台每分钟检查一次。编辑连接失效后必须重新登录，不能恢复旧快照。
+- COMMIT 按整数 id 校验写写冲突，缺少整数 id 时整表比对及替换；冲突返回 serialization_failure，调用方回滚或重试，无自动重试或死锁检测。
+- WAL 只有 redo，检查点按库 LSN 而非页 LSN，幂等恢复代价随数据量增长；库目录建删不走 WAL，删库用墓碑目录处理。
+- recovery_required 期间除 Ping / SystemStatus 外请求被拒绝，需恢复后继续。
+- 每库读共享、写独占，写入会阻塞同库跨表读取，尚无并行写。
+- 权限变更只标记 TCP 连接失效，客户端下一次请求收到 unauthorized 后关闭，空闲连接不会立即断开；并发测试不证明性能提升。
+
+## 查询与性能
+- 基础成本及贪心连接重排，无动态规划或跨外连接重排；只在行序不可观察处重排。
+- catalog 行数可能滞后，distinct 有上限；16 桶等宽直方图只统计数值并按闭区间估算，增量维护可能偏差，桶内分布仍为估算。
+- 内存统计去重上限为 4096，暂不提供直方图或索引成本；派生表可从透明算子估计行数，含聚合或可能报错表达式时仍保守。投影下推保留所有计算项，不消除潜在错误。
+- 查询内物化只在内存保存结果，尚无容量预算或磁盘溢出；既有按绑定分组求值可能更早报告同一错误。
+- CTE 解析期展开，不支持递归、写语句或 MATERIALIZED / NOT MATERIALIZED 指定；不同优化子树不能共享物化。只能引用前面定义的 CTE，前向引用按普通表名解析。
+- 半连接重写尚未覆盖组合谓词、复杂相关条件、多键、相关聚合或排序截断；可能报错的相关投影继续走原执行路径。
+- 并行只覆盖页区间扫描：schema 至少 1000 行、最多 8 线程，无页内并行，统计滞后可退回顺序扫描。
+- compact 不填跨页空洞，含隐藏列时仍需整表重写。
+
+## 权限与兼容性
+- 对象权限快照整体写入，鉴权会读取身份、成员和对象元数据；尚未针对大规模权限目录做性能基准。
+- 对象高水位损坏或回退后无法恢复已删除对象的编号上限；旧二进制会丢弃新增目录字段，不应降级使用已升级的数据目录。
+- 无列级权限、所有权转移或角色 ADMIN OPTION。
+- 旧授权缺少授予来源，迁移为管理来源；旧全局 * 只绑定迁移时现存表。没有身份改名命令；已有同名 public 身份在删除前不会解析为虚拟 PUBLIC。
+- 尚无 CREATEDB / CREATEROLE、继承开关、口令到期、连接上限或 Web 专门的身份属性编辑界面。
+- 旧账号与角色重名会阻止迁移；迁移后的身份目录与 DOMAIN 编码不支持旧二进制。更早的 __chusql_users 无自动迁移。
+- 旧配置 host 不读取，web.static_dir / web.user 被忽略，升级需按 docs/config.md 调整。
+- 引导不重设已有口令、不提升已降权身份；类型定义冲突需人工解决。
+
+## 类型与语义
+- 范式分析最多 12 列；领域原子性和依赖完整性由用户声明，信息不足时不认证高阶范式。分解建议仅一轮，不保证子关系已达 BCNF；尚无自动迁移。
+- DOMAIN 无自身 CHECK / NOT NULL / DEFAULT、ALTER DOMAIN、CASCADE；尚无 ENUM 或用户定义复合类型。内置目录不能靠增加行扩展基础类型。
+- DECIMAL 仍使用浮点表示，不是精确十进制存储；整数类型共用整数表示，CHAR 不补空格。
+- 少量接口设置仍用字符串类型名；Haskell 值语义和 Rust 索引键分开维护。旧 ColumnType / RelOp 仍是兼容桥，完整能力、转换及关系 IR 迁移待后续阶段。
+- 多请求查询不提供整条查询的数据快照；旧目录无有效对象编号时无法证明历史对象身份。执行期外层行仍使用扁平布局，原始关系执行 API 仍允许名称引用；尚无独立作用域或来源编号。
+- 写入的存储操作分别取门，尚无整条语句的数据快照或数据冲突检测。来源/列缺少独立身份，不能视作完整写入 bound IR；建表、库及 DOMAIN 管理不在已有表写计划范围。
+- CHECK 仍以表达式文本持久化；RENAME COLUMN 不自动改写依赖 CHECK，引用旧列名时拒绝改名。普通原始存储 DDL 不具有 Haskell 的完整表达式语义校验。
+- 运行时类型尚无 Eq / Ord / Hash 等 capability 字典，不提供比较、排序、分组、极值、去重和索引；复合字段在 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 历史不自动清理，任意业务字符串中的敏感数据不自动识别。

.agents/context/main-roadmap.txt

@@ -0,0 +1,22 @@
+ChuSQL 长期路线图
+
+交付状态和验收只以 progress.txt 为准；近期顺序见 side-branch-plan.txt。
+本文件描述目标，不代表现有实现或功能承诺。
+
+目标链路：SQL → Parser / Binder → Typed IR → Planner / Optimizer → Executor → Rust Storage。
+类型能力与权限保持独立；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 的版本、依赖、安装/升级/移除；其他访问方法按真实需求推进。
+
+贯穿约束
+- 现有 ColumnType / Expr / RelOp 有真实消费者；迁移时逐步收拢，不提前删除兼容桥。
+- 每阶段验证持久化、升级、依赖和恢复，不能靠重新初始化掩盖不兼容。
+- 内建对象可由可信 bootstrap 元数据恢复；用户对象依赖 WAL / 备份。
+- catalog 版本与 bootstrap / recovery 匹配，系统目录索引可重建。
+- 不提前增加孤立扩展或绕过事务、权限及依赖管理。

.agents/context/progress.txt

@@ -0,0 +1,41 @@
+ChuSQL 已完成事项
+更新：2026-10-13
+
+本文件是当前完成状态及最新验收的唯一来源，等价于 project-plan.txt；不保留历史批次、提交记录或修改流水。
+设计见 design-decisions.txt，未解决限制见 known-issues.txt，后续计划见 side-branch-plan.txt。
+
+## SQL 与查询执行
+
+- 实现 CRUD、表列约束、索引、INNER / LEFT JOIN、聚合、GROUP BY、HAVING、ORDER BY、LIMIT、投影别名、DISTINCT / ALL；排序支持输出序号、表达式、函数、聚合及子查询。
+- 实现标量及相关子查询、派生表、非递归 CTE、IN / EXISTS、比较与 ANY / ALL；保持 NULL 三值逻辑、重复列、稳定排序、空输入聚合及空集成员比较语义；HAVING 覆盖整体组与未投影聚合，新子句参与依赖守卫和表权限检查。
+- 实现谓词 / 投影下推、常量折叠、点查 / 范围成本选择、贪心内连接重排、16 桶直方图及保序并行扫描；子查询按定义和外层值在查询内物化、跨子句复用，相同 CTE / 派生执行子树共享结果；独立 IN / NOT IN 和简单等值相关 EXISTS / NOT EXISTS 使用哈希半连接 / 反连接。
+
+## 类型与绑定
+
+- 建立固定类型 / 函数编号、TypeId / TypeExpr / Kind、逻辑与物理类型、版本化复合值编码；支持 Int / Double / Bool / String / List / Maybe / Tuple、length / not，接入 SQL、存储、CLI 和 Web。
+- 实现 CREATE / DROP / SHOW DOMAIN、库内嵌套定义、列引用、依赖与循环校验及持久化；查询输出保留 DOMAIN 身份。
+- 查询使用 BoundQuery；表达式、投影、连接、排序和分组按 schema 槽位绑定，存储返回行按布局整理，缺列和位置失配明确失败。
+- 相关列按最近到最远的独立词法作用域解析，局部 / 外层槽位分离；重绑定保留有效位置，失配仅允许唯一同名列重定位。子查询取值与缓存共享槽位绑定。
+- DML 使用可复用 BoundWrite，预绑定 INSERT 输入、UPDATE 目标、DELETE 布局及 CHECK / 非空 / 唯一性约束；保留默认值、自增、逐项赋值和未命中行不求值，唯一性按最终行集判断，失败不发布修改。
+- 查询与已有表写计划保存对象身份、schema 版本、列定义及传递 DOMAIN 依赖；执行前及实际存储操作锁内复查。写前握手拒绝不支持守卫的存储，跨库按名称排序取门；数据、统计和无关结构变化不使计划失效。
+- CHECK 定义与执行共用类型及槽位绑定；建表、加列和结构变更校验条件、默认值与键能力，空表不跳过，失效引用明确拒绝。
+
+## 存储与事务
+
+- 实现页、堆表、B+Tree、catalog、WAL、LSN 检查点、已提交组幂等恢复及页内 compact；持久化对象编号、高水位和 schema 版本，失败进入 recovery_required。
+- 实现按连接隔离工作库、整库快照事务、写写冲突检查、保存点和差分提交；权限及对象身份在事务提交时复查。
+- 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。
+
+## 最新验证
+
+- 全量门禁通过：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。局部改动验证受影响模块，较大改动执行全量门禁；当前工作区改动未提交。

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

@@ -0,0 +1,16 @@
+ChuSQL 近期任务与依赖
+
+实现、测试及门禁状态只以 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 复合值编辑、大整数及多页面事务的交互与会话约束。按真实需求选择实施范围。
+
+持续验收
+- 局部改动通过受影响模块测试；较大改动由 agent 执行全量门禁，通过后再提交。模块测试不替代异常恢复、磁盘错误、持续负载及并发冲突演练。
+- sudo、在线安装、Linux $ORIGIN、macOS 构建发行与发布签名按目标平台验证，结果登记 progress.txt。
+- 升级明确账号/授权/配置迁移、禁止降级、旧历史和异常凭据清理；不承诺旧二进制兼容、损坏页自动修复或任意 OS 用户映射。
+- Haskell 构建串行，存储协议变化重建实际动态库；门禁入口为 gate-check/run-gate.ps1。

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

@@ -0,0 +1,64 @@
+---
+name: chusql-boundary-contracts
+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-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 属于不同协议。
+
+## ABI 与所有权
+
+下表符号均带 chusql_storage_ 前缀；Rust usize 对 Haskell CSize、i32 对 CInt，句柄使用 Ptr ()。不直接跨语言传 Rust struct、enum、Vec 或 Haskell 对象布局。
+
+| 符号 | C ABI 形状 | 契约 |
+| --- | --- | --- |
+| version | () → const char* | 静态 NUL 字符串，不释放 |
+| 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 |
+| 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 不是非法指针保护。
+- 成功输出是 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

@@ -0,0 +1,53 @@
+---
+name: chusql-storage-integrity
+description: 修改 ChuSQL 存储页、索引、序列化、catalog、系统元数据、初始化、持久化事务或恢复时使用；维护实际落盘顺序与恢复约束。普通 SQL 表达式或界面任务不加载。
+---
+
+# 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 单独配置。
+- `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/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 做离线维护。
+
+## Invariants
+
+- 表存在性以 catalog 为准，文件存在不表示已登记；不能靠打开文件创建逻辑表。语义与优化只读取 schema。
+- Catalog::save 写 pending 文件、同步后替换；单文件替换不等于 catalog、页与索引已整体原子提交。
+- 普通组先 append_group 落盘，再设置 recovery_required，然后应用、刷表、推进检查点、截断日志，全部成功才解除恢复状态。
+- 应用 / 刷盘 / 检查点 / 截断失败必须保持恢复状态并报错。普通业务请求被阻断；Ping / SystemStatus 例外由各自分派层处理，新增入口不得绕过状态。
+- 恢复仅重放检查点之后已提交组，保持 replay_op 幂等；不应用未提交组。现有 WAL 是 redo，检查点是库级 LSN，不是 undo 或页级恢复。
+- 账号引导 / 变更存在独立 WAL 路径，不能假定所有写入都走普通组函数。
+- 库 / 表对象和身份编号依赖持久化高水位，删除后不复用；迁移不能降低计数器，不能从现存对象推断已删除编号上限。
+- 系统身份 / 凭据、角色、授权、类型与 DOMAIN 元数据保持对应关系。引导保留已有口令和降权状态，拒绝定义 / 保留文件冲突；类型目录不是可动态扩展基础类型的机制。
+- 数据目录锁覆盖存储和维护生命周期；维护前停止占用进程。每库读共享 / 写独占、表句柄加锁，不假定同库跨表并行写。
+- 会话事务是整库内存快照，无嵌套事务，事务内禁止 DDL / USE。提交跳过未修改表，整数 id 按键差分，否则整表比较 / 替换；对象身份和权限需复查，冲突返回 serialization_failure 并保留事务。
+- 页内 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、页级恢复、跨页填洞、并行写或通用结构迁移事务，不据此放松校验。
+
+## 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

@@ -0,0 +1,48 @@
+---
+name: chusql-type-system
+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/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 已开放该类型的比较、排序、分组或索引。
+- DOMAIN 使用 domainTableName 与目录定义解析基础类型、依赖及循环；不能拿解析器占位基础类型直接执行。系统内建类型目录也不是通过增加行即可扩展的插件注册表。
+- Date / Timestamp / Blob 在 QueryType 保留 CompatibilityType；ColumnType 与 RelOp 仍有真实消费者，不能作为无用兼容层删除。
+- 类型 / 值编码版本为 1；身份、类型名、封装或值结构变化可能影响 catalog、WAL、FFI、TCP 和 Web，组合相关 Skills 核对消费者。
+- 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 字典。
+
+## 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`，区分当前类型用法与未来约束设计。以上源码模块是契约核对入口。

.github/workflows/release.yml

@@ -1,8 +1,7 @@
-# 发版流水线：打 tag（v*）时为四个平台各出一个发行包，附 sha256，挂到 Release。
+# 发版流水线：构建 Windows 与 Linux 安装包，验证后上传 Release。
 #
 # 资源命名（install.sh / install.ps1 按 <os>-<arch> 挑资源，见 scripts/install.sh）：
 #   chusql-linux-x86_64.tar.gz     chusql-windows-x86_64.zip
-#   chusql-macos-x86_64.tar.gz     chusql-macos-arm64.tar.gz
 #
 # 一个平台一个包，里面 Web 前端与命令行客户端两部分都在；装哪几个由包内的安装脚本
 # 当场问（非交互时用 --component / -Component 指定）。
@@ -13,8 +12,6 @@
 # 没有对应平台的资源时，同一个脚本可以退回本地编译：
 #   sh scripts/install.sh --component web --from-source
 #
-# 说明：macOS 两个 runner 会让总时长变长（每个 job 都要 cargo + stack 各编一遍）；
-# 不需要 Intel mac 的包就把 macos-13 那两行删掉。
 name: release
 
 on:
@@ -29,10 +26,19 @@ on:
 permissions:
   contents: write
 
+concurrency:
+  group: release-${{ inputs.tag || github.ref_name }}
+  cancel-in-progress: true
+
 env:
   CARGO_TERM_COLOR: always
 
 jobs:
+  validate:
+    uses: ./.github/workflows/linux.yml
+    with:
+      phase: release
+
   build:
     name: ${{ matrix.platform }}
     runs-on: ${{ matrix.os }}
@@ -43,10 +49,10 @@ jobs:
         include:
           - { os: ubuntu-latest, platform: linux-x86_64 }
           - { os: windows-latest, platform: windows-x86_64 }
-          - { os: macos-13, platform: macos-x86_64 }
-          - { os: macos-14, platform: macos-arm64 }
     steps:
       - uses: actions/checkout@v4
+        with:
+          ref: ${{ inputs.tag || github.ref }}
 
       # ---------- 工具链 ----------
       - name: Rust toolchain
@@ -101,113 +107,15 @@ jobs:
         working-directory: chusql-bootstrap
         run: stack build --fast chusql-bootstrap:exe:csql-bootstrap
 
-      # ---------- 装配 + 打归档（CI 里直接写在这里；本机打同一个包用 scripts/package.sh）----------
+      - name: package and verify (Unix)
-      # 归档里是包内容本身（bin/、scripts/、static/、install.sh 就在根上），安装脚本按这个布局找文件。
-      - name: package (Unix)
         if: runner.os != 'Windows'
         shell: bash
-        run: |
+        run: sh scripts/package.sh --out-dir "$PWD/dist" --platform '${{ matrix.platform }}' --version '${{ inputs.tag || github.ref_name }}' --no-build
-          set -eu
-          name="chusql-${{ matrix.platform }}"
-          stage="dist/$name"
-          rm -rf "$stage"
-          mkdir -p "$stage/bin" "$stage/resources"
 
-          cp chusql-core/storage/target/release/libchusql_core_storage.* "$stage/bin/"
+      - name: package and verify (Windows)
-
-          stack_root="$(cd chusql-cli && stack path --local-install-root | tail -n 1 | tr -d '\r')"
-          for front_name in chusql-web chusql-server csql; do
-            front="$stack_root/bin/$front_name"
-            if [ ! -f "$front" ]; then
-              front="$(find chusql-web/.stack-work chusql-cli/.stack-work -name "$front_name" -type f 2>/dev/null | head -n 1 || true)"
-            fi
-            [ -n "$front" ] && [ -f "$front" ] || { echo "front end binary not found: $front_name" >&2; exit 1; }
-            cp "$front" "$stage/bin/"
-          done
-
-          # 引导程序住在自己的工程里，安装根也单独问它要
-          bootstrap_root="$(cd chusql-bootstrap && stack path --local-install-root | tail -n 1 | tr -d '\r')"
-          bootstrap_bin="$bootstrap_root/bin/csql-bootstrap"
-          if [ ! -f "$bootstrap_bin" ]; then
-            bootstrap_bin="$(find chusql-bootstrap/.stack-work -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true)"
-          fi
-          [ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || { echo "csql-bootstrap not found" >&2; exit 1; }
-          cp "$bootstrap_bin" "$stage/bin/"
-
-          # Haskell 一般静态链接，靶目录里真有共享库就一起带上；改名前的旧库（libchusql_storage.*）不能进包
-          for lib in chusql-core/storage/target/release/*.so chusql-core/storage/target/release/*.dylib; do
-            [ -f "$lib" ] || continue
-            case "$(basename "$lib")" in
-              libchusql_storage.*|libchusql_storage-*) continue ;;
-            esac
-            cp "$lib" "$stage/bin/"
-          done
-
-          cp resources/settings.toml.* "$stage/resources/"
-          cp scripts/install.ps1 scripts/install.sh "$stage/"
-          cp scripts/uninstall.ps1 scripts/uninstall.sh "$stage/"
-          mkdir -p "$stage/static"
-          cp -R chusql-web/static/. "$stage/static/"
-          cp scripts/csql-web.sh "$stage/"
-          if [ -f scripts/csql-web.ps1 ]; then cp scripts/csql-web.ps1 "$stage/"; fi
-
-          chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh"
-
-          mkdir -p dist
-          tar -czf "dist/$name.tar.gz" -C "$stage" .
-          rm -rf "$stage"
-          ls -l "dist/$name.tar.gz"
-
-      - name: package (Windows)
         if: runner.os == 'Windows'
         shell: pwsh
-        run: |
+        run: ./scripts/package.ps1 -OutDir dist -Platform '${{ matrix.platform }}' -Version '${{ inputs.tag || github.ref_name }}' -NoBuild
-          $ErrorActionPreference = 'Stop'
-          $name = "chusql-${{ matrix.platform }}"
-          $stage = "dist/$name"
-          if (Test-Path $stage) { Remove-Item -Recurse -Force $stage }
-          New-Item -ItemType Directory -Force -Path "$stage/bin", "$stage/resources" | Out-Null
-
-          Copy-Item 'chusql-core/storage/target/release/chusql_core_storage.dll' "$stage/bin/"
-
-          $stackRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
-          foreach ($frontName in @('chusql-web.exe', 'chusql-server.exe', 'csql.exe')) {
-            $front = Join-Path $stackRoot "bin/$frontName"
-            if (-not (Test-Path $front)) {
-              $front = Get-ChildItem -Path 'chusql-web/.stack-work', 'chusql-cli/.stack-work' -Recurse -Filter $frontName -File -ErrorAction SilentlyContinue |
-                Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
-            }
-            if (-not $front -or -not (Test-Path $front)) { throw "front end binary not found: $frontName" }
-            Copy-Item $front "$stage/bin/"
-          }
-
-          $bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
-          $bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe'
-          if (-not (Test-Path $bootstrapExe)) {
-            $bootstrapExe = Get-ChildItem -Path 'chusql-bootstrap/.stack-work' -Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue |
-              Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
-          }
-          if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { throw 'csql-bootstrap.exe not found' }
-          Copy-Item $bootstrapExe "$stage/bin/"
-
-          # 第三方 dll 才要连带上：名字带 chusql 的是本 crate 产物或改名前的残留，上面已按名拷过
-          Get-ChildItem 'chusql-core/storage/target/release' -Filter '*.dll' -File -ErrorAction SilentlyContinue |
-            Where-Object { $_.Name -notlike 'chusql*' } |
-            ForEach-Object { Copy-Item $_.FullName "$stage/bin/" }
-
-          Copy-Item 'resources/settings.toml.*' "$stage/resources/"
-          Copy-Item 'scripts/install.ps1', 'scripts/install.sh' $stage
-          Copy-Item 'scripts/uninstall.ps1', 'scripts/uninstall.sh' $stage
-          New-Item -ItemType Directory -Force -Path "$stage/static" | Out-Null
-          Copy-Item 'chusql-web/static/*' "$stage/static" -Recurse
-          Copy-Item 'scripts/csql-web.sh' $stage
-          if (Test-Path 'scripts/csql-web.ps1') { Copy-Item 'scripts/csql-web.ps1' $stage }
-
-          New-Item -ItemType Directory -Force -Path dist | Out-Null
-          Compress-Archive -Path "$stage/*" -DestinationPath "dist/$name.zip" -Force
-          Remove-Item -Recurse -Force $stage
-          Get-Item "dist/$name.zip" | Select-Object Name, Length | Format-Table
-
       - name: checksum
         shell: pwsh
         run: |
@@ -229,9 +137,13 @@ jobs:
 
   publish:
     name: publish release
-    needs: build
+    needs: [build, validate]
     runs-on: ubuntu-latest
     steps:
+      - uses: actions/checkout@v4
+        with:
+          ref: ${{ inputs.tag || github.ref }}
+
       - uses: actions/download-artifact@v4
         with:
           path: dist
@@ -244,5 +156,8 @@ jobs:
         run: |
           set -eu
           ls -l dist
-          gh release view "$TAG" >/dev/null 2>&1 || gh release create "$TAG" --title "ChuSQL $TAG" --generate-notes
+          notes="docs/release-$TAG.md"
+          test -f "$notes"
+          gh release view "$TAG" >/dev/null 2>&1 || gh release create "$TAG" --title "ChuSQL $TAG" --notes-file "$notes" --verify-tag
+          gh release edit "$TAG" --notes-file "$notes"
           gh release upload "$TAG" dist/* --clobber

.gitignore

@@ -76,8 +76,6 @@ resources/chusql.ui.settings.json
 *~
 \#*\#
 .\#*
-AGENTS.md
-agent-credientials
 .dsh
 # 注意：.zed/tasks.json 是本仓库共享的构建任务（stack build / run / test / repl），
 # 需要入库，所以这里不忽略 .zed/
@@ -95,3 +93,13 @@ plandocs/
 Thumbs.db
 ehthumbs.db
 desktop.ini
+
+learning
+
+# 通用技能和安装状态仅供本机；只跟踪项目专用技能
+/.agents/skills/*
+!/.agents/skills/chusql-boundary-contracts/
+!/.agents/skills/chusql-storage-integrity/
+!/.agents/skills/chusql-type-system/
+/.agents/context/prompt.txt
+/skills-lock.json

AGENTS.md

@@ -0,0 +1,41 @@
+# AGENTS.md — ChuSQL 开发契约
+
+参考：
+- 唯一进度与验收来源：`.agents/context/progress.txt`（等价于 project-plan.txt）。
+- 限制与设计：`.agents/context/known-issues.txt`、`.agents/context/design-decisions.txt`。
+
+## 核心约束
+- 测试必须通过，禁止绕过检查。
+- 不吞错误，使用明确错误返回。
+- FFI 响应由 Rust 分配并通过配套 free 归还；句柄关闭不得与请求并发。
+- 表存在性以 catalog 为准。
+- 语义检查和优化只使用 schema。
+- 索引由存储层管理，优化器只判断可点查条件。
+- 优化不能改变结果语义。
+- 持久化、事务、并发、类型及 FFI 改动优先维护不变量、内存所有权与错误传播；保留必要的迁移和恢复约束。
+
+## 开发方式
+- 按任务选择已安装 Skills：编码用 ponytail / karpathy-guidelines，审查与简化按需用 ponytail-review；Rust、FFI、测试及覆盖率分别使用对应项目技能。
+- 类型、值、转换或表达式语义用 `chusql-type-system`；存储、序列化、系统目录、初始化或恢复用 `chusql-storage-integrity`；FFI、跨组件协议、序列化契约或外部接口用 `chusql-boundary-contracts`（均在 `.agents/skills/`）。
+- 跨领域组合相关 Skills，无关任务不加载；Skills 不覆盖更高优先级的安全和工程约束。
+- 简单任务直接执行；采用最小必要改动，允许有明确收益且能验证的局部结构优化，优先删除重复和无用代码。
+- 保持代码最简：用最少且易读的代码完整解决当前需求，优先复用现有实现与标准库；相同规则只维护一份，不引入仅为缩短函数或预留未来而存在的抽象、包装、配置和依赖。简化须保持求值顺序、错误传播、边界校验及恢复约束，不以压缩行数牺牲清晰度或正确性。
+- Haskell 编码后对受影响源码运行 HLint（与 nvim 的提示来源一致），修复能保持语义的建议；不通过禁用提示绕过检查。优先使用 `void`、`when/unless`、`fromMaybe`、`isJust/isNothing`、`maybeToList`、`zipWithM` 等惯用函数，避免冗余 lambda、括号、绑定、导入与 LANGUAGE pragma；涉及惰性、严格性或类型表示变化的建议须核对语义，不能机械套用。
+- 测试强度与实际风险及影响范围匹配，不机械新增测试，不盲目追求覆盖率；数据库内核微改动也须验证关键行为。
+- 不强制 TDD、子代理或多阶段审查；减少无关读取、重复搜索、工具调用和输出，Skills 不应增加无收益的流程。
+- 文档描述当前状态；不创建整改报告、修改流水账或无用途的兼容层，不修改 Git 历史。
+
+## 注释规范
+- 文件级：外部引用语句（Haskell `import`、Rust `use`、JS `import`、HTML 的 `<link>`/`<script>`、
+  CSS `@import`、脚本的依赖/参数区）之后写一段注释，概括本文件的功能；没有引用语句的文件写在
+  文件开头。长度不超过 3 行、合计不超过 90 字。
+- 函数级：每个函数（含 Haskell 的 `where`/`let` 内函数、Rust 的私有 `fn`）前用一行不超过
+  30 字的注释说明它做什么。
+- 摘要说明做什么；仅在必要处补充不直观的不变量、所有权与安全约束，不记录历史和被删实现。
+
+## 协作规则
+- 全量门禁入口：`gate-check/run-gate.ps1`（三条车道并行，日志写仓库根的 `logs/`）。
+- 局部改动运行受影响模块的规定测试；较大改动由 agent 执行全量门禁，通过后再提交。
+- engine / web / storage 使用规定测试入口。
+- 规定入口见 `gate-check/run-step.ps1`；Haskell 构建串行，存储协议改动须重建实际动态库。
+- 改动说明只在交流中记录。

README.md

@@ -1,8 +1,13 @@
 # ChuSQL
 
-[![Release](docs/badges/release.svg)](https://github.com/TheBadRoger/ChuSQL/releases) [![Commit](docs/badges/commit.svg)](https://github.com/TheBadRoger/ChuSQL/commits/main) ![Haskell + Rust](docs/badges/languages.svg) [![Code lines](docs/badges/lines.svg)](scripts/update-code-lines.ps1)
+<p align="center">
-
+  <img src="https://img.shields.io/badge/Haskell-5e5086?style=flat-square" alt="Haskell">
-[![Build](docs/badges/build.svg)](https://github.com/TheBadRoger/ChuSQL/actions/workflows/build.yml) [![Tests](docs/badges/tests.svg)](https://github.com/TheBadRoger/ChuSQL/actions/workflows/linux.yml) [![Gate](docs/badges/gate.svg)](https://github.com/TheBadRoger/ChuSQL/actions/workflows/gate.yml)
+  <img src="https://img.shields.io/badge/Rust-dea584?style=flat-square" alt="Rust">
+  <a href="https://github.com/TheBadRoger/ChuSQL/actions/workflows/build.yml"><img src="https://img.shields.io/github/actions/workflow/status/TheBadRoger/ChuSQL/build.yml?branch=main&amp;label=build&amp;style=flat-square" alt="Build"></a>
+  <a href="https://github.com/TheBadRoger/ChuSQL/actions/workflows/linux.yml"><img src="https://img.shields.io/github/actions/workflow/status/TheBadRoger/ChuSQL/linux.yml?branch=main&amp;label=tests&amp;style=flat-square" alt="Tests"></a>
+  <a href="https://github.com/TheBadRoger/ChuSQL/releases"><img src="https://img.shields.io/github/v/release/TheBadRoger/ChuSQL?style=flat-square" alt="Release"></a>
+  <br>
+</p>
 
 ChuSQL 是采用 Haskell SQL 引擎与 Rust 存储层的数据库项目，提供 TCP 服务、CLI 和 Web 管理端。支持查询优化、快照事务、WAL 崩溃恢复、DOMAIN 自定义类型及用户与角色管理。
 

benchmark/src/Main.hs

@@ -2,6 +2,7 @@
 
 module Main where
 
+import Data.Either (lefts)
 import ChuSQL.Core.Protocol (QueryResult (..), TableInfo (..))
 import ChuSQL.Interface.Link (Client, clientPing, closeClient, connectClient)
 import ChuSQL.Interface.Session (
@@ -15,7 +16,7 @@ import ChuSQL.Interface.Session (
 import Control.Concurrent (forkIO, forkFinally, threadDelay)
 import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (IOException, bracket, evaluate, throwIO, try)
-import Control.Monad (forM, forM_, replicateM, unless, when)
+import Control.Monad (forM_, replicateM, unless, when, void)
 import Data.List (intercalate, sort)
 import ChuSQL.Core.Model (Value (..))
 import Data.Text (Text)
@@ -32,7 +33,7 @@ import System.Environment (getArgs)
 import System.Exit (ExitCode (..), exitFailure)
 import System.FilePath ((</>))
 import System.Info (os)
-import System.IO (Handle, hGetLine)
+import System.IO (Handle, hGetLine, hSetBuffering, BufferMode (LineBuffering), stdout)
 import System.Process (
     CreateProcess (std_err, std_out),
     ProcessHandle,
@@ -77,7 +78,7 @@ timedQuery bench sql = do
         Left _ -> pure (-1)
         Right result -> evaluate (qrRowCount result)
     t1 <- getMonotonicTime
-    pure (t1 - t0, either Left (const (Right n)) r)
+    pure (t1 - t0, const (Right n) =<< r)
 
 -- | 打印一行结果
 report :: String -> Either Text Int -> Double -> IO ()
@@ -107,7 +108,7 @@ batchInsert bench label n mkSql = do
     results <- mapM (runSql bench . mkSql) [1 .. n]
     t1 <- getMonotonicTime
     let total = t1 - t0
-        errs = [e | Left e <- results]
+        errs = lefts results
     case errs of
         [] -> do
             printf
@@ -181,7 +182,7 @@ runBatch bench sqls = do
     t0 <- getMonotonicTime
     results <- mapM (runSql bench) sqls
     t1 <- getMonotonicTime
-    pure (t1 - t0, [e | Left e <- results])
+    pure (t1 - t0, lefts results)
 
 -- | 把 1..n 按 size 切成一段段
 chunked :: Int -> Int -> [[Int]]
@@ -484,6 +485,7 @@ stopProcess process = do
 -- | 主入口
 main :: IO ()
 main = do
+    hSetBuffering stdout LineBuffering
     args <- getArgs
     unless (length args <= 2) (ioError (userError "usage: benchmark4csql [users=10000] [orders=50000]"))
     let values = take 2 (args ++ drop (length args) ["10000", "50000"])
@@ -588,9 +590,10 @@ pressureScenarios bench u o = do
     _ <- runSql bench "CREATE TABLE writes (id int, name str, age int)"
     _ <- batchInsert bench "200 individual durable INSERTs" 200 (\i -> printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i)
     (milliseconds, ()) <- measure $ do
-        _ <- runSql bench "BEGIN"
+        (beginMs, _) <- measure (runSql bench "BEGIN")
-        forM_ [201 .. 400 :: Int] $ \i -> runSql bench (printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i) >> pure ()
+        (stagedMs, ()) <- measure $ forM_ [201 .. 400 :: Int] $ \i -> void (runSql bench (printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i))
-        _ <- runSql bench "COMMIT"
+        (commitMs, _) <- measure (runSql bench "COMMIT")
+        printf "TXN_PHASE begin_ms=%.3f staged_ms=%.3f commit_ms=%.3f\n" beginMs stagedMs commitMs
         pure ()
     printf "WRITE transaction200 total_ms=%.3f rows_s=%.2f\n" milliseconds (200000 / milliseconds)
     checkCount bench "writes" 400
@@ -607,17 +610,33 @@ pressureScenarios bench u o = do
 -- | 用多条独立会话同步开始点查
 concurrentLookup :: Bench -> Int -> IO ()
 concurrentLookup bench workers = do
-    completions <- forM [1 .. workers] $ \_ -> do
+    completions <- replicateM
-        start <- newEmptyMVar
+                     workers
+                     (do start <- newEmptyMVar
                          done <- newEmptyMVar
-        client <- connectClient "127.0.0.1" (bPort bench) >>= either (ioError . userError . T.unpack) pure
+                         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
+                         authenticateSession session "admin" ""
-        switchDatabase session "bench" >>= either (ioError . userError . T.unpack) pure
+                           >>= either (ioError . userError . T.unpack) pure
-        _ <- forkFinally (takeMVar start >> bracket (pure client) closeClient (\_ -> replicateM 100 (fst <$> measure (do
+                         switchDatabase session "bench"
-            result <- runStatement session "SELECT id FROM users WHERE id = 1"
+                           >>= either (ioError . userError . T.unpack) pure
-            unless (fmap qrRows result == Right [[VInt 1]]) (ioError (userError "concurrent lookup mismatch")))))) (putMVar done)
+                         _ <- forkFinally
-        pure (start, done)
+                                (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"))))))
+                                (putMVar done)
+                         pure (start, done))
     (milliseconds, results) <- measure $ do
         mapM_ (\(start, _) -> putMVar start ()) completions
         mapM (takeMVar . snd) completions

chusql-bootstrap/app/Main.hs

@@ -2,6 +2,7 @@
 
 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)
@@ -139,7 +140,7 @@ runMaintenance opts mode = do
         Left err -> failWith err
         Right plain -> do
             encoded <- if T.null plain then pure "" else hashPassword plain
-            let request = A.object ["mode" A..= mode, "user" A..= maybe "root" id (optUser opts), "password_hash" A..= encoded, "types" A..= preinstalledTypes]
+            let request = A.object ["mode" A..= mode, "user" A..= fromMaybe "root" (optUser opts), "password_hash" A..= encoded, "types" A..= preinstalledTypes]
             reply <- maintainStorage path (BL.toStrict (A.encode request))
             case reply of
                 Left err -> failWith err
@@ -155,9 +156,8 @@ send request = do
 readPassword :: Options -> IO (Either String Text)
 readPassword opts
     | optPasswordless opts = pure (Right "")
-    | optPasswordStdin opts = do
+    | optPasswordStdin opts = do Right . T.dropWhileEnd (\ c -> c == '\r' || c == '\n')
-        line <- TIO.getLine
+                                   <$> TIO.getLine
-        pure (Right (T.dropWhileEnd (\c -> c == '\r' || c == '\n') line))
     | otherwise = pure (Left "pass --password-stdin or --passwordless")
 
 -- | 打印错误并退出 1

chusql-bootstrap/chusql-bootstrap.cabal

@@ -28,6 +28,10 @@ executable csql-bootstrap
                     , text
     default-language: Haskell2010
     ghc-options:      -Wall
+    if os(linux)
+        ld-options: -Wl,-rpath,$ORIGIN
+    if os(osx)
+        ld-options: -Wl,-rpath,@loader_path
 
 test-suite chusql-bootstrap-test
     type: exitcode-stdio-1.0

chusql-bootstrap/test/Spec.hs

@@ -2,6 +2,7 @@
 
 module Main (main) where
 
+import Data.Maybe (fromMaybe)
 import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
 import ChuSQL.Core.Protocol (Account (..))
 import ChuSQL.Core.Model (columnType, typeName)
@@ -81,11 +82,11 @@ ready = A.object ["status" A..= ("system" :: Text), "initialized" A..= True]
 
 -- | 带最高权限属性的身份响应
 identity :: Bool -> A.Value
-identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [Account 1 "root" "existing-hash" 1 "" Nothing True super True False]]
+identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [Account 1 "root" "existing-hash" 1 "" Nothing True super True False False]]
 
 -- | 已写入编号的类型响应
 installed :: A.Value
-installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= map numbered (zip [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)
@@ -93,7 +94,7 @@ installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= map numbered (
 
 -- | 读取响应中的一个字段
 field :: A.Key -> A.Value -> A.Value
-field key (A.Object fields) = maybe A.Null id (KM.lookup key fields)
+field key (A.Object fields) = fromMaybe A.Null (KM.lookup key fields)
 field _ _ = A.Null
 
 -- | 记录请求并返回指定响应

chusql-cli/app/Main.hs

@@ -2,22 +2,25 @@
 
 module Main (main) where
 
+import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
 import ChuSQL.CLI.Password (readPasswordInput)
 import ChuSQL.CLI.Script (stripTerminator)
 import ChuSQL.Interface.Session (
     Session,
     authenticateSession,
+    authenticateSudoSession,
     isPlainIdentifier,
     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)
-import Control.Monad (unless)
+import Control.Monad (unless, when)
-import Data.IORef (newIORef)
+import Data.IORef (IORef, newIORef)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -38,6 +41,9 @@ data Options = Options
     , optExecute :: Maybe Text
     , optHistory :: Maybe FilePath
     , optConfig :: Maybe FilePath
+    , optNormalize :: Maybe Text
+    , optDeclaration :: Maybe FilePath
+    , optSudo :: Bool
     }
 
 -- | 命令行参数解析器
@@ -61,15 +67,19 @@ optionsParser =
                 <> metavar "FORMAT"
                 <> value FormatTable
                 <> showDefaultWith (T.unpack . formatName)
-                <> help "Output format: table, json or csv"
+                <> help "Output format: table (or text), json or csv"
             )
         <*> optional (T.pack <$> strOption (long "execute" <> short 'e' <> metavar "SQL" <> help "Run one statement and exit"))
         <*> optional (strOption (long "history" <> metavar "FILE" <> help "SQL history file (default ~/.chusql_history)"))
         <*> optional (strOption (long "config" <> metavar "FILE" <> help "Config file to read (default: the fixed settings.toml under the system config directory)"))
+        <*> optional (T.pack <$> strOption (long "normalize" <> metavar "TABLE" <> help "Analyze normalization using explicit declarations"))
+        <*> optional (strOption (long "declaration" <> metavar "FILE" <> help "UTF-8 JSON normalization declaration"))
+        <*> switch (long "sudo" <> help "Authenticate using the local root or elevated administrator identity")
 
 -- | 把 --format 的取值解析成格式
 formatReader :: String -> Either String OutputFormat
-formatReader raw = maybe (Left "format must be table, json or csv") Right (parseFormat (T.pack raw))
+formatReader "text" = Right FormatTable
+formatReader raw = maybe (Left "format must be table, text, json or csv") Right (parseFormat (T.pack raw))
 
 -- | 命令行界面与帮助
 parserInfo :: ParserInfo Options
@@ -87,24 +97,38 @@ main = do
     hSetEncoding stdout utf8
     hSetEncoding stderr utf8
     options <- execParser parserInfo
+    case (optNormalize options, optDeclaration options, optExecute options, optFormat options) of
+        (Nothing, Nothing, _, _) -> pure ()
+        (Just _, Just _, Nothing, format) | format /= FormatCsv -> pure ()
+        _ -> reportError "--normalize requires --declaration, text/json format and cannot be combined with --execute" >> exitFailure
     configPath <- resolveConfigPath (optConfig options)
     base <- loadWebConfigAt configPath
     config <- loadServerConfigAt configPath
     let rootName = rootUserName base
-        userName = fromMaybe rootName (optUser options)
+        userName = fromMaybe (if optSudo options then scSudoUser config else rootName) (optUser options)
-    password <- promptPassword userName
+    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
+            Right proof -> pure (Just proof)
+        else pure Nothing
+    password <- if optSudo options then pure "" else promptPassword userName
     connected <- connectClient (T.pack (scHost config)) (scPort config)
     case connected of
         Left message -> reportError message >> exitFailure
         Right client ->
-            connect options client userName password
+            connect options client userName password credential
                 `finally` closeClient client
 
 -- | 连 server、登录，之后转入会话
-connect :: Options -> Client -> Text -> Text -> IO ()
+connect :: Options -> Client -> Text -> Text -> Maybe SudoCredential -> IO ()
-connect options client userName password = do
+connect options client userName password credential = do
     session <- newSession client
-    signedIn <- authenticateSession session userName password
+    signedIn <- case credential of
+        Just proof -> authenticateSudoSession session proof userName
+        Nothing -> authenticateSession session userName password
     case signedIn of
         Left message -> reportError message >> exitFailure
         Right () -> runSession options session
@@ -116,7 +140,13 @@ runSession options session = do
     ready <- selectDatabase session (T.strip (optDatabase options))
     if not ready
         then exitFailure
-        else case optExecute options of
+        else case (optNormalize options, optDeclaration options) of
+            (Just table, Just file) -> runNormalizationOnce session table file (optFormat options == FormatJson) >>= \ok -> unless ok exitFailure
+            _ -> runSqlSession options session formatRef
+
+-- 执行 SQL 或进入交互循环。
+runSqlSession :: Options -> Session -> IORef OutputFormat -> IO ()
+runSqlSession options session formatRef = case optExecute options of
     Just sql -> do
         ok <- runStatementOnce session (optFormat options) (stripTerminator sql)
         unless ok exitFailure

chusql-cli/app/Repl.hs

@@ -6,13 +6,14 @@ module Repl
     , reportError
     ) where
 
+import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
 import ChuSQL.CLI.History (historySettings, rememberStatement)
 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)
+import Control.Monad (forM_, when, unless)
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (IORef, readIORef, writeIORef)
 import Data.Text (Text)
@@ -83,7 +84,7 @@ drain :: Session -> IORef OutputFormat -> Text -> InputT IO Text
 drain session formatRef buffer = case takeStatement buffer of
     Nothing -> pure (T.strip buffer)
     Just (statement, rest) -> do
-        when (not (T.null statement)) $ do
+        unless (T.null statement) $ do
             rememberStatement (statement <> ";")
             runOne session formatRef statement
         drain session formatRef rest
@@ -106,6 +107,7 @@ runMeta session formatRef meta = case meta of
     MetaDatabases -> listDatabases session >> pure True
     MetaTables -> listTables session >> pure True
     MetaDescribe name -> describeTable session name >> pure True
+    MetaNormalize table file jsonOutput -> liftIO (runNormalizationOnce session table file jsonOutput) >> pure True
     MetaRoles -> listRoles session >> pure True
     MetaConnect name -> do
         switched <- liftIO (switchDatabase session name)

chusql-cli/chusql-cli.cabal

@@ -12,6 +12,7 @@ build-type:     Simple
 library
     hs-source-dirs:   src
     exposed-modules:  ChuSQL.CLI.Format
+                      ChuSQL.CLI.Normalization
                       ChuSQL.CLI.History
                       ChuSQL.CLI.Password
                       ChuSQL.CLI.Script
@@ -55,6 +56,7 @@ test-suite chusql-cli-test
                     , directory
                     , aeson
                     , bytestring
+                    , chusql-interface
                     , chusql-cli
                     , chusql-core-model
                     , hspec

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

@@ -14,6 +14,7 @@ module ChuSQL.CLI.Format
 
 import ChuSQL.Core.Model (Value (..))
 import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
+import ChuSQL.Core.Runtime (renderRuntimeValue)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
 import Data.Text (Text)
@@ -109,3 +110,4 @@ displayValue (VFloat d) = T.pack (show d)
 displayValue (VStr s) = T.pack s
 displayValue (VBool True) = "true"
 displayValue (VBool False) = "false"
+displayValue (VRuntime _ value) = T.pack (renderRuntimeValue value)

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

@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.CLI.Normalization (normalizationArguments, loadNormalizationDeclaration, renderNormalization, runNormalizationOnce) where
+
+import ChuSQL.Interface.Normalization
+import ChuSQL.Interface.Session (Session, sessionDatabase, analyzeNormalization)
+import Control.Exception (IOException, try)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Key as K
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BL
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.IO as TIO
+import System.IO (IOMode (ReadMode), stderr, withBinaryFile)
+import Text.ParserCombinators.ReadP
+
+-- CLI 范式入口：读取严格声明文件、发送专用请求并显示报告。
+
+-- 解析表、声明路径和独立显示格式。
+normalizationArguments :: Text -> Either Text (Text, FilePath, Bool)
+normalizationArguments input = case readP_to_S (skipSpaces *> sepBy token skipSpaces <* skipSpaces <* eof) (T.unpack input) of
+    [(parts, "")] -> case parts of
+        [table, "--declaration", file] -> Right (T.pack table, file, False)
+        [table, "--declaration", file, "--format", "text"] -> Right (T.pack table, file, False)
+        [table, "--declaration", file, "--format", "json"] -> Right (T.pack table, file, True)
+        _ -> Left usage
+    _ -> Left usage
+  where
+    usage = "usage: \\normalize TABLE --declaration FILE [--format text|json]"
+    -- 保留引号内的 Windows 路径及空格。
+    token = quoted '"' <++ quoted '\'' <++ munch1 (\c -> c /= ' ' && c /= '\t' && c /= '\n' && c /= '"' && c /= '\'')
+    -- 读取不带转义解释的引号参数。
+    quoted quote = char quote *> munch (/= quote) <* char quote
+
+-- 有界读取 UTF-8 声明并拒绝重复字段。
+loadNormalizationDeclaration :: FilePath -> IO (Either Text NormalizationDeclaration)
+loadNormalizationDeclaration path = do
+    loaded <- try (withBinaryFile path ReadMode (`BS.hGet` 65537)) :: IO (Either IOException BS.ByteString)
+    pure $ case loaded of
+        Left err -> Left (T.pack (show err))
+        Right raw -> do
+            value <- decodeNormalizationJSON (BL.fromStrict raw)
+            case A.fromJSON value of
+                A.Error message -> Left (T.pack message)
+                A.Success declaration -> Right declaration
+
+-- 保留报告字段并选择文本或 JSON 显示。
+renderNormalization :: Bool -> A.Value -> Text
+renderNormalization True = jsonText
+renderNormalization False = pretty 0
+
+-- 将 JSON 编码为 UTF-8 文本。
+jsonText :: A.Value -> Text
+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 "  "
+pretty depth value = T.replicate depth "  " <> jsonText value
+
+-- 发送声明并让失败决定 CLI 退出码。
+runNormalizationOnce :: Session -> Text -> FilePath -> Bool -> IO Bool
+runNormalizationOnce session table path jsonOutput = do
+    declaration <- loadNormalizationDeclaration path
+    database <- sessionDatabase session
+    result <- case declaration of
+        Left message -> pure (Left message)
+        Right d -> analyzeNormalization session (NormalizationRequest 1 database table d Nothing Nothing)
+    case result of
+        Left message -> TIO.hPutStrLn stderr ("chusql: error: " <> message) >> pure False
+        Right analysis -> TIO.putStrLn (renderNormalization jsonOutput analysis) >> pure True

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

@@ -10,6 +10,8 @@ module ChuSQL.CLI.Script
     , metaHelp
     ) where
 
+import Data.Maybe (isJust)
+import ChuSQL.CLI.Normalization (normalizationArguments)
 import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
 import Data.Char (isSpace)
 import Data.Text (Text)
@@ -23,6 +25,7 @@ data Meta
     | MetaDatabases
     | MetaTables
     | MetaDescribe Text
+    | MetaNormalize Text FilePath Bool
     | MetaRoles
     | MetaConnect Text
     | MetaSetFormat OutputFormat
@@ -50,6 +53,7 @@ parseMeta raw = do
             | otherwise -> MetaDescribe argument
         "dr" -> MetaRoles
         "roles" -> MetaRoles
+        "normalize" -> either (const (MetaUnknown "normalize")) (\(table, file, jsonOutput) -> MetaNormalize table file jsonOutput) (normalizationArguments argument)
         "c" -> connectTo argument
         "connect" -> connectTo argument
         "use" -> connectTo argument
@@ -87,7 +91,7 @@ data ScanState = ScanNormal | ScanString | ScanLineComment | ScanBlockComment
 
 -- | 攒下来的内容里有没有一条以分号结束的语句
 statementComplete :: Text -> Bool
-statementComplete = maybe False (const True) . takeStatement
+statementComplete = isJust . takeStatement
 
 -- | 去掉结尾的空白与分号（-e 直接执行时用）
 stripTerminator :: Text -> Text
@@ -118,6 +122,7 @@ metaHelp =
         , "  \\l, \\list           list databases"
         , "  \\dt, \\d             list tables"
         , "  \\d <table>          describe a table"
+        , "  \\normalize TABLE --declaration FILE [--format text|json]"
         , "  \\dr, \\roles         list roles with their grants and members"
         , "  \\c <database>       switch database"
         , "  \\f, \\format <fmt>   output format: " <> T.intercalate ", " (map formatName [FormatTable, FormatJson, FormatCsv])

chusql-cli/test/Spec.hs

@@ -2,12 +2,15 @@
 
 module Main (main) where
 
-import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable)
+import ChuSQL.CLI.Normalization
+import ChuSQL.Interface.Normalization
+import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable, displayValue)
 import ChuSQL.CLI.History (historySettings, rememberStatement)
 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 Data.Aeson (decode)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
@@ -30,6 +33,11 @@ main = hspec spec
 -- | 全部测试用例
 spec :: Spec
 spec = do
+    normalizationSpec
+    it "renders typed compound values without losing their wire identity" $ do
+        case resolveType builtinTypes (listType intType) of
+            Left err -> expectationFailure err
+            Right descriptor -> displayValue (VRuntime (descriptorId descriptor) (RList [RInt 1, RInt 2])) `shouldBe` "[1, 2]"
     formatSpec
     scriptSpec
     passwordSpec
@@ -183,3 +191,26 @@ sampleResult =
         , qrTruncated = False
         , qrDatabase = Nothing
         }
+
+
+-- 范式元命令、严格文件与显示格式回归。
+normalizationSpec :: Spec
+normalizationSpec = describe "CLI: normalization" $ do
+    it "parses quoted paths without interpreting Windows backslashes" $ do
+        normalizationArguments "users --declaration \"C:\\My Data\\fd.json\" --format json" `shouldBe` Right ("users", "C:\\My Data\\fd.json", True)
+        parseMeta "\\normalize users --declaration deps.json --format text" `shouldBe` Just (MetaNormalize "users" "deps.json" False)
+        normalizationArguments "users --declaration deps.json --format csv" `shouldSatisfy` either (const True) (const False)
+    it "keeps the same report fields in text and JSON output" $ do
+        let report = A.object ["candidate_keys" A..= ([["id"]] :: [[T.Text]]), "conditional" A..= True, "findings" A..= [A.object ["normal_form" A..= ("bcnf" :: T.Text), "verdict" A..= ("insufficient" :: T.Text)]]]
+        A.eitherDecodeStrict (encodeUtf8 (renderNormalization True report)) `shouldBe` Right report
+        renderNormalization False report `shouldSatisfy` T.isInfixOf "candidate_keys"
+        renderNormalization False report `shouldSatisfy` T.isInfixOf "insufficient"
+    it "loads defaults and refuses duplicate JSON fields in declaration files" $ do
+        directory <- getTemporaryDirectory
+        bracket (openTempFile directory "normalization-declaration") (\(path, _) -> removeFile path) $ \(path, handle) -> do
+            hPutStr handle "{}"
+            hClose handle
+            loadNormalizationDeclaration path `shouldReturn` Right (NormalizationDeclaration [] [] False Nothing)
+            BL.writeFile path "{\"atomic_attributes\":true,\"atomic_attributes\":false}"
+            result <- loadNormalizationDeclaration path
+            result `shouldSatisfy` either (T.isInfixOf "duplicate") (const False)

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

@@ -22,6 +22,14 @@ library
                       ChuSQL.Core.Engine.Error
                       ChuSQL.Core.Engine
                       ChuSQL.Core.Engine.Parallel
+                      ChuSQL.Core.Engine.Normalization
+                      ChuSQL.Core.Engine.Runtime.Types
+                      ChuSQL.Core.Engine.Runtime.Functions
+                      ChuSQL.Core.Engine.Runtime.Binding
+                      ChuSQL.Core.Engine.Runtime.SQL
+                      ChuSQL.Core.Engine.Runtime.Query
+                      ChuSQL.Core.Engine.Runtime.Relation
+                      ChuSQL.Core.Engine.Runtime.Dependencies
                       ChuSQL.Core.Engine.Semantic
                       ChuSQL.Core.Engine.Storage
                       ChuSQL.Core.Engine.Storage.FFI
@@ -38,7 +46,9 @@ library
                     , parser-combinators
                     , scientific
                     , text
+                    , transformers
                     , unordered-containers
+                    , vector
     extra-libraries:  chusql_core_storage
     -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
     if os(linux)
@@ -46,11 +56,14 @@ library
     if os(osx)
         ld-options: -Wl,-rpath,@loader_path
     default-language: Haskell2010
+    default-extensions: ImportQualifiedPost
     ghc-options:      -Wall
 
 test-suite chusql-core-engine-test
     type:             exitcode-stdio-1.0
     main-is:          Spec.hs
+    other-modules:    NormalizationSpec
+                      RuntimeSpec
     hs-source-dirs:   test
     build-depends:    base
                     , chusql-core-engine
@@ -59,5 +72,7 @@ test-suite chusql-core-engine-test
                     , filepath
                     , hashable
                     , hspec
+                    , bytestring
+                    , aeson
     default-language: Haskell2010
     ghc-options:      -Wall -threaded

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

@@ -1,17 +1,19 @@
-module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf) where
+module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf, BoundWrite, bindWrite, executeWriteM) where
 
-import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM, evalRelOpM)
+import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM)
 import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
-import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
+import ChuSQL.Core.Engine.Runtime.Query (bindQuery, executeQueryM)
-import ChuSQL.Core.Engine.Algebra.Planner (translate)
+import ChuSQL.Core.Engine.Runtime.Relation (bindWriteColumns, orderRow)
-import ChuSQL.Core.Model
+import ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, typeDependencies, validateDependencies)
-import ChuSQL.Core.Engine.Semantic (prepare)
+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.Maybe (mapMaybe)
-import qualified Data.HashSet as HS
 
 -- 引擎入口：检查语义、按语句分发执行，另有内存实现与泛型版本。
 
@@ -33,69 +35,141 @@ runStatementM (DropDatabase name) = fmap (fmap (const [])) (dropDatabase name)
 runStatementM (UseDatabase name) = fmap (fmap (const [])) (useDatabase name)
 runStatementM ShowDatabases = fmap (fmap (map (\name -> [("database", VStr name)]))) listDatabases
 runStatementM q = do
-    db <- schema
+    result <- schema
-    case prepare db q of
+    case result of
+        Left err -> pure (Left err)
+        Right db
+            | SelectDistinct{} <- q -> runStatementUncheckedM db q
+            | Select{} <- q -> runStatementUncheckedM db q
+            | null (queryTables q) -> case prepare db q >>= bindWriteColumns db of
                 Left err -> pure (Left err)
                 Right resolved -> runStatementUncheckedM db resolved
-
+            | otherwise -> case bindWrite db q of
--- | 按语句类型分发（已检查过）
-runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
-runStatementUncheckedM db q@Select{} =
-    case translate q of
-        Left e -> pure (Left e)
-        Right relOp -> evalRelOpM db (optimize db relOp)
-runStatementUncheckedM db q@SelectExpr{} =
-    case translate q of
-        Left e -> pure (Left e)
-        Right relOp -> evalRelOpM db (optimize db relOp)
-runStatementUncheckedM db (Insert tbl cols rows) =
-    case lookupTable db tbl of
-        Left e -> pure (Left e)
-        Right table -> do
-            current <- existingRows tbl table
-            case current >>= \current' -> buildRows table current' cols rows of
                 Left err -> pure (Left err)
-                Right rs -> do
+                Right bound -> executeWriteM bound
-                    result <- insertMany tbl rs
+
+-- | 保存已有表写入的 schema、依赖及执行动作
+data BoundWrite = BoundWrite Database Database WriteAction
+
+-- | 区分已绑定的数据修改与结构变更
+data WriteAction
+    = InsertAction String InsertPlan [[Expr]]
+    | UpdateAction String UpdatePlan
+    | DeleteAction String [String] (Maybe Expr)
+    | StructureAction Statement
+
+-- | 保存 INSERT 目标、输入宽度及约束
+data InsertPlan = InsertPlan [BoundInsertColumn] Int (Maybe (String, Column)) CheckPlan ConstraintPlan
+
+-- | 保存 UPDATE 布局、赋值、条件及约束
+data UpdatePlan = UpdatePlan [String] [BoundAssignment] (Maybe Expr) CheckPlan ConstraintPlan
+
+-- | 仅用 schema 绑定已有表写入及结构变更
+bindWrite :: Database -> Statement -> Either String BoundWrite
+bindWrite db statement = case statement of
+    Select{} -> unsupported
+    SelectDistinct{} -> unsupported
+    _ | null (queryTables statement) -> unsupported
+      | otherwise -> do
+        resolved <- prepare catalog statement >>= bindWriteColumns catalog
+        let sources = queryTables resolved
+        mapM_ (lookupTable catalog) sources
+        let names = sources ++ domainDependencies catalog sources ++ typeDependencies catalog (declaredTypes resolved)
+            dependencies = [(name, table) | (name, table) <- catalog, name `elem` names]
+        action <- bindWriteAction catalog resolved
+        Right (BoundWrite catalog dependencies action)
+  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 (BoundWrite catalog dependencies action) = do
+    current <- schema
+    case current >>= validateDependencies dependencies of
+        Left err -> pure (Left err)
+        Right () -> withWriteSchemaGuard dependencies (executeWriteActionM catalog action)
+
+-- | 在绑定阶段固定目标槽位与行约束
+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))
+        Right (InsertAction target plan rows)
+    Update target assignments condition -> do
+        table <- lookupTable catalog target
+        bound <- bindUpdateTargets (tableCols table) assignments
+        checks <- checkPlan table
+        let plan = UpdatePlan (map fst (tableCols table)) bound condition checks (constraintPlan (tableCols table))
+        Right (UpdateAction target plan)
+    Delete target condition -> do
+        table <- lookupTable catalog target
+        Right (DeleteAction target (map fst (tableCols table)) condition)
+    _ -> Right (StructureAction statement)
+
+-- | 直接执行已绑定的数据修改或结构动作
+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
+        Left err -> pure (Left err)
+        Right built -> do
+            result <- insertMany target built
             pure (result >> Right [])
-runStatementUncheckedM db (Delete tbl mWhere) = do
+executeWriteActionM catalog (UpdateAction target (UpdatePlan columns assignments condition checks constraints)) = do
-    rowsResult <- scan tbl
+    current <- scan target
-    case rowsResult of
+    case current >>= mapM (orderRow columns) of
         Left err -> pure (Left err)
         Right rows -> do
-            split <- splitByConditionM db mWhere rows
+            updated <- mapM (updateRowM catalog checks condition assignments) rows
+            case sequence updated >>= \newRows -> enforceConstraints constraints [] newRows >> Right newRows of
+                Left err -> pure (Left err)
+                Right newRows -> do
+                    result <- replaceAll target newRows
+                    pure (result >> Right [])
+executeWriteActionM catalog (DeleteAction target columns condition) = do
+    current <- scan target
+    case current >>= mapM (orderRow columns) of
+        Left err -> pure (Left err)
+        Right rows -> do
+            split <- splitByConditionM catalog condition rows
             case split of
                 Left err -> pure (Left err)
-                Right (doomed, kept) ->
+                Right (doomed, kept) -> case mapM rowId doomed of
-                    case mapM rowId doomed of
                     Right ids -> do
-                            result <- deleteKeys tbl ids
+                        result <- deleteKeys target ids
                         pure (result >> Right [])
                     Left _ -> do
-                            result <- replaceAll tbl kept
+                        result <- replaceAll target kept
                         pure (result >> Right [])
   where
-    -- | 取行里的整数 id，取不到就报错
+    -- | 取整数主键，否则使用原有整表删除路径
-    rowId :: Row -> Either String Int
+    rowId row = case lookup "id" row of
-    rowId r = case lookup "id" r of
+        Just (VInt key) -> Right key
-        Just (VInt k) -> Right k
         _ -> Left "row has no integer id"
-runStatementUncheckedM db (Update tbl assigns mWhere) =
+executeWriteActionM catalog (StructureAction statement) = runStatementUncheckedM catalog statement
-    case lookupTable db tbl of
+
+-- | 绑定并执行查询语句
+runQueryM :: MonadStorage m => Database -> Statement -> m (Either String [Row])
+runQueryM db q = case bindQuery db q of
     Left e -> pure (Left e)
-        Right table -> do
+    Right bound -> executeQueryM bound
-            rowsResult <- scan tbl
+
-            case rowsResult of
+-- | 分发语句，查询由 BoundQuery 绑定
-                Left err -> pure (Left err)
+runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
-                Right rows -> case checkPlan table of
+runStatementUncheckedM db q@SelectDistinct{} = runQueryM db q
-                    Left err -> pure (Left err)
+runStatementUncheckedM db q@Select{} = runQueryM db q
-                    Right plan -> do
+runStatementUncheckedM _ Insert{} = pure (Left "INSERT requires a bound write plan")
-                        newRows <- mapM (updateRowM db table plan mWhere assigns) rows
+runStatementUncheckedM _ Update{} = pure (Left "UPDATE requires a bound write plan")
-                        case sequence newRows of
+runStatementUncheckedM _ Delete{} = pure (Left "DELETE requires a bound write plan")
-                            Left err -> pure (Left err)
-                            Right rs -> do
-                                result <- replaceAll tbl rs
-                                pure (result >> Right [])
 runStatementUncheckedM _ (CreateTable name cols) = do
     result <- createTable name cols
     pure (result >> Right [])
@@ -105,9 +179,15 @@ runStatementUncheckedM _ (CreateDomain name base) = do
 runStatementUncheckedM _ (DropDomain name) = do
     result <- dropTable (domainTableName name)
     pure (result >> Right [])
-runStatementUncheckedM db ShowDomains = pure (Right
+runStatementUncheckedM db ShowDomains =
-    [[("domain", VStr (drop (length (domainTableName "")) name)), ("base_type", VStr (typeName (columnType base)))]
+    pure
-    | (name, table) <- db, isDomainTable name, Just base <- [lookup "base" (tableCols table)]])
+        ( Right
+            [ [("domain", VStr (drop (length (domainTableName "")) name)), ("base_type", VStr (typeName (columnType base)))]
+            | (name, table) <- db
+            , isDomainTable name
+            , Just base <- [lookup "base" (tableCols table)]
+            ]
+        )
 runStatementUncheckedM _ (DropTable name) = do
     result <- dropTable name
     pure (result >> Right [])
@@ -133,11 +213,13 @@ runStatementUncheckedM db (AlterColumnNull tbl col nullable) =
 runStatementUncheckedM _ CreateUser{} = pure (Left "CREATE USER is executed by the account service")
 runStatementUncheckedM _ AlterUser{} = pure (Left "ALTER USER is executed by the account service")
 runStatementUncheckedM _ AlterIdentity{} = pure (Left "ALTER ROLE is executed by the account service")
+runStatementUncheckedM _ ShowGrants = pure (Left "SHOW GRANTS is executed by the account service")
 runStatementUncheckedM _ ShowRoles = pure (Left "SHOW ROLES is executed by the account service")
 runStatementUncheckedM _ DropUser{} = pure (Left "DROP USER is executed by the account service")
 runStatementUncheckedM _ CreateRole{} = pure (Left "CREATE ROLE is executed by the privilege service")
 runStatementUncheckedM _ DropRole{} = pure (Left "DROP ROLE is executed by the privilege service")
 runStatementUncheckedM _ GrantPrivileges{} = pure (Left "GRANT is executed by the privilege service")
+runStatementUncheckedM _ RevokeGrantOption{} = pure (Left "REVOKE is executed by the privilege service")
 runStatementUncheckedM _ RevokePrivileges{} = pure (Left "REVOKE is executed by the privilege service")
 runStatementUncheckedM _ GrantRole{} = pure (Left "GRANT is executed by the privilege service")
 runStatementUncheckedM _ RevokeRole{} = pure (Left "REVOKE is executed by the privilege service")
@@ -153,62 +235,67 @@ runStatementUncheckedM _ RollbackToSavepoint{} = pure (Left "ROLLBACK TO is exec
 runStatementUncheckedM _ ReleaseSavepoint{} = pure (Left "RELEASE is executed by the session")
 
 -- | 只有需要读全表才能判断约束时才扫表
-existingRows :: (MonadStorage m) => String -> Table -> m (Either String [Row])
+existingRows :: (MonadStorage m) => String -> InsertPlan -> m (Either String [Row])
-existingRows tbl table
+existingRows tbl (InsertPlan _ _ auto _ (ConstraintPlan _ _ unique))
-    | needsRows table = scan tbl
+    | Just _ <- auto = scan tbl
+    | not (null unique) = scan tbl
     | otherwise = pure (Right [])
-  where
-    -- | 这一表有没有要判约束的列
-    needsRows t = any (constraintColumn . snd) (tableCols t)
-    -- | 这一列带不带要判的约束
-    constraintColumn c = columnAutoIncrement c || columnUnique c || columnPrimaryKey c
 
 -- | 插一行：补齐缺列、给自增值、收类型、查约束
-buildRows :: Table -> [Row] -> [String] -> [[Expr]] -> Either String [Row]
+buildRows :: InsertPlan -> [Row] -> [[Expr]] -> Either String [Row]
-buildRows table current cols rows = do
+buildRows (InsertPlan layout width auto checks constraints) current rows = do
-    values <- mapM (mapM (\e -> evalExpr e [])) rows
+    values <- mapM (mapM (`evalExpr` [])) rows
-    if any (\vals -> length vals /= length cols) values
+    if any (\vals -> length vals /= width) values
         then Left "column count does not match value count"
-        else do
+        else go (autoStart auto current) values []
-            let auto = autoColumn table
-            go auto (autoStart auto current) values []
   where
-    -- | 逐行构造，最后统一查一遍约束
+    -- \| 逐行构造，最后统一查一遍约束
-    go _ _ [] acc = do
+    go _ [] acc = do
         let built = reverse acc
-        plan <- checkPlan table
+        mapM_ (runChecks checks) built
-        mapM_ (runChecks plan) built
+        enforceConstraints constraints current built
-        enforceNotNull (tableCols table) built
-        enforceUnique (tableCols table) (current ++ built)
         Right built
-    go auto counter (vals : rest) acc = do
+    go counter (vals : rest) acc = do
-        (row, counter') <- buildRow table auto cols counter vals
+        (row, counter') <- buildRow layout auto counter vals
-        go auto counter' rest (row : acc)
+        go counter' rest (row : acc)
 
--- | 按列定义补出一行
+-- | 保存输出列定义及可选 VALUES 槽位
-buildRow :: Table -> Maybe (String, Column) -> [String] -> Int -> [Value] -> Either String (Row, Int)
+data BoundInsertColumn = BoundInsertColumn String Column (Maybe Int)
-buildRow table auto cols counter vals = go (tableCols table) counter []
+
+-- | 把已校验的目标清单绑定为输入槽位
+bindInsertTargets :: [(String, Column)] -> [String] -> [BoundInsertColumn]
+bindInsertTargets columns targets =
+    [BoundInsertColumn name column (lookup name positions) | (name, column) <- columns]
   where
-    provided = zip cols vals
+    positions = zip targets [0 ..]
-    -- | 按列定义逐列补值
+
+-- | 按绑定槽位和列定义补出一行
+buildRow :: [BoundInsertColumn] -> Maybe (String, Column) -> Int -> [Value] -> Either String (Row, Int)
+buildRow layout auto counter vals = go layout counter []
+  where
+    provided = HM.fromList (zip [0 :: Int ..] vals)
+    -- \| 按列定义逐列补值
     go [] c acc = Right (reverse acc, c)
-    go ((name, col) : rest) c acc = do
+    go (BoundInsertColumn name col position : rest) c acc = do
-        (v, c') <- pick name col c
+        supplied <- mapM (\slot -> maybe (Left ("missing bound INSERT value: " ++ name)) Right (HM.lookup slot provided)) position
+        (v, c') <- pick name col supplied c
         v' <- coerceValue (columnType col) v
         go rest c' ((name, v') : acc)
-    -- | 决定这一列取什么值
+    -- \| 决定这一列取什么值
-    pick name col c
+    pick name col supplied c
         | Just (autoName, _) <- auto
         , name == autoName
-        , maybe True (== VNull) (lookup name provided) = Right (VInt c, c + 1)
+        , maybe True (== VNull) supplied =
-        | Just v <- lookup name provided = Right (v, bump name col c v)
+            Right (VInt c, c + 1)
+        | Just v <- supplied = Right (v, bump name c v)
         | Just d <- columnDefault col = Right (d, c)
         | columnNullable col = Right (VNull, c)
         | otherwise = Left ("INSERT: column " ++ name ++ " is NOT NULL and has no default")
-    -- | 自增值跟着已有的值往前推
+    -- \| 自增值跟着已有的值往前推
-    bump name _ c v
+    bump name c v
         | Just (autoName, _) <- auto
-        , name == autoName = max (c + 1) (valueInt v + 1)
+        , name == autoName =
+            max (c + 1) (valueInt v + 1)
         | otherwise = c
 
 -- | 取自增值，不是整数就当 0
@@ -230,25 +317,29 @@ autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup
     ns -> maximum ns + 1
 
 -- | 一次解析出来的 CHECK 条件
-type CheckPlan = [(String, Expr)]
+data CheckPlan = CheckPlan [String] [(String, Expr)]
 
--- | 把表上的 CHECK 文本解析成条件，每语句只解析一次
+-- | 按 schema 解析并绑定表上全部 CHECK
 checkPlan :: Table -> Either String CheckPlan
-checkPlan table = mapM parse (mapMaybe checked (tableCols table))
+checkPlan table = CheckPlan (map fst (tableCols table)) <$> mapM parse (mapMaybe checked (tableCols table))
   where
-    -- | 只挑出带 CHECK 文本的列
+    -- \| 只挑出带 CHECK 文本的列
     checked (name, col) = (,) name <$> columnCheck col
-    -- | 解析一列的 CHECK 文本
+    -- \| 解析一列的 CHECK 文本
     parse (name, text) = case parseExpression text of
         Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
-        Right e -> Right (name, e)
+        Right e -> do
+            bound <- prepareCheckExpression (tableCols table) e
+            Right (name, bound)
 
 -- | 执行解析好的 CHECK 条件
 runChecks :: CheckPlan -> Row -> Either String ()
-runChecks plan row = mapM_ check plan
+runChecks (CheckPlan columns plan) row = do
+    ordered <- orderRow columns row
+    mapM_ (check ordered) plan
   where
-    -- | 跑一条 CHECK
+    -- \| 跑一条 CHECK
-    check (name, e) = case evalCondForRow e row of
+    check ordered (name, e) = case evalCondForRow e ordered of
         Left err -> Left ("CHECK on " ++ name ++ ": " ++ err)
         Right True -> Right ()
         Right False -> Left ("CHECK on " ++ name ++ " failed")
@@ -257,34 +348,52 @@ runChecks plan row = mapM_ check plan
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
 
--- | NOT NULL 检查
+-- | 保存非空及唯一键的固定列槽位
-enforceNotNull :: [(String, Column)] -> [Row] -> Either String ()
+data ConstraintPlan = ConstraintPlan [String] [(String, Expr)] [(String, Expr)]
-enforceNotNull cols rows = mapM_ check cols
+
+-- | 按 schema 一次绑定行集约束目标
+constraintPlan :: [(String, Column)] -> ConstraintPlan
+constraintPlan columns = ConstraintPlan (map fst columns) required unique
   where
-    -- | 查这一列的 NOT NULL
+    slots = [(name, column, ColumnSlot slot name) | (slot, (name, column)) <- zip [0 ..] columns]
-    check (name, col)
+    required = [(name, reference) | (name, column, reference) <- slots, not (columnNullable column)]
-        | columnNullable col = Right ()
+    unique = [(name, reference) | (name, column, reference) <- slots, columnUnique column || columnPrimaryKey column]
-        | any (\r -> lookup name r == Just VNull) rows = Left ("NOT NULL: column " ++ name ++ " cannot be null")
+
-        | otherwise = Right ()
+-- | 检查新行非空及合并旧行后的唯一性
+enforceConstraints :: ConstraintPlan -> [Row] -> [Row] -> Either String ()
+enforceConstraints (ConstraintPlan columns required unique) current rows = do
+    enforceNotNull required rows
+    orderedCurrent <- mapM (orderRow columns) current
+    enforceUnique unique (orderedCurrent ++ rows)
+
+-- | NOT NULL 检查
+enforceNotNull :: [(String, Expr)] -> [Row] -> Either String ()
+enforceNotNull targets rows = mapM_ check targets
+  where
+    -- | 按 schema 槽位检查 NOT NULL
+    check (name, reference) = do
+        values <- mapM (evalExpr reference) rows
+        if VNull `elem` values
+            then Left ("NOT NULL: column " ++ name ++ " cannot be null")
+            else Right ()
 
 -- | 唯一性检查（NULL 之间不算冲突）
-enforceUnique :: [(String, Column)] -> [Row] -> Either String ()
+enforceUnique :: [(String, Expr)] -> [Row] -> Either String ()
-enforceUnique cols rows = mapM_ check targets
+enforceUnique targets rows = mapM_ check targets
   where
-    targets = [(n, c) | (n, c) <- cols, columnUnique c || columnPrimaryKey c]
+    -- \| 查这一列有没有重复值
-    -- | 查这一列有没有重复值
+    check (name, reference) = mapM (evalExpr reference) rows >>= go name HS.empty
-    check (name, _) = go name HS.empty (mapMaybe (lookup name) rows)
+    -- \| 逐个值比过去
-    -- | 逐个值比过去
     go _ _ [] = Right ()
-    -- | NULL 不算冲突，跳过
+    -- \| NULL 不算冲突，跳过
     go name seen (VNull : rest) = go name seen rest
     go name seen (v : rest)
         | HS.member (canonicalValue v) seen = Left ("UNIQUE: duplicate value in column " ++ name)
         | otherwise = go name (HS.insert (canonicalValue v) seen) rest
 
 -- | UPDATE 的一行（条件与赋值都可能带子查询）
-updateRowM :: (MonadStorage m) => Database -> Table -> CheckPlan -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row)
+updateRowM :: (MonadStorage m) => Database -> CheckPlan -> Maybe Expr -> [BoundAssignment] -> Row -> m (Either String Row)
-updateRowM db table plan cond asgns row = do
+updateRowM db plan cond asgns row = do
     keep <- case cond of
         Nothing -> pure (Right True)
         Just e -> evalCondForRowM db e row
@@ -292,31 +401,45 @@ updateRowM db table plan cond asgns row = do
         Left err -> pure (Left err)
         Right False -> pure (Right row)
         Right True -> do
-            row' <- applyUpdatesM db table asgns row
+            row' <- applyUpdatesM db asgns row
             pure (row' >>= \r -> runChecks plan r >> Right r)
 
--- | 依次求值、收类型并覆盖列（表达式可以带子查询）
+-- | 保存赋值目标槽位、列定义和右侧表达式
-applyUpdatesM :: (MonadStorage m) => Database -> Table -> [(String, Expr)] -> Row -> m (Either String Row)
+data BoundAssignment = BoundAssignment Int String Column Expr
-applyUpdatesM _ _ [] row = pure (Right row)
-applyUpdatesM db table ((col, e) : rest) row = do
-    v <- evalExprM db e row
-    case v of
-        Left err -> pure (Left err)
-        Right val -> case colType table col of
-            Just def -> case coerceValue (columnType def) val of
-                Left err -> pure (Left err)
-                Right v' -> applyUpdatesM db table rest (setColumn col v' row)
-            Nothing -> applyUpdatesM db table rest (setColumn col val row)
 
--- | 覆盖一列
+-- | 按 schema 一次绑定全部赋值目标
-setColumn :: String -> Value -> Row -> Row
+bindUpdateTargets :: [(String, Column)] -> [(String, Expr)] -> Either String [BoundAssignment]
-setColumn col v = map (\(k, val) -> if k == col then (k, v) else (k, val))
+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)
+        _ -> Left ("UPDATE: ambiguous target column: " ++ name)
+
+-- | 依次求值并按目标槽位收类型和覆盖
+applyUpdatesM :: (MonadStorage m) => Database -> [BoundAssignment] -> Row -> m (Either String Row)
+applyUpdatesM _ [] row = pure (Right row)
+applyUpdatesM db (assignment@(BoundAssignment _ _ _ e) : rest) row = do
+    v <- evalExprM db e row
+    case v >>= writeAssignment assignment row of
+        Left err -> pure (Left err)
+        Right updated -> applyUpdatesM db rest updated
+
+-- | 校验目标位置并只覆盖该槽位的值
+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
+        coerced <- coerceValue (columnType column) value
+        Right (before ++ ((name, coerced) : after))
+    (_, []) -> Left ("missing bound column: " ++ name)
+    _ -> Left ("bound column position mismatch: " ++ name)
 
 -- | 按条件把行分成待删和保留两拨（条件可以带子查询）
 splitByConditionM :: (MonadStorage m) => Database -> Maybe Expr -> [Row] -> m (Either String ([Row], [Row]))
 splitByConditionM db cond = go [] []
   where
-    -- | 逐行分流
+    -- \| 逐行分流
     go doomed kept [] = pure (Right (reverse doomed, reverse kept))
     go doomed kept (r : rs) = do
         hit <- case cond of
@@ -337,7 +460,7 @@ alterTable db tbl change = case lookupTable db tbl of
     Left e -> pure (Left e)
     Right table -> do
         rowsResult <- scan tbl
-        case rowsResult of
+        case rowsResult >>= mapM (orderRow (map fst (tableCols table))) of
             Left e -> pure (Left e)
             Right rows -> case change table{tableRows = rows} >>= checkAltered of
                 Left e -> pure (Left e)
@@ -345,13 +468,12 @@ alterTable db tbl change = case lookupTable db tbl of
                     result <- replaceSchema tbl cols newRows
                     pure (result >> Right [])
   where
-    -- | 改完再统一查一遍约束
+    -- \| 改完再统一查一遍约束
     checkAltered (cols, rows) = do
-        let table = Table tbl cols rows Nothing
+        let table = Table tbl cols rows Nothing Nothing Nothing
         plan <- checkPlan table
         mapM_ (runChecks plan) rows
-        enforceNotNull cols rows
+        enforceConstraints (constraintPlan cols) [] rows
-        enforceUnique cols rows
         Right (cols, rows)
 
 -- | ADD COLUMN：老行补默认值或 NULL
@@ -386,7 +508,7 @@ retypeColumn col ty cols rows
         rows' <- mapM convert rows
         Right (map (\entry@(n, c) -> if n == col then (n, c{columnType = ty}) else entry) cols, rows')
   where
-    -- | 把这一列的老值收进新类型
+    -- \| 把这一列的老值收进新类型
     convert row = case lookup col row of
         Nothing -> Right row
         Just v -> do

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

@@ -1,5 +1,6 @@
 module ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf, probeCost, pointRows, rangeRows, selectivityOf, indexCheaper) where
 
+import Data.Maybe (fromMaybe)
 import ChuSQL.Core.Model
 
 -- 统计与成本估算：行数、不同值数、列直方图与索引探路页数。
@@ -32,8 +33,8 @@ 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 = maybe (-1 / 0) id (boundOf lo)
+    lower = fromMaybe (- (1 / 0)) (boundOf lo)
-    upper = maybe (1 / 0) id (boundOf hi)
+    upper = fromMaybe (1 / 0) (boundOf hi)
     -- | 第 i 个桶与区间重叠的行数
     overlap :: Int -> Int -> Double
     overlap i count

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

@@ -1,22 +1,44 @@
+{-# 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, subqueryRefsIn)
+import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, hasSubquery, quantifiedCompare, subquerySlotsIn, subqueryColumns)
 import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
 import ChuSQL.Core.Engine.Algebra.Op
 import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Core.Engine.Algebra.Sort (sortRows)
+import ChuSQL.Core.Engine.Algebra.Sort (sortRows, sortBoundRows)
-import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, 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 Control.Monad (filterM)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.State.Strict (StateT, evalStateT, gets, modify')
 import Data.List (nub)
 import qualified Data.HashMap.Strict as HM
+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 key action = do
+    cached <- gets (HM.lookup key)
+    case cached of
+        Just rows -> pure (Right rows)
+        Nothing -> do
+            result <- action
+            case result of
+                Left _ -> pure result
+                Right rows -> do
+                    modify' (HM.insert key rows)
+                    pure result
+
 -- | 只保留清单里的列，顺序照清单
 project :: [String] -> Row -> Row
 project ["*"] row = row
@@ -36,6 +58,7 @@ valueLiteral (VInt n) = LitInt n
 valueLiteral (VFloat d) = LitFloat d
 valueLiteral (VStr s) = LitStr s
 valueLiteral (VBool b) = LitBool b
+valueLiteral (VRuntime tid value) = RuntimeLiteral tid value
 valueLiteral VNull = LitNull
 
 -- | 点查退化成扫描时用的条件
@@ -78,11 +101,23 @@ data EquiKeys = EquiKeys
 
 -- | 认出 a = b 这种两列等值条件，并且能分清谁在左谁在右
 equiKeys :: [String] -> [String] -> Expr -> Maybe EquiKeys
-equiKeys lcols rcols (Eq (Col a) (Col b))
+equiKeys lcols rcols (Eq left 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)
+    , 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
 
+-- | 提取执行列的诊断名称
+columnName :: Expr -> Maybe String
+columnName (Col name) = Just name
+columnName (ColumnSlot _ name) = Just name
+columnName _ = Nothing
+
+-- | 在存储边界按输入布局排列行
+orderedRows :: [String] -> [Row] -> Either String [Row]
+orderedRows columns = mapM (orderRow columns)
+
 -- | 连接两批行：等值键走哈希，否则嵌套循环
 joinRowsIn ::
     (MonadStorage m) =>
@@ -93,7 +128,7 @@ joinRowsIn ::
     Expr ->
     [Row] ->
     [Row] ->
-    m (Either String [Row])
+    Execution m (Either String [Row])
 joinRowsIn db outer kind rcols cond lrows rrows =
     case equiKeys (rowsCols lrows) rcols cond of
         Just ks -> pure (Right (hashJoin kind ks ncols lrows rrows))
@@ -102,6 +137,37 @@ joinRowsIn db outer kind rcols cond lrows rrows =
     -- 右表为空时行上没有列名，用算子推导出来的列名补 NULL
     ncols = if null rrows then rcols else rowsCols rrows
 
+-- | 哈希判定存在性，仅输出原始左行
+semiRows :: SemiKind -> Expr -> Expr -> Row -> [Row] -> [Row] -> Either String [Row]
+semiRows kind left right outer leftRows rightRows = do
+    values <- mapM (evalExpr right . (++ outer)) rightRows
+    let keys = HS.fromList [canonicalValue value | value <- values, value /= VNull]
+        hasNull = VNull `elem` values
+        hashSafe = all safeNumber values
+        -- | 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
+                             Matching -> found
+                             NonMatching -> not found
+                             NotIn -> not found && not hasNull)
+                    else do
+                        result <- inValues value values
+                        Right (case kind of
+                            Matching -> result == VBool True
+                            NonMatching -> result /= VBool True
+                            NotIn -> result == VBool False)
+    filterM keep leftRows
+  where
+    -- | 大数混合比较退回既有逐值语义
+    safeNumber (VInt value) = abs (toInteger value) <= 9007199254740992
+    safeNumber (VFloat value) = abs value <= 9007199254740992
+    safeNumber _ = True
+
 -- | 左连接配不上的左行补 NULL，内连接丢弃
 unmatched :: JoinKind -> Row -> [String] -> [Row]
 unmatched InnerJoin _ _ = []
@@ -134,10 +200,10 @@ filterPairsM ::
     Expr ->
     [Row] ->
     [Row] ->
-    m (Either String [Row])
+    Execution m (Either String [Row])
 filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
   where
-    refs = subqueryRefsIn cond
+    refs = subquerySlotsIn cond
     -- | 逐左行配对，左连接没配上就补 NULL
     go [] acc _ = pure (Right (reverse acc))
     go (l : ls) acc cache = do
@@ -153,7 +219,9 @@ filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
     keep _ [] acc cache = pure (Right (reverse acc, cache))
     keep l (r : rs) acc cache = do
         let env = l ++ r ++ outer
-            key = bindingKey refs env
+        case bindingKey refs env of
+            Left err -> pure (Left err)
+            Right key -> do
                 resolved <- case HM.lookup key cache of
                     Just expression -> pure (Right expression)
                     Nothing -> substSubqueries db cond env
@@ -176,19 +244,20 @@ probeIndexJoin ::
     [String] ->
     Expr ->
     Row ->
-    m (Either String (Maybe [Row]))
+    Execution m (Either String (Maybe [Row]))
 probeIndexJoin db outer kind mAlias t ks rcols cond l = case lookup (ekLeft ks) l of
     Nothing -> pure (Right (Just (unmatched kind l rcols)))
     Just k
         | not (indexSafe db t (unqualify mAlias (ekRight ks)) k) -> pure (Right Nothing)
         | otherwise -> do
-            res <- lookupByColumn t (unqualify mAlias (ekRight ks)) k
+            res <- lift (lookupByColumn t (unqualify mAlias (ekRight ks)) k)
             case res of
                 Left e -> pure (Left e)
                 Right NoIndex -> pure (Right Nothing)
                 Right (IndexRows rows) -> do
-                    pairs <- joinRowsIn db outer kind rcols cond [l] (prefixRows mAlias rows)
+                    case orderedRows rcols (prefixRows mAlias rows) of
-                    pure (fmap Just pairs)
+                        Left err -> pure (Left err)
+                        Right ordered -> fmap (fmap Just) (joinRowsIn db outer kind rcols cond [l] ordered)
 
 -- | 列与键都不是浮点时才敢用索引
 indexSafe :: Database -> String -> String -> Value -> Bool
@@ -212,26 +281,23 @@ floatValue (VFloat _) = True
 floatValue _ = False
 
 -- | 分组键的值
-groupKey :: [String] -> Row -> Either String [Value]
+groupKey :: Row -> [Expr] -> Row -> Either String [Value]
-groupKey keys row = mapM get keys
+groupKey outer keys row = mapM (\key -> evalExpr key (row ++ outer)) keys
-  where
-    -- | 取这一列的分组值
-    get c = maybe (Left ("unknown column: " ++ c)) Right (lookup c row)
 
 -- | 按分组键把行分组，保留分组首次出现的顺序
-groupRows :: [String] -> [Row] -> Either String [([Value], [Row])]
+groupRows :: Row -> [Expr] -> [Row] -> Either String [([Value], [Row])]
-groupRows keys rows = go rows (HM.empty, [])
+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 keys r
+        k <- groupKey outer keys r
         let order' = if HM.member k acc then order else k : order
         go rs (HM.insertWith (++) k [r] acc, order')
 
 -- | 一组行上求同一个表达式（外层列从 outer 取）
 valuesOf :: Row -> Expr -> [Row] -> Either String [Value]
-valuesOf outer e rows = mapM (evalExpr e . (++ outer)) rows
+valuesOf outer e = mapM (evalExpr e . (++ outer))
 
 -- | 一个聚合算子在一组行上的结果，统一走内置函数权威
 evalAgg :: Row -> Expr -> [Row] -> Either String Value
@@ -248,15 +314,22 @@ oneGroup outer keys aggs (keyValues, rows) = do
     Right (zip keys keyValues ++ zip (map fst aggs) values)
 
 -- | 分组求值：没有分组列时，即使没有行也要出一行
-evalAggregate :: Row -> [String] -> [(String, Expr)] -> [Row] -> Either String [Row]
+evalAggregate :: Row -> [(String, Expr)] -> [(String, Expr)] -> [Row] -> Either String [Row]
 evalAggregate outer keys aggs rows = do
-    groups <- groupRows keys rows
+    groups <- groupRows outer (map snd keys) rows
     let top = if null keys && null groups then [([], [])] else groups
-    mapM (oneGroup outer keys aggs) top
+    mapM (oneGroup outer (map fst keys) aggs) top
 
 -- | 绑定键：子查询引用的外层列在这一行上的取值
-bindingKey :: [String] -> Row -> String
+bindingKey :: [Expr] -> Row -> Either String String
-bindingKey refs env = show [(c, bindingValue c env) | c <- refs]
+bindingKey refs env = show <$> mapM (\reference -> (,) reference <$> bindingReferenceValue reference env) refs
+
+-- | 按已绑定槽位取值，原始计划保留名称入口
+bindingReferenceValue :: Expr -> Row -> Either String Value
+bindingReferenceValue (Col name) env = case bindingValue name env of
+    Just value -> Right value
+    Nothing -> Left ("unknown outer column: " ++ name)
+bindingReferenceValue expression env = evalExpr expression env
 
 -- | 查已解析外层引用对应的物理列值
 bindingValue :: String -> Row -> Maybe Value
@@ -266,15 +339,15 @@ bindingValue column env = case lookup column env of
     Nothing -> Nothing
 
 -- | 每个绑定留第一行当样本，去掉重复绑定
-bindingSamples :: [String] -> Row -> [Row] -> [(String, Row)]
+bindingSamples :: [Expr] -> Row -> [Row] -> Either String [(String, Row)]
 bindingSamples refs outer rows = go rows HM.empty []
   where
     -- | 逐行按绑定键去重
-    go [] _ acc = reverse acc
+    go [] _ acc = Right (reverse acc)
-    go (r : rs) seen acc =
+    go (r : rs) seen acc = do
         let env = r ++ outer
-            k = bindingKey refs env
+        k <- bindingKey refs env
-        in case HM.lookup k seen of
+        case HM.lookup k seen of
             Just _ -> go rs seen acc
             Nothing -> go rs (HM.insert k () seen) ((k, env) : acc)
 
@@ -285,27 +358,33 @@ bindingsTableM ::
     Row ->
     [Expr] ->
     [Row] ->
-    m (Either String (HM.HashMap String [Expr]))
+    Execution m (Either String (HM.HashMap String [Expr]))
-bindingsTableM db outer exprs rows = do
+bindingsTableM db outer exprs rows = case bindingSamples refs outer rows of
-    built <- mapM swap (bindingSamples refs outer rows)
+    Left err -> pure (Left err)
+    Right samples -> do
+        built <- mapM swap samples
         pure (fmap HM.fromList (sequence built))
   where
-    refs = nub (concatMap subqueryRefsIn exprs)
+    refs = nub (concatMap subquerySlotsIn exprs)
     -- | 一个绑定样本上把子查询全换成字面量
     swap (key, env) = do
         es <- mapM (\e -> substSubqueries db e env) exprs
-        pure (fmap (\xs -> (key, xs)) (sequence es))
+        pure (fmap (key,) (sequence es))
 
 -- | 取这一行绑定换好的表达式；没有这个绑定就是内部错误
-boundExprs :: [String] -> Row -> HM.HashMap String [Expr] -> Either String [Expr]
+boundExprs :: [Expr] -> Row -> HM.HashMap String [Expr] -> Either String [Expr]
-boundExprs refs env table = case HM.lookup (bindingKey refs env) table of
+boundExprs refs env table = do
+    key <- bindingKey refs env
+    case HM.lookup key table of
         Just es -> Right es
         Nothing -> Left "subquery binding is missing"
 
 -- | 取这一行绑定换好的唯一表达式
-boundExpr :: [String] -> Row -> HM.HashMap String [Expr] -> Either String Expr
+boundExpr :: [Expr] -> Row -> HM.HashMap String [Expr] -> Either String Expr
-boundExpr refs env table = case boundExprs refs env table of
+boundExpr refs env table = do
-    Right [x] -> Right x
+    expressions <- boundExprs refs env table
+    case expressions of
+        [x] -> Right x
         _ -> Left "subquery binding is missing"
 
 -- | 单子过滤：条件本身是单子求值的
@@ -322,26 +401,34 @@ filterRowsM p = go []
             Right False -> go acc rs
 
 -- | 按投影顺序逐项求值（可以带子查询）
-computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> m (Either String Row)
+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 <- evalExprM db e (row ++ outer)
+        v <- evalExprIn db e (row ++ outer)
         case v of
             Left err -> pure (Left err)
             Right val -> go rest ((label, val) : acc)
 
 -- | 表达式求值（先把子查询求成字面量）
 evalExprM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Value)
-evalExprM db e env = do
+evalExprM db e env = evalStateT (evalExprIn db e env) HM.empty
+
+-- | 在当前执行中求值并共享子查询物化
+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)
 
 -- | 条件求值（先把子查询求成字面量）
 evalCondForRowM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Bool)
-evalCondForRowM db e env = do
+evalCondForRowM db e env = evalStateT (evalCondIn db e env) HM.empty
+
+-- | 在当前执行中判定条件并共享物化
+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)
 
@@ -360,8 +447,20 @@ scalarResult rows = do
         _ -> Left "scalar subquery returned more than one row"
 
 -- | 把子查询求值成字面量；子查询的错直接往上传
-substSubqueries :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Expr)
+substSubqueries :: (MonadStorage m) => Database -> Expr -> Row -> Execution m (Either String Expr)
 substSubqueries db e env = case e of
+    Construct tid arguments -> do
+        bound <- mapM (\argument -> substSubqueries db argument env) arguments
+        pure (Construct tid <$> sequence bound)
+    BoundConstruct tid arguments -> do
+        bound <- mapM (\argument -> substSubqueries db argument env) arguments
+        pure (BoundConstruct tid <$> sequence bound)
+    FunctionCall name arguments -> do
+        bound <- mapM (\argument -> substSubqueries db argument env) arguments
+        pure (FunctionCall name <$> sequence bound)
+    BoundFunction fid tid arguments -> do
+        bound <- mapM (\argument -> substSubqueries db argument env) arguments
+        pure (BoundFunction fid tid <$> sequence bound)
     ScalarSub sq -> scalarResult <$> runSubqueryRows db sq env
     InSub a sq negated -> do
         lhs <- substSubqueries db a env
@@ -418,37 +517,42 @@ substSubqueries db e env = case e of
             Left err -> pure (Left err)
             Right a' -> do
                 rb <- substSubqueries db b env
-                pure ((ctor a') <$> rb)
+                pure (ctor a' <$> rb)
     -- | 递归处理一个子表达式
     un ctor a = do
         ra <- substSubqueries db a env
         pure (ctor <$> ra)
 
 -- | 跑子查询：翻译成算子树再求值，外层行做相关子查询的绑定
-runSubqueryRows :: (MonadStorage m) => Database -> Subquery -> Row -> m (Either String [Row])
+runSubqueryRows :: (MonadStorage m) => Database -> Subquery -> Row -> Execution m (Either String [Row])
 runSubqueryRows db sq outer = case translate (subqueryStatement sq) of
     Left e -> pure (Left e)
-    Right op -> case mapM bind (subqueryRefs sq) of
+    Right op -> case mapM bind (subqueryColumns sq) of
         Left err -> pure (Left err)
-        Right bindings -> evalRelOpIn db (bindings ++ outer) (optimize db op)
+        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))
+                (evalRelOpIn db (bindings ++ outer) bound)
   where
+    -- | 原始调用未证明依赖完整，保留整个外层行
+    fallback = case sq of
+        Subquery{} -> Just outer
+        BoundSubquery{} -> Nothing
     -- | 给外层物理列补回已解析的限定名
-    bind column = case bindingValue column outer of
+    bind (column, expression) = (,) column <$> bindingReferenceValue expression outer
-        Just value -> Right (column, value)
-        Nothing -> Left ("unknown outer column: " ++ column)
 
 -- | 单子求值：Scan/点查/范围查都问存储
 evalRelOpM :: (MonadStorage m) => Database -> RelOp -> m (Either String [Row])
-evalRelOpM db = evalRelOpIn db []
+evalRelOpM db op = evalStateT (evalRelOpIn db [] op) HM.empty
 
 -- | 纯求值（内存存储，子查询走同一条路径）
 evalRelOp :: Database -> RelOp -> Either String [Row]
 evalRelOp db op = do
-    (result, _) <- runMemoryStorage (evalRelOpIn db [] op) db
+    (result, _) <- runMemoryStorage (evalRelOpM db op) db
     result
 
 -- | 带外层行的执行器
-evalRelOpIn :: (MonadStorage m) => Database -> Row -> RelOp -> m (Either String [Row])
+evalRelOpIn :: (MonadStorage m) => Database -> Row -> RelOp -> Execution m (Either String [Row])
 evalRelOpIn _ _ Unit = pure (Right [[]])
 evalRelOpIn db outer (Compute items op) = do
     rows <- evalRelOpIn db outer op
@@ -462,40 +566,43 @@ evalRelOpIn db outer (Compute items op) = do
                 table <- bindingsTableM db outer (map snd items) rs
                 pure (table >>= \t -> traverse (computeBound t) rs)
   where
-    refs = nub (concatMap (subqueryRefsIn . snd) items)
+    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)
 evalRelOpIn db outer (Aggregate keys aggs op) = do
+    rows <- evalRelOpIn db outer op
+    pure (rows >>= evalAggregate outer [(name, Col name) | name <- keys] aggs)
+evalRelOpIn db outer (BoundAggregate keys aggs op) = do
     rows <- evalRelOpIn db outer op
     pure (rows >>= evalAggregate outer keys aggs)
 evalRelOpIn db _ (Scan mAlias tbl cols) = do
     res <- scanTable db tbl cols
-    pure (fmap (prefixRows mAlias) res)
+    pure (res >>= orderedRows (relOpCols db (Scan mAlias tbl cols)) . prefixRows mAlias)
 evalRelOpIn db outer (Lookup mAlias tbl col k) = do
-    res <- lookupByColumn tbl col k
+    res <- lift (lookupByColumn tbl col k)
     case res of
         Left e -> pure (Left e)
         Right NoIndex -> scanFiltered db outer mAlias tbl (lookupCondition mAlias col k)
-        Right (IndexRows rows) -> pure (Right (prefixRows mAlias rows))
+        Right (IndexRows rows) -> pure (orderedRows (relOpCols db (Lookup mAlias tbl col k)) (prefixRows mAlias rows))
 evalRelOpIn db outer (Range mAlias tbl col lo hi) = do
-    res <- scanRange tbl col lo hi
+    res <- lift (scanRange tbl col lo hi)
     case res of
         Left e -> pure (Left e)
         Right Nothing -> scanFiltered db outer mAlias tbl (rangeCondition mAlias col lo hi)
-        Right (Just rows) -> pure (Right (prefixRows mAlias rows))
+        Right (Just rows) -> pure (orderedRows (relOpCols db (Range mAlias tbl col lo hi)) (prefixRows mAlias rows))
 evalRelOpIn db outer (Filter e op) = do
     rows <- evalRelOpIn db outer op
     case rows of
         Left err -> pure (Left err)
         Right rs
-            | not (hasSubquery e) -> filterRowsM (\r -> evalCondForRowM db e (r ++ outer)) rs
+            | not (hasSubquery e) -> filterRowsM (\r -> evalCondIn db e (r ++ outer)) rs
             | otherwise -> do
                 table <- bindingsTableM db outer [e] rs
                 pure (table >>= \t -> filterM (keepBound t) rs)
   where
-    refs = nub (subqueryRefsIn e)
+    refs = nub (subquerySlotsIn e)
     -- | 用这一行绑定换好的条件判定
     keepBound table r = do
         e' <- boundExpr refs (r ++ outer) table
@@ -503,15 +610,33 @@ evalRelOpIn db outer (Filter e op) = do
 evalRelOpIn db outer (Project cols op) = do
     rows <- evalRelOpIn db outer op
     pure (fmap (map (project cols)) rows)
+evalRelOpIn db outer (Distinct op) = do
+    rows <- evalRelOpIn db outer op
+    pure (distinctRows <$> rows)
 evalRelOpIn db outer (Sort spec op) = do
     rows <- evalRelOpIn db outer op
     pure (fmap (sortRows spec) rows)
+evalRelOpIn db outer (BoundSort spec op) = do
+    rows <- evalRelOpIn db outer op
+    pure (rows >>= sortBoundRows spec outer)
 evalRelOpIn db outer (Limit n op) = do
     rows <- evalRelOpIn db outer op
     pure (fmap (take n) rows)
 evalRelOpIn db outer (Derived mAlias op) = do
-    rows <- evalRelOpIn db outer op
+    rows <- materialize (show ("derived", op, outer)) (evalRelOpIn db outer op)
     pure (fmap (prefixRows mAlias) rows)
+evalRelOpIn db outer (SemiJoin kind left right l r query) = do
+    rows <- evalRelOpIn db outer l
+    case rows of
+        Left err -> pure (Left err)
+        Right [] -> pure (Right [])
+        Right leftRows -> do
+            -- | 独立 IN 沿用子查询身份，跨算子复用结果
+            let key = case query of
+                    Just statement -> show ("subquery", statement, [] :: Row, Nothing :: Maybe Row)
+                    Nothing -> show ("derived", r, outer)
+            rightRows <- materialize key (evalRelOpIn db outer r)
+            pure (rightRows >>= semiRows kind left right outer leftRows)
 evalRelOpIn db outer (Join kind l r c) = do
     lres <- evalRelOpIn db outer l
     case lres of
@@ -540,24 +665,36 @@ scanFiltered ::
     Maybe String ->
     String ->
     Expr ->
-    m (Either String [Row])
+    Execution m (Either String [Row])
 scanFiltered db outer mAlias tbl cond = do
     res <- scanTable db tbl Nothing
     pure $ do
-        rows <- res
+        rows <- res >>= orderedRows (relOpCols db (Scan mAlias tbl Nothing)) . prefixRows mAlias
-        filterM (evalCondForRow cond . (++ outer)) (prefixRows mAlias rows)
+        filterM (evalCondForRow cond . (++ outer)) rows
 
 -- | 行数到阈值才值得并行分片
 parallelRowThreshold :: Int
 parallelRowThreshold = 1000
 
 -- | 表够大且存储支持并行时按分片扫，否则顺序扫
-scanTable :: (MonadStorage m) => Database -> String -> Maybe [String] -> m (Either String [Row])
+scanTable :: (MonadStorage m) => Database -> String -> Maybe [String] -> Execution m (Either String [Row])
 scanTable db tbl cols = do
-    width <- parallelShards
+    width <- lift parallelShards
     if width > 1 && rows >= parallelRowThreshold
-        then scanShards width tbl cols
+        then lift (scanShards width tbl cols)
-        else maybe (scan tbl) (scanColumns tbl) cols
+        else lift (maybe (scan tbl) (scanColumns tbl) cols)
   where
     -- | 统计里的行数，没有统计算 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
+        | otherwise = row : go (HS.insert key seen) rows
+      where
+        key = map (canonicalValue . snd) row

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

@@ -1,8 +1,9 @@
-module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, subqueryRefsIn, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot, quantifiedCompare) where
+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)
 
 -- 表达式求值：三值逻辑，NULL 参与运算结果仍是 NULL。
 
@@ -10,6 +11,19 @@ import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator,
 evalExpr :: Expr -> Row -> Either String Value
 evalExpr (Col name) row =
     maybe (Left ("unknown column: " ++ name)) Right (lookup name row)
+evalExpr (ColumnSlot slot name) row = case drop slot row of
+    (key, value) : _ | slot >= 0, key == name -> Right value
+    [] -> Left ("missing bound column: " ++ name)
+    _ -> Left ("bound column position mismatch: " ++ name)
+evalExpr (OuterColumnSlot localWidth slot name) row
+    | localWidth < 0 || slot < 0 = Left ("bound column position mismatch: " ++ name)
+    | otherwise = evalExpr (ColumnSlot slot name) (drop localWidth row)
+evalExpr (FunctionCall name _) _ = Left ("unbound function call: " ++ name)
+evalExpr (Construct _ _) _ = Left "unbound runtime constructor"
+evalExpr (BoundConstruct tid arguments) row = mapM (`evalExpr` row) arguments >>= constructSQLValue tid
+evalExpr (RuntimeLiteral tid value) _ = coerceValue (CRuntime tid) (VRuntime tid value)
+evalExpr (BoundFunction fid tid arguments) row =
+    mapM (`evalExpr` row) arguments >>= invokeSQLFunction fid tid
 evalExpr LitNull _ = Right VNull
 evalExpr (LitInt n) _ = Right (VInt n)
 evalExpr (LitFloat d) _ = Right (VFloat d)
@@ -41,13 +55,13 @@ evalExpr (IsNotNull a) row = do
     Right (VBool (v /= VNull))
 evalExpr (InList a es negated) row = do
     v <- evalExpr a row
-    vs <- mapM (\e -> evalExpr e row) es
+    vs <- mapM (`evalExpr` row) es
     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)
 
 -- | 子查询要连上存储才能跑
@@ -63,6 +77,12 @@ quantifiedCompare op lhs vs q = case vs of
 -- | 表达式用到了哪些列
 colsInExpr :: Expr -> [String]
 colsInExpr (Col c) = [c]
+colsInExpr (ColumnSlot _ c) = [c]
+colsInExpr (OuterColumnSlot _ _ c) = [c]
+colsInExpr (Construct _ arguments) = concatMap colsInExpr arguments
+colsInExpr (BoundConstruct _ arguments) = concatMap colsInExpr arguments
+colsInExpr (FunctionCall _ arguments) = concatMap colsInExpr arguments
+colsInExpr (BoundFunction _ _ arguments) = concatMap colsInExpr arguments
 colsInExpr (Add a b) = colsInExpr a ++ colsInExpr b
 colsInExpr (Sub a b) = colsInExpr a ++ colsInExpr b
 colsInExpr (Mul a b) = colsInExpr a ++ colsInExpr b
@@ -92,17 +112,34 @@ colsInExpr _ = []
 
 -- | 表达式里子查询引用的外层列
 subqueryRefsIn :: Expr -> [String]
-subqueryRefsIn e = case e of
+subqueryRefsIn = subqueryReferences subqueryRefs
-    ScalarSub sq -> subqueryRefs sq
+
-    InSub a sq _ -> subqueryRefsIn a ++ subqueryRefs sq
+-- | 提取子查询依赖的父布局表达式
-    InList a es _ -> concatMap subqueryRefsIn (a : es)
+subquerySlotsIn :: Expr -> [Expr]
-    ExistsSub sq _ -> subqueryRefs sq
+subquerySlotsIn = subqueryReferences (map snd . subqueryColumns)
-    QuantCmp _ a sq _ -> subqueryRefsIn a ++ subqueryRefs sq
+
+-- | 取得原始或已绑定的外部列
+subqueryColumns :: Subquery -> [(String, Expr)]
+subqueryColumns (Subquery _ names) = [(name, Col name) | name <- names]
+subqueryColumns (BoundSubquery _ _ bindings) = bindings
+
+-- | 收集表达式中子查询的外部引用
+subqueryReferences :: (Subquery -> [a]) -> Expr -> [a]
+subqueryReferences references e = case e of
+    Construct _ arguments -> concatMap collect arguments
+    BoundConstruct _ arguments -> concatMap collect arguments
+    FunctionCall _ arguments -> concatMap collect arguments
+    BoundFunction _ _ arguments -> concatMap collect arguments
+    ScalarSub sq -> references sq
+    InSub a sq _ -> collect a ++ references sq
+    InList a es _ -> concatMap collect (a : es)
+    ExistsSub sq _ -> references sq
+    QuantCmp _ a sq _ -> collect a ++ references sq
     Add a b -> both a b
     Sub a b -> both a b
     Mul a b -> both a b
     Div a b -> both a b
-    Neg a -> subqueryRefsIn a
+    Neg a -> collect a
     Gt a b -> both a b
     Lt a b -> both a b
     Eq a b -> both a b
@@ -111,21 +148,27 @@ subqueryRefsIn e = case e of
     NotEq a b -> both a b
     And a b -> both a b
     Or a b -> both a b
-    IsNull a -> subqueryRefsIn a
+    IsNull a -> collect a
-    IsNotNull a -> subqueryRefsIn a
+    IsNotNull a -> collect a
-    CountOf a -> subqueryRefsIn a
+    CountOf a -> collect a
-    SumOf a -> subqueryRefsIn a
+    SumOf a -> collect a
-    AvgOf a -> subqueryRefsIn a
+    AvgOf a -> collect a
-    MinOf a -> subqueryRefsIn a
+    MinOf a -> collect a
-    MaxOf a -> subqueryRefsIn a
+    MaxOf a -> collect a
     _ -> []
   where
+    -- | 递归收集当前提取器的引用
+    collect = subqueryReferences references
     -- | 两个子表达式的外层列拼起来
-    both a b = subqueryRefsIn a ++ subqueryRefsIn b
+    both a b = collect a ++ collect b
 
 -- | 表达式里有没有除法（除法可能报错，不能提前或延后求值）
 hasDivision :: Expr -> Bool
 hasDivision e = case e of
+    Construct _ arguments -> any hasDivision arguments
+    BoundConstruct _ arguments -> any hasDivision arguments
+    FunctionCall _ arguments -> any hasDivision arguments
+    BoundFunction _ _ arguments -> any hasDivision arguments
     Div _ _ -> True
     Neg a -> hasDivision a
     Add a b -> both a b
@@ -148,11 +191,15 @@ hasDivision e = case e of
 -- | 表达式里有没有子查询
 hasSubquery :: Expr -> Bool
 hasSubquery e = case e of
+    Construct _ arguments -> any hasSubquery arguments
+    BoundConstruct _ arguments -> any hasSubquery arguments
+    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
@@ -181,6 +228,10 @@ hasSubquery e = case e of
 -- | 表达式里出现的聚合调用（按出现顺序）
 aggregatesIn :: Expr -> [Expr]
 aggregatesIn e = case e of
+    Construct _ arguments -> concatMap aggregatesIn arguments
+    BoundConstruct _ arguments -> concatMap aggregatesIn arguments
+    FunctionCall _ arguments -> concatMap aggregatesIn arguments
+    BoundFunction _ _ arguments -> concatMap aggregatesIn arguments
     a@CountAll -> [a]
     a@(CountOf _) -> [a]
     a@(SumOf _) -> [a]
@@ -188,6 +239,8 @@ aggregatesIn e = case e of
     a@(MinOf _) -> [a]
     a@(MaxOf _) -> [a]
     QuantCmp _ a _ _ -> aggregatesIn a
+    InSub a _ _ -> aggregatesIn a
+    InList a values _ -> aggregatesIn a ++ concatMap aggregatesIn values
     Add a b -> both a b
     Sub a b -> both a b
     Mul a b -> both a b
@@ -215,7 +268,13 @@ hasAggregate = not . null . aggregatesIn
 -- | 聚合之外的列引用（聚合参数里的列不算）
 bareColumns :: Expr -> [String]
 bareColumns e = case e of
+    Construct _ arguments -> concatMap bareColumns arguments
+    BoundConstruct _ arguments -> concatMap bareColumns arguments
+    FunctionCall _ arguments -> concatMap bareColumns arguments
+    BoundFunction _ _ arguments -> concatMap bareColumns arguments
     Col c -> [c]
+    ColumnSlot _ c -> [c]
+    OuterColumnSlot _ _ c -> [c]
     Add a b -> both a b
     Sub a b -> both a b
     Mul a b -> both a b

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

@@ -1,5 +1,6 @@
 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)
@@ -15,6 +16,7 @@ reorderJoins db = pass db False
 
 -- | 往下带“行序是否不可观察”，可观察时不动内连接
 pass :: Database -> Bool -> RelOp -> RelOp
+pass db free (Distinct x) = Distinct (pass db free x)
 pass db _ (Sort spec x) = Sort spec (pass db True x)
 pass db _ (Limit n x) = Limit n (pass db False x)
 pass db _ (Aggregate keys aggs x) = Aggregate keys aggs (pass db False x)
@@ -22,6 +24,7 @@ pass db free (Project cols x) = Project cols (pass db free x)
 pass db free (Compute items x) = Compute items (pass db free x)
 pass db free (Filter p x) = Filter p (pass db free x)
 pass db free (Derived a x) = Derived a (pass db free x)
+pass db free (SemiJoin kind left right l r query) = SemiJoin kind left right (pass db free l) (pass db False r) query
 pass db free (Join kind l r c)
     | free
     , Just (leaves, conds) <- innerChain (Join kind l r c)
@@ -37,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
@@ -78,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
@@ -100,11 +103,9 @@ leafSource _ = Nothing
 
 -- | 某列在叶子统计里的不同值数
 distinctOf :: Database -> RelOp -> String -> Maybe Int
-distinctOf db leaf col = do
+distinctOf db leaf col = do (alias, t) <- leafSource leaf
-    (alias, t) <- leafSource leaf
                             m <- tableMetaOf db t
-    num <- lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
+                            lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
-    pure num
 
 -- | 若干叶子里某列最大的不同值数
 distinctOn :: Database -> [RelOp] -> String -> Maybe Int
@@ -137,11 +138,11 @@ stepRows db have acc x conds = case keyDistinct db have x conds of
     Just v | v > 1 -> max 1 (acc * rows `div` v)
     _ -> acc * rows
   where
-    rows = maybe 1 id (leafRows db x)
+    rows = fromMaybe 1 (leafRows db x)
 
 -- | 一批叶子按给定顺序连接，累加每一步的中间结果
 chainCost :: Database -> [RelOp] -> [Expr] -> Int
-chainCost db (l : ls) conds = go [l] (maybe 1 id (leafRows db l)) ls
+chainCost db (l : ls) conds = go [l] (fromMaybe 1 (leafRows db l)) ls
   where
     -- | 逐步接上后面的叶子
     go _ _ [] = 0
@@ -212,8 +213,7 @@ rebuildChain _ [] _ = Unit
 
 -- | 挂不上去的条件套成 Filter
 applyConds :: [Expr] -> RelOp -> RelOp
-applyConds [] op = op
+applyConds cs op = foldr Filter op cs
-applyConds (c : cs) op = Filter c (applyConds cs op)
 
 -- | 条件的列是不是都在可用列里
 subsetOf :: [String] -> [String] -> Bool

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

@@ -1,10 +1,13 @@
-module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols, renderPlan) where
+module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols, renderPlan) where
 
 import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir)
+import ChuSQL.Core.Engine.Syntax.AST (Expr, Statement, JoinKind (..), SortDir)
 
 -- 关系代数算子定义、输出列推导与算子树文本渲染。
 
+-- | 区分存在匹配、无匹配与 NULL 感知排除
+data SemiKind = Matching | NonMatching | NotIn deriving (Show, Eq)
+
 data RelOp
     = Scan (Maybe String) String (Maybe [String])
     | Lookup (Maybe String) String String Value
@@ -13,10 +16,15 @@ data RelOp
     | Project [String] RelOp
     | Compute [(String, Expr)] RelOp
     | Aggregate [String] [(String, Expr)] RelOp
+    | BoundAggregate [(String, Expr)] [(String, Expr)] RelOp
+    | Distinct RelOp
     | Unit
     | Sort [(String, SortDir)] RelOp
+    | BoundSort [(Expr, SortDir)] RelOp
     | Limit Int RelOp
     | Join JoinKind RelOp RelOp Expr
+    -- | 末项仅保存独立 IN 的物化身份
+    | SemiJoin SemiKind Expr Expr RelOp RelOp (Maybe Statement)
     | Derived (Maybe String) RelOp
     deriving (Show, Eq)
 
@@ -25,6 +33,7 @@ relOpCols :: Database -> RelOp -> [String]
 relOpCols _ Unit = []
 relOpCols _ (Compute items _) = map fst items
 relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs
+relOpCols _ (BoundAggregate keys aggs _) = map fst keys ++ map fst aggs
 relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols
 relOpCols db (Scan mAlias tbl Nothing) =
     case lookup tbl db of
@@ -37,9 +46,12 @@ relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing)
 relOpCols db (Filter _ x) = relOpCols db x
 relOpCols _ (Project ["*"] _) = ["*"]
 relOpCols _ (Project cols _) = cols
+relOpCols db (Distinct x) = relOpCols db x
 relOpCols db (Sort _ x) = relOpCols db x
+relOpCols db (BoundSort _ x) = relOpCols db x
 relOpCols db (Limit _ x) = relOpCols db x
 relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r
+relOpCols db (SemiJoin _ _ _ l _ _) = relOpCols db l
 relOpCols db (Derived mAlias x) = map (qualify mAlias) (relOpCols db x)
 
 -- | 连接的显示名
@@ -67,10 +79,16 @@ renderPlan = go 0
                 ++ show [label ++ " <- " ++ show e | (label, e) <- aggs]
                 ++ "\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
         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
         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

@@ -3,9 +3,10 @@ module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject) where
 import ChuSQL.Core.Engine.Algebra.Cost (indexCheaper, pointRows, rangeRows, tableMetaOf)
 import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr, hasDivision)
 import ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins)
-import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
+import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols)
+import ChuSQL.Core.Engine.Algebra.Planner (translate)
 import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
+import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Statement (..), FromClause (..), Subquery (..))
 import Data.List (nub)
 
 -- 查询优化：谓词下推、投影下推、常量折叠、扫描方式与连接顺序选择。
@@ -36,8 +37,7 @@ partitionPred have = foldr pick ([], [])
 
 -- | 依次套上若干 Filter
 applyFilters :: [Expr] -> RelOp -> RelOp
-applyFilters [] op = op
+applyFilters es op = foldl (flip Filter) op es
-applyFilters (e : es) op = applyFilters es (Filter e op)
 
 -- | Filter 压在内连接上时下推
 pushJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
@@ -75,8 +75,10 @@ pushOne _ op = op
 planHasDivision :: RelOp -> Bool
 planHasDivision (Filter p x) = hasDivision p || planHasDivision x
 planHasDivision (Join _ l r c) = hasDivision c || planHasDivision l || planHasDivision r
+planHasDivision (SemiJoin _ left right l r _) = hasDivision left || hasDivision right || planHasDivision l || planHasDivision r
 planHasDivision (Compute items x) = any (hasDivision . snd) items || planHasDivision x
 planHasDivision (Project _ x) = planHasDivision x
+planHasDivision (Distinct x) = planHasDivision x
 planHasDivision (Sort _ x) = planHasDivision x
 planHasDivision (Limit _ x) = planHasDivision x
 planHasDivision (Derived _ x) = planHasDivision x
@@ -96,6 +98,8 @@ pushProjectLeaf db need leaf
 -- | 把需要哪些列往下传
 pushProject :: Database -> [String] -> RelOp -> RelOp
 pushProject _ _ Unit = Unit
+pushProject _ _ op@BoundSort{} = op
+pushProject _ _ op@BoundAggregate{} = op
 pushProject db _ (Compute items x) = Compute items (pushProject db (concatMap (colsInExpr . snd) items) x)
 pushProject db _ (Aggregate keys aggs x) =
     Aggregate keys aggs (pushProject db (keys ++ concatMap (colsInExpr . snd) aggs) x)
@@ -103,8 +107,12 @@ pushProject db _ (Project cols x) = case pushProject db cols x of
     Project cols' y | cols' == cols -> Project cols y
     other -> Project cols other
 pushProject db need (Filter p x) = Filter p (pushProject db (need ++ colsInExpr p) x)
+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
 pushProject db need (Join kind l r c)
     | needsAll need = Join kind (pushProject db need l) (pushProject db need r) c
     | otherwise =
@@ -127,8 +135,8 @@ pushProject db need (Derived a 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@(Lookup {}) = pushProjectLeaf db need leaf
-pushProject db need leaf@(Range _ _ _ _ _) = pushProjectLeaf db need leaf
+pushProject db need leaf@(Range {}) = pushProjectLeaf db need leaf
 
 -- | 折一个表达式节点
 foldNode :: Expr -> Expr
@@ -139,6 +147,7 @@ foldNode e
         Right (VFloat d) -> LitFloat d
         Right (VStr s) -> LitStr s
         Right (VBool b) -> LitBool b
+        Right (VRuntime tid value) -> RuntimeLiteral tid value
         Left _ -> e
     | otherwise = e
 
@@ -149,6 +158,8 @@ foldConstants (Sub a b) = foldNode (Sub (foldConstants a) (foldConstants b))
 foldConstants (Mul a b) = foldNode (Mul (foldConstants a) (foldConstants b))
 foldConstants (Div a b) = foldNode (Div (foldConstants a) (foldConstants b))
 foldConstants (Neg a) = foldNode (Neg (foldConstants a))
+foldConstants (BoundConstruct tid arguments) = BoundConstruct tid (map foldConstants arguments)
+foldConstants (BoundFunction fid tid arguments) = foldNode (BoundFunction fid tid (map foldConstants arguments))
 foldConstants (Gt a b) = foldNode (Gt (foldConstants a) (foldConstants b))
 foldConstants (Lt a b) = foldNode (Lt (foldConstants a) (foldConstants b))
 foldConstants (Eq a b) = foldNode (Eq (foldConstants a) (foldConstants b))
@@ -172,8 +183,52 @@ worthRange db t col lo hi = case tableMetaOf db t of
     Nothing -> True
     Just m -> indexCheaper m col (rangeRows m col lo hi)
 
+-- | 将独立 IN 或简单等值 EXISTS 变为半连接
+semiJoin :: Database -> Expr -> RelOp -> Maybe RelOp
+semiJoin db (InSub left query negated) source
+    | null (subqueryRefs query), safeKey left
+    , Right right <- translate (subqueryStatement query)
+    , [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
+    , Select items (FromTable alias table) (Just (Eq (Col a) (Col b))) [] Nothing [] Nothing <- subqueryStatement query
+    , let scan = Scan alias table Nothing
+          columns = relOpCols db scan
+    , all (localProjection columns . snd) items
+    , 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)
+semiJoin _ _ _ = Nothing
+
+-- | 只允许无求值错误的左键
+safeKey :: Expr -> Bool
+safeKey Col{} = True
+safeKey LitNull = True
+safeKey LitInt{} = True
+safeKey LitFloat{} = True
+safeKey LitStr{} = True
+safeKey LitBool{} = True
+safeKey _ = False
+
+-- | 投影仅保留当前来源的普通列
+localProjection :: [String] -> Expr -> Bool
+localProjection columns (Col column) = column `elem` columns
+localProjection _ expression = safeKey expression && null (colsInExpr expression)
+
+-- | 提取与唯一外层引用比较的本地列
+localKey :: [String] -> String -> String -> String -> Maybe String
+localKey columns reference a b
+    | a == reference, b `elem` columns, b /= reference = Just b
+    | b == reference, a `elem` columns, a /= reference = Just a
+    | otherwise = Nothing
+
 -- | 单节点重写
 rewriteNode :: Database -> RelOp -> RelOp
+rewriteNode db (Filter expression source)
+    | Just joined <- semiJoin db expression source = joined
 rewriteNode db (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t Nothing))
     | worthLookup db t (unqualify mAlias k) = Lookup mAlias t (unqualify mAlias k) (VInt v)
 rewriteNode db (Filter (Eq (Col k) (LitStr v)) (Scan mAlias t Nothing))
@@ -247,9 +302,11 @@ optimizeRelOp db = rewriteNode db . descend
     descend (Project cols x) = Project cols (optimizeRelOp db x)
     descend (Compute items x) = Compute items (optimizeRelOp db x)
     descend (Aggregate keys aggs x) = Aggregate keys aggs (optimizeRelOp db x)
+    descend (Distinct x) = Distinct (optimizeRelOp db x)
     descend (Sort spec x) = Sort spec (optimizeRelOp db x)
     descend (Limit n x) = Limit n (optimizeRelOp db x)
     descend (Join kind l r c) = Join kind (optimizeRelOp db l) (optimizeRelOp db r) c
+    descend (SemiJoin kind left right l r query) = SemiJoin kind left right (optimizeRelOp db l) (optimizeRelOp db r) query
     descend (Derived a x) = Derived a (optimizeRelOp db x)
     descend x = x
 

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE TupleSections #-}
+
 module ChuSQL.Core.Engine.Algebra.Planner (translate) where
 
 import ChuSQL.Core.Engine.Algebra.Expr (aggregatesIn, colsInExpr)
@@ -30,13 +32,17 @@ nameAggs items = go (1 :: Int) [] (concatMap (aggregatesIn . snd) items)
     go _ acc [] = reverse acc
     go n acc (e : es)
         | any ((== e) . snd) acc = go n acc es
-        | otherwise = go (n + 1) (("agg" ++ show n, e) : acc) es
+        | otherwise = go (n + 1) (("$agg" ++ show n, e) : acc) es
 
 -- | 把聚合调用换成对聚合结果的引用
 rewriteAggs :: [(String, Expr)] -> Expr -> Expr
 rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
     (label : _) -> Col label
     [] -> case e of
+        Construct tid arguments -> Construct tid (map go arguments)
+        BoundConstruct tid arguments -> BoundConstruct tid (map go arguments)
+        FunctionCall name arguments -> FunctionCall name (map go arguments)
+        BoundFunction fid tid arguments -> BoundFunction fid tid (map go arguments)
         Add a b -> Add (go a) (go b)
         Sub a b -> Sub (go a) (go b)
         Mul a b -> Mul (go a) (go b)
@@ -49,22 +55,17 @@ rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
         LtE a b -> LtE (go a) (go b)
         NotEq a b -> NotEq (go a) (go b)
         QuantCmp op a sq q -> QuantCmp op (go a) sq q
+        InSub a sq negated -> InSub (go a) sq negated
+        InList a values negated -> InList (go a) (map go values) negated
         And a b -> And (go a) (go b)
         Or a b -> Or (go a) (go b)
         IsNull a -> IsNull (go a)
         IsNotNull a -> IsNotNull (go a)
         other -> other
   where
+    -- | 递归替换当前查询层的聚合引用
     go = rewriteAggs aggs
 
--- | 过滤 + 分组：没有分组也没有聚合时原样返回
-grouped :: [String] -> [(String, Expr)] -> RelOp -> (RelOp, [(String, Expr)])
-grouped keys items base
-    | null keys && null aggs = (base, items)
-    | otherwise = (Aggregate keys aggs base, [(label, rewriteAggs aggs e) | (label, e) <- items])
-  where
-    aggs = nameAggs items
-
 -- | 排序 + 截断
 limited :: [(String, SortDir)] -> Maybe Int -> RelOp -> RelOp
 limited orderBy mLimit op = case mLimit of
@@ -75,33 +76,64 @@ limited orderBy mLimit op = case mLimit of
         [] -> op
         spec -> Sort spec op
 
--- | 翻成：过滤 -> 分组 -> 排序 -> 截断 -> 取列
+-- | 生成过滤、聚合、HAVING、排序和投影计划
 translate :: Statement -> Either String RelOp
 translate q = case q of
-    Select
+    SelectDistinct inner -> do
-        { selectCols = cols
+        ordering <- distinctOrdering inner
-        , selectFrom = fromC
+        plan <- case inner of
-        , selectWhere = mWhere
+            s@Select{} -> translate s { selectOrderBy = [], selectLimit = Nothing }
-        , selectGroupBy = groupBy
+            _ -> Left "DISTINCT requires SELECT"
-        , selectOrderBy = orderBy
+        let labels = case inner of
-        , selectLimit = mLimit
+                Select { selectItems = items } -> map fst items
-        } -> do
+                _ -> []
+        keys <- mapM (distinctKey labels) ordering
+        namedOrdering <- mapM (columnKey labels) ordering
+        let sorted
+                | null keys = Distinct plan
+                | any (\(column, _) -> length (filter (== column) labels) > 1) namedOrdering = BoundSort keys (Distinct plan)
+                | otherwise = Sort namedOrdering (Distinct plan)
+        Right (maybe sorted (`Limit` sorted) (selectLimit inner))
+    Select items fromC mWhere groupBy having orderBy mLimit -> do
         plan0 <- source fromC mWhere
-            let (plan, _) = grouped groupBy [] plan0
+        expressions <- mapM (orderExpression items . fst) orderBy
-            Right (Project cols (limited orderBy mLimit plan))
+        let aggs = nameAggs (items ++ [("having", expression) | expression <- maybe [] pure having]
-    SelectExpr items fromC mWhere groupBy orderBy mLimit -> do
+                ++ map ("order",) expressions)
-        plan0 <- source fromC mWhere
+            aggregate = not (null groupBy && null aggs && null having)
-        let (plan, items') = grouped groupBy items plan0
+            grouped = if aggregate then Aggregate groupBy aggs plan0 else plan0
-        Right $ if any (\(c, _) -> c `elem` map fst items') orderBy
+            plan = maybe grouped (\condition -> Filter (rewriteAggs aggs condition) grouped) having
-            then orderedProjection items' orderBy mLimit plan
+            items' = [(label, rewriteAggs aggs expression) | (label, expression) <- items]
-            else Compute items' (limited orderBy mLimit plan)
+            ordering = zip (map (rewriteAggs aggs) expressions) (map snd orderBy)
+            -- | 简单列排序保留可优化的名称算子
+            named (Col column, direction) = Just (column, direction)
+            named _ = Nothing
+            -- | 保持普通投影在 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
+            Just spec -> projected (limited spec 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
+            Just slot -> Right (ColumnSlot slot (columns !! slot), direction)
+            Nothing -> Left "DISTINCT: sorting requires an output position"
 
 -- | 在排序前计算别名并保留输出顺序
-orderedProjection :: [(String, Expr)] -> [(String, SortDir)] -> Maybe Int -> RelOp -> RelOp
+orderedProjection :: [(String, Expr)] -> [(Expr, SortDir)] -> Maybe Int -> RelOp -> RelOp
 orderedProjection items orderBy mLimit plan =
     Compute items (limited ordering mLimit (Compute (carried ++ keys) plan))
   where
-    carried = [(column, Col column) | column <- nub (concatMap (colsInExpr . snd) items)]
+    keys = [("$order" ++ show n, expression) | (n, (expression, _)) <- zip [1 :: Int ..] orderBy]
-    keys = [("$order" ++ show n, maybe (Col c) id (lookup c items)) | (n, (c, _)) <- zip [1 :: Int ..] orderBy]
     ordering = [(key, direction) | ((key, _), (_, direction)) <- zip keys orderBy]
+    carried = [(column, Col column) | column <- nub (concatMap (colsInExpr . snd) items)]

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

@@ -1,7 +1,8 @@
-module ChuSQL.Core.Engine.Algebra.Sort (sortRows, compareValue) where
+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 Data.List (sortBy)
 
 -- 排序：按多列规格排出结果行，每列可升可降。
@@ -17,9 +18,9 @@ sortKey :: [(String, SortDir)] -> Row -> [Maybe Value]
 sortKey spec row = [lookup col row | (col, _) <- spec]
 
 -- | 比较两个排序键
-compareKeys :: [(String, SortDir)] -> [Maybe Value] -> [Maybe Value] -> Ordering
+compareKeys :: [SortDir] -> [Maybe Value] -> [Maybe Value] -> Ordering
 compareKeys [] _ _ = EQ
-compareKeys ((_, dir) : rest) (a : as) (b : bs) =
+compareKeys (dir : rest) (a : as) (b : bs) =
     case (a, b) of
         (Just v1, Just v2) ->
             case compareValue v1 v2 of
@@ -36,4 +37,19 @@ sortRows spec rows = map snd (sortBy cmp (map decorate rows))
     -- | 取键并带上原行
     decorate row = (sortKey spec row, row)
     -- | 比较两个带键的行
-    cmp (k1, _) (k2, _) = compareKeys spec k1 k2
+    cmp (k1, _) (k2, _) = compareKeys (map snd spec) k1 k2
+
+-- | 用绑定槽位取键并稳定排序
+sortBoundRows :: [(Expr, SortDir)] -> Row -> [Row] -> Either String [Row]
+sortBoundRows [] _ rows = Right rows
+sortBoundRows spec outer rows = do
+    decorated <- mapM decorate rows
+    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

@@ -1,25 +1,25 @@
-module ChuSQL.Core.Engine.Builtin
+module ChuSQL.Core.Engine.Builtin (
-    ( Builtin (..)
+    Builtin (..),
-    , builtinNames
+    builtinNames,
-    , resolveBuiltin
+    resolveBuiltin,
-    , builtinName
+    builtinName,
-    , invokeBuiltin
+    invokeBuiltin,
-    , builtinOfExpr
+    builtinOfExpr,
-    , builtinNode
+    builtinNode,
-    , aggregateArg
+    aggregateArg,
-    , unsupportedAggregate
+    unsupportedAggregate,
-    , Operator (..)
+    Operator (..),
-    , operatorOfExpr
+    operatorOfExpr,
-    , operatorSymbol
+    operatorSymbol,
-    , operatorOfCompare
+    operatorOfCompare,
-    , compareNode
+    compareNode,
-    , executeOperator
+    executeOperator,
-    , threeValuedNot
+    threeValuedNot,
-    , inValues
+    inValues,
-    ) where
+) where
 
-import ChuSQL.Core.Model (Value (..), compareValue)
 import ChuSQL.Core.Engine.Syntax.AST (CompareOp (..), Expr (..))
+import ChuSQL.Core.Model (Value (..), compareValue)
 import Control.Monad (foldM)
 import Data.Char (toLower)
 
@@ -246,12 +246,12 @@ evalArith ops x y = case (asDouble x, asDouble y) of
 divArith :: Arith
 divArith = Arith intDiv floatDiv
   where
-    -- | 整数除法：除零与溢出都报错
+    -- \| 整数除法：除零与溢出都报错
     intDiv _ 0 = Left "division by zero"
     intDiv x y
         | x == minBound && y == -1 = Left "integer division overflow"
         | otherwise = Right (x `quot` y)
-    -- | 浮点除法：不能除以零
+    -- \| 浮点除法：不能除以零
     floatDiv _ 0 = Left "division by zero"
     floatDiv x y = Right (x / y)
 
@@ -303,8 +303,9 @@ threeValuedNot :: Value -> Value
 threeValuedNot (VBool b) = VBool (not b)
 threeValuedNot _ = VNull
 
--- | IN 三值逻辑：命中为真，碰 NULL 得 NULL
+-- | IN 空集为假，非空集按三值逻辑比较
 inValues :: Value -> [Value] -> Either String Value
+inValues _ [] = Right (VBool False)
 inValues VNull _ = Right VNull
 inValues v vs = do
     results <- mapM (\x -> executeOperator OpEq [v, x]) vs

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

@@ -1,12 +1,12 @@
-module ChuSQL.Core.Engine.Error
+module ChuSQL.Core.Engine.Error (
-    ( ErrorCategory (..)
+    ErrorCategory (..),
-    , ErrorRule (..)
+    ErrorRule (..),
-    , errorRules
+    errorRules,
-    , errorCategory
+    errorCategory,
-    , errorCode
+    errorCode,
-    , errorLike
+    errorLike,
-    , accountErrorCode
+    accountErrorCode,
-    ) where
+) where
 
 import Data.List (isInfixOf)
 
@@ -35,6 +35,8 @@ errorRules :: [ErrorRule]
 errorRules =
     [ ErrorRule "no database selected" NoDatabaseError "no_database"
     , ErrorRule "administrator required" PermissionError "forbidden"
+    , ErrorRule "bound query object changed" CatalogError "serialization_failure"
+    , ErrorRule "bound query schema changed" CatalogError "serialization_failure"
     , ErrorRule "unknown table" CatalogError "not_found"
     , ErrorRule "unknown domain" CatalogError "not_found"
     , ErrorRule "domain is still used" CatalogError "query_error"

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

@@ -0,0 +1,151 @@
+module ChuSQL.Core.Engine.Normalization where
+
+import ChuSQL.Core.Model (Column)
+import Data.List (nub, sort, subsequences, (\\))
+
+-- 只读范式分析：声明验证、阿姆斯特朗闭包、候选键与分解建议。
+
+type Attributes = [String]
+data Dependency = Dependency Attributes Attributes deriving (Eq, Show)
+data Verdict = Satisfied | Violated | Insufficient deriving (Eq, Show)
+data NormalForm = NF1 | NF2 | NF3 | BCNF deriving (Eq, Show)
+data Declaration = Declaration
+    { declaredKeys :: [Attributes]
+    , dependencies :: [Dependency]
+    , dependenciesComplete :: Bool
+    , atomicAttributes :: Maybe Bool
+    }
+    deriving (Eq, Show)
+data Finding = Finding
+    { normalForm :: NormalForm
+    , verdict :: Verdict
+    , witnesses :: [Dependency]
+    , condition :: String
+    }
+    deriving (Eq, Show)
+data Decomposition = Decomposition
+    { relations :: [Attributes]
+    , losslessJoin :: Verdict
+    , dependencyPreserving :: Verdict
+    }
+    deriving (Eq, Show)
+data Analysis = Analysis
+    { candidateKeys :: [Attributes]
+    , findings :: [Finding]
+    , suggestions :: [Decomposition]
+    }
+    deriving (Eq, Show)
+
+-- 规范化属性集合。
+canonical :: Attributes -> Attributes
+canonical = sort . nub
+
+-- 判断属性集合包含关系。
+subset :: Attributes -> Attributes -> Bool
+subset xs ys = all (`elem` ys) xs
+
+-- 用自反、增广和传递规则求闭包。
+attributeClosure :: [Dependency] -> Attributes -> Attributes
+attributeClosure f seed = fixed (canonical seed)
+  where
+    -- 迭代加入已蕴含的属性。
+    fixed xs =
+        let ys = canonical (xs ++ concat [b | Dependency a b <- f, subset a xs])
+         in if xs == ys then xs else fixed ys
+
+-- 判断声明是否蕴含依赖。
+implies :: [Dependency] -> Dependency -> Bool
+implies f (Dependency a b) = subset b (attributeClosure f a)
+
+-- 枚举最小超键。
+keysOf :: Attributes -> [Dependency] -> [Attributes]
+keysOf attrs f =
+    [ x
+    | x <- subsequences attrs
+    , super x
+    , (not . any super) [x \\ [a] | a <- x]
+    ]
+  where
+    -- 判断闭包是否覆盖关系。
+    super x = subset attrs (attributeClosure f x)
+
+-- 投影关系上的全部非平凡依赖。
+projectDependencies :: [Dependency] -> Attributes -> [Dependency]
+projectDependencies f attrs =
+    [ Dependency x [a]
+    | x <- subsequences attrs
+    , a <- attributeClosure f x
+    , a `elem` attrs
+    , a `notElem` x
+    ]
+
+-- 验证声明并生成只读范式报告。
+analyzeNormalization :: [(String, Column)] -> Declaration -> Either String Analysis
+analyzeNormalization schema declaration
+    | null attrs = Left "normalization: empty schema"
+    | length attrs /= length schema = Left "normalization: duplicate columns"
+    | length attrs > 12 = Left "normalization: exhaustive analysis supports at most 12 columns"
+    | any invalidDependency supplied = Left "normalization: unknown or duplicate dependency attributes"
+    | any invalidKey rawKeys = Left "normalization: unknown or duplicate key attributes"
+    | any (`notElem` keys) normalizedKeys = Left "normalization: declared candidate key is not minimal"
+    | otherwise = Right (Analysis keys results decompositions)
+  where
+    attrs = canonical (map fst schema)
+    supplied = dependencies declaration
+    rawKeys = declaredKeys declaration
+    normalizedKeys = map canonical rawKeys
+    f = supplied ++ [Dependency k attrs | k <- normalizedKeys]
+    keys = keysOf attrs f
+    prime = nub (concat keys)
+    complete = dependenciesComplete declaration
+    atomic = case atomicAttributes declaration of
+        Just True -> Satisfied
+        Just False -> Violated
+        Nothing -> Insufficient
+    allFDs = projectDependencies f attrs
+    partial =
+        [ d
+        | d@(Dependency x [a]) <- allFDs
+        , a `notElem` prime
+        , any (\k -> x /= k && subset x k) keys
+        ]
+    third =
+        [ d
+        | d@(Dependency x [a]) <- allFDs
+        , a `notElem` prime
+        , not (subset attrs (attributeClosure f x))
+        ]
+    boyce =
+        [ d
+        | d@(Dependency x _) <- allFDs
+        , not (subset attrs (attributeClosure f x))
+        ]
+    results =
+        Finding NF1 atomic [] "attributes must have atomic domains; requires an explicit declaration"
+            : [classify NF2 partial, classify NF3 third, classify BCNF boyce]
+    decompositions = [split d | complete, atomic == Satisfied, d <- take 1 boyce]
+    -- 校验字段集合。
+    valid xs = length xs == length (canonical xs) && subset xs attrs
+    -- 校验依赖声明。
+    invalidDependency (Dependency a b) = not (valid a && valid b) || null b
+    -- 校验候选键声明。
+    invalidKey k = not (valid k)
+    -- 结合声明完整性判定范式。
+    classify nf ds = Finding nf status (if complete then ds else []) (rule nf)
+      where
+        status
+            | atomic == Violated = Violated
+            | atomic == Insufficient || not complete = Insufficient
+            | null ds = Satisfied
+            | otherwise = Violated
+    -- 说明各范式的必要条件。
+    rule NF1 = "attributes must have atomic domains"
+    rule NF2 = "no nonprime attribute depends on a proper subset of any candidate key"
+    rule NF3 = "each nontrivial dependency has a superkey determinant or a prime dependent"
+    rule BCNF = "each nontrivial dependency has a superkey determinant"
+    -- 按违反依赖生成一次无损分解。
+    split (Dependency x y) = Decomposition parts Satisfied preservation
+      where
+        parts = [canonical (x ++ y), attrs \\ (y \\ x)]
+        projected = concatMap (projectDependencies f) parts
+        preservation = if all (implies projected) f then Satisfied else Violated

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

@@ -6,8 +6,10 @@ module ChuSQL.Core.Engine.Parallel (
 ) where
 
 import Control.Concurrent (forkIO)
-import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar)
+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
+import Control.Concurrent.MVar (MVar, modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar)
 import Control.Exception (SomeException, throwIO, try)
+import Control.Monad (forever, join)
 import System.IO.Unsafe (unsafePerformIO)
 
 -- 并行执行：常驻工作线程池，结果按提交顺序收回。
@@ -16,13 +18,11 @@ import System.IO.Unsafe (unsafePerformIO)
 parallelShardLimit :: Int
 parallelShardLimit = 8
 
--- | 池：待办队列与唤醒信号
+-- | 池：工作线程共享的待办队列
-data Pool = Pool
+newtype Pool = Pool (Chan (IO ()))
-    { poolJobs :: MVar [IO ()]
-    , poolReady :: MVar ()
-    }
 
 {-# NOINLINE poolRef #-}
+
 -- | 进程全局的池，按容量复用
 poolRef :: MVar (Maybe (Int, Pool))
 poolRef = unsafePerformIO (newMVar Nothing)
@@ -31,42 +31,33 @@ poolRef = unsafePerformIO (newMVar Nothing)
 workerPool :: Int -> IO Pool
 workerPool size = modifyMVar poolRef reuse
   where
-    -- | 现有池够大就留着，否则换新的
+    -- \| 复用队列并按需补充工作线程
     reuse current = case current of
-        Just (capacity, pool)
+        Just (capacity, pool@(Pool jobs))
             | capacity >= wanted -> pure (current, pool)
-        _ -> do
+            | otherwise -> do
+                sequence_ [forkIO (worker jobs) | _ <- [capacity + 1 .. wanted]]
+                pure (Just (wanted, pool), pool)
+        Nothing -> do
             pool <- startPool wanted
             pure (Just (wanted, pool), pool)
 
-    -- | 池的线程数至少一个
+    -- \| 池的线程数至少一个
     wanted = max 1 size
 
-    -- | 起 wanted 个常驻线程吃队列
+    -- \| 起 wanted 个常驻线程吃队列
     startPool n = do
-        jobs <- newMVar []
+        jobs <- newChan
-        ready <- newMVar ()
+        sequence_ [forkIO (worker jobs) | _ <- [1 .. n]]
-        sequence_ [forkIO (worker jobs ready) | _ <- [1 .. n]]
+        pure (Pool jobs)
-        pure (Pool jobs ready)
 
--- | 一个工作线程：被唤醒一次就取一个待办
+-- | 一个工作线程：等待并执行队首待办
-worker :: MVar [IO ()] -> MVar () -> IO ()
+worker :: Chan (IO ()) -> IO ()
-worker jobs ready = do
+worker jobs = forever (join (readChan jobs))
-    takeMVar ready
-    job <- modifyMVar jobs pick
-    case job of
-        Nothing -> worker jobs ready
-        Just act -> act >> worker jobs ready
-  where
-    -- | 取队首，空队列就回 Nothing
-    pick [] = pure ([], Nothing)
-    pick (j : js) = pure (js, Just j)
 
 -- | 往池里丢一个待办
 submit :: Pool -> IO () -> IO ()
-submit pool job = do
+submit (Pool jobs) = writeChan jobs
-    modifyMVar_ (poolJobs pool) (pure . (++ [job]))
-    putMVar (poolReady pool) ()
 
 -- | 跑一个动作，结果或异常都填进格子
 fillCell :: MVar (Either SomeException a) -> IO a -> IO ()

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

@@ -0,0 +1,177 @@
+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 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 ExpressionNode = Constant RuntimeValue | BoundReference Int String | BoundApply FunctionId [TypedExpression]
+    | BoundList [TypedExpression] | BoundNothing | BoundJust TypedExpression | BoundTuple [TypedExpression]
+    deriving (Show, Eq)
+
+-- | 保存表达式的确定类型
+data TypedExpression = TypedExpression TypeId ExpressionNode deriving (Show, Eq)
+
+-- | 提取表达式类型身份
+expressionType :: TypedExpression -> TypeId
+expressionType (TypedExpression tid _) = tid
+
+-- | 绑定类型、列与函数身份
+bindExpression :: TypeRegistry -> FunctionRegistry -> [(String, TypeId)] -> Expression -> Either String TypedExpression
+bindExpression types functions env expression = case expression of
+    Literal ty value -> do
+        tid <- descriptorId <$> resolveType types ty
+        validateValue types tid value
+        Right (TypedExpression tid (Constant value))
+    Reference name -> case [(slot, tid) | (slot, (key, tid)) <- zip [0 ..] env, key == name] of
+        [(slot, tid)] -> describeType types tid >> Right (TypedExpression tid (BoundReference slot name))
+        [] -> Left ("unknown column: " ++ name)
+        _ -> Left ("ambiguous column: " ++ name)
+    Apply name arguments -> do
+        bound <- mapM bind arguments
+        sig <- resolveFunction functions name (map expressionType bound)
+        Right (TypedExpression (signatureResult sig) (BoundApply (signatureId sig) bound))
+    ListLiteral child arguments -> do
+        childId <- descriptorId <$> resolveType types child
+        bound <- mapM bind arguments
+        if all ((== childId) . expressionType) bound
+            then compound (listType child) (BoundList bound)
+            else Left "list element type mismatch"
+    NothingLiteral child -> compound (maybeType child) BoundNothing
+    JustLiteral argument -> do
+        bound <- bind argument
+        compound (maybeType (typeExpression (expressionType bound))) (BoundJust bound)
+    TupleLiteral arguments -> do
+        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)
+
+-- | 执行已绑定表达式并校验输出
+evaluateExpression :: TypeRegistry -> FunctionRegistry -> [(String, RuntimeValue)] -> TypedExpression -> Either String RuntimeValue
+evaluateExpression types functions row (TypedExpression tid node) = do
+    value <- case node of
+        Constant v -> Right v
+        BoundReference slot name -> case drop slot row of
+            (key, value) : _ | key == name -> Right value
+            [] -> Left ("missing bound column: " ++ name)
+            _ -> Left ("bound column position mismatch: " ++ name)
+        BoundApply fid arguments -> mapM evaluate arguments >>= invokeFunction types functions fid
+        BoundList arguments -> RList <$> mapM evaluate arguments
+        BoundNothing -> Right (RMaybe Nothing)
+        BoundJust argument -> RMaybe . Just <$> evaluate argument
+        BoundTuple arguments -> RTuple <$> mapM evaluate arguments
+    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 PlanNode = BoundScan String | BoundSingleRow | BoundProjection [(String, TypedExpression)] TypedPlan
+    | BoundSelection TypedExpression TypedPlan deriving (Show, Eq)
+
+-- | 保存输出 schema 和关系节点
+data TypedPlan = TypedPlan [(String, TypeId)] PlanNode deriving (Show, Eq)
+
+-- | 提取计划的输出 schema
+planSchema :: TypedPlan -> [(String, TypeId)]
+planSchema (TypedPlan output _) = output
+
+-- | 使用目录 schema 绑定查询计划
+bindPlan :: TypeRegistry -> FunctionRegistry -> [(String, [(String, TypeExpr)])] -> Plan -> Either String TypedPlan
+bindPlan types functions catalog plan = case plan of
+    TableScan name -> case [columns | (key, columns) <- catalog, key == name] of
+        [columns] -> do
+            uniqueNames (map fst columns)
+            bound <- mapM bindColumn columns
+            Right (TypedPlan bound (BoundScan name))
+        [] -> Left ("unknown table: " ++ name)
+        _ -> Left ("ambiguous table: " ++ name)
+    SingleRow -> Right (TypedPlan [] BoundSingleRow)
+    Projection items source -> do
+        child <- bind source
+        uniqueNames (map fst items)
+        bound <- mapM (bindItem (planSchema child)) items
+        Right (TypedPlan [(name, expressionType value) | (name, value) <- bound] (BoundProjection bound child))
+    Selection condition source -> do
+        child <- bind source
+        predicate <- bindExpression types functions (planSchema child) condition
+        bool <- descriptorId <$> resolveType types boolType
+        if expressionType predicate == bool
+            then Right (TypedPlan (planSchema child) (BoundSelection predicate child))
+            else Left "selection predicate must be Bool"
+  where
+    -- | 绑定子计划
+    bind = bindPlan types functions catalog
+    -- | 解析 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)
+
+-- | 拒绝重复输出列
+uniqueNames :: [String] -> Either String ()
+uniqueNames names
+    | nub names == names = Right ()
+    | otherwise = Left "duplicate schema column"
+
+-- | 执行绑定计划并校验存储返回值
+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
+        BoundSingleRow -> Right [[]]
+        BoundProjection items child -> do
+            input <- executePlan types functions scan child
+            mapM (project items) input
+        BoundSelection condition child -> do
+            input <- executePlan types functions scan child
+            filterM (keep condition) input
+    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
+    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

@@ -0,0 +1,111 @@
+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 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)
+        Just actual | tableCols actual == tableCols table -> Right ()
+        _ -> Left ("bound query schema changed: " ++ name)
+
+-- | 收集读写目标、来源及子查询依赖
+queryTables :: Statement -> [String]
+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
+        ++ 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
+        ++ concatMap expressionTables condition
+    Delete target condition -> target : concatMap expressionTables condition
+    DropTable target -> [target]
+    CreateIndex target _ -> [target]
+    DropIndex target _ -> [target]
+    DropColumn target _ -> [target]
+    AddColumn target _ -> [target]
+    RenameColumn target _ _ -> [target]
+    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]
+
+-- | 收集声明类型依赖的领域目录
+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]
+            names = map fst definitions
+            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 _ = []
+
+-- | 收集来源树与连接条件依赖
+sourceTables :: FromClause -> [String]
+sourceTables source = case source of
+    FromTable _ name -> [name]
+    FromSubquery _ statement -> queryTables statement
+    FromJoin _ left right condition -> sourceTables left ++ sourceTables right ++ expressionTables condition
+    FromUnit -> []
+
+-- | 收集表达式内嵌套子查询依赖
+expressionTables :: Expr -> [String]
+expressionTables expression = case expression of
+    ScalarSub query -> queryTables (subqueryStatement query)
+    ExistsSub query _ -> queryTables (subqueryStatement query)
+    InSub value query _ -> expressionTables value ++ queryTables (subqueryStatement query)
+    QuantCmp _ value query _ -> expressionTables value ++ queryTables (subqueryStatement query)
+    _ -> concatMap expressionTables (children expression)
+
+-- | 列出当前表达式的直接子节点
+children :: Expr -> [Expr]
+children expression = case expression of
+    FunctionCall _ arguments -> arguments
+    BoundFunction _ _ arguments -> arguments
+    Construct _ arguments -> arguments
+    BoundConstruct _ arguments -> arguments
+    InList value arguments _ -> value : arguments
+    Add a b -> [a, b]
+    Sub a b -> [a, b]
+    Mul a b -> [a, b]
+    Div a b -> [a, b]
+    Gt a b -> [a, b]
+    Lt a b -> [a, b]
+    Eq a b -> [a, b]
+    GtE a b -> [a, b]
+    LtE a b -> [a, b]
+    NotEq a b -> [a, b]
+    And a b -> [a, b]
+    Or a b -> [a, b]
+    Neg a -> [a]
+    IsNull a -> [a]
+    IsNotNull a -> [a]
+    CountOf a -> [a]
+    SumOf a -> [a]
+    AvgOf a -> [a]
+    MinOf a -> [a]
+    MaxOf a -> [a]
+    _ -> []

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

@@ -0,0 +1,80 @@
+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 Data.Char (toLower)
+
+-- 内建函数的固定身份、签名解析和类型化调用。
+
+-- | 标识稳定的内建函数
+newtype FunctionId = FunctionId Int deriving (Show, Eq, Ord)
+
+-- | 描述已解析的函数签名
+data FunctionSignature = FunctionSignature
+    { signatureId :: FunctionId, signatureName :: String
+    , signatureArguments :: [TypeId], signatureResult :: TypeId
+    } deriving (Show, Eq)
+
+-- | 保存函数签名和实现
+newtype FunctionRegistry = FunctionRegistry [(FunctionSignature, [RuntimeValue] -> Either String RuntimeValue)]
+
+-- | 从内建元数据恢复函数注册表
+builtinFunctions :: TypeRegistry -> Either String FunctionRegistry
+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)])
+
+-- | 按名称和完整参数类型解析函数
+resolveFunction :: FunctionRegistry -> String -> [TypeId] -> Either String FunctionSignature
+resolveFunction registry name arguments = resolveNullableFunction registry name (map Just arguments)
+
+-- | 按可空 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
+              , length arguments == length (signatureArguments sig)
+              , and (zipWith matches arguments (signatureArguments sig))] of
+        [sig] -> Right sig
+        [] -> Left ("no matching function signature: " ++ name)
+        _ -> Left ("ambiguous function signature: " ++ name)
+  where
+    -- | 匹配具体参数或未定型 NULL
+    matches Nothing _ = True
+    matches (Just supplied) expected = supplied == expected
+
+-- | 按固定身份查找函数签名
+functionSignature :: FunctionRegistry -> FunctionId -> Either String FunctionSignature
+functionSignature (FunctionRegistry functions) fid = case [sig | (sig, _) <- functions, signatureId sig == fid] of
+    [sig] -> Right sig
+    _ -> Left ("unknown function identity: " ++ show fid)
+
+-- | 校验参数并执行已解析的函数
+invokeFunction :: TypeRegistry -> FunctionRegistry -> FunctionId -> [RuntimeValue] -> Either String RuntimeValue
+invokeFunction types (FunctionRegistry functions) fid values =
+    case [(sig, implementation) | (sig, implementation) <- functions, signatureId sig == fid] of
+        [(sig, implementation)]
+            | length values == length (signatureArguments sig) -> do
+                zipWithM_
+                  (validateValue types) (signatureArguments sig) values
+                result <- implementation values
+                validateValue types (signatureResult sig) result
+                Right result
+            | otherwise -> Left "function argument count mismatch"
+        _ -> Left ("unknown function identity: " ++ show fid)
+
+-- | 计算字符串字符个数
+stringLength :: [RuntimeValue] -> Either String RuntimeValue
+stringLength [RString text] = Right (RInt (length text))
+stringLength _ = Left "length expects String"
+
+-- | 计算布尔取反
+booleanNot :: [RuntimeValue] -> Either String RuntimeValue
+booleanNot [RBool value] = Right (RBool (not value))
+booleanNot _ = Left "not expects Bool"

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

@@ -0,0 +1,76 @@
+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.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.Model
+
+-- SQL 查询绑定边界：保存解析后的类型、函数身份及输出 schema。
+
+-- | 保存运行时或兼容列类型
+data QueryType = RuntimeType TypeId | CompatibilityType ColumnType
+    | DomainType String QueryType | NullType deriving (Show, Eq)
+
+-- | 保存仅由 schema 绑定的执行计划
+data BoundQuery = BoundQuery Database [String] [(String, Column)] [(String, QueryType)] RelOp
+
+-- | 查询绑定计划的输出类型身份
+queryTypes :: BoundQuery -> [(String, QueryType)]
+queryTypes (BoundQuery _ _ _ types _) = types
+
+-- | 绑定 SQL 查询并优化确定的计划
+bindQuery :: Database -> Statement -> Either String BoundQuery
+bindQuery catalog statement = do
+    let schemaOnly = [(name, table {tableRows = []}) | (name, table) <- catalog]
+    resolved <- prepare schemaOnly statement
+    columns <- querySchema schemaOnly resolved
+    plan <- translate resolved
+    types <- mapM typeOf columns
+    bound <- bindRelOpColumns schemaOnly [] (optimize schemaOnly plan)
+    let sources = queryTables resolved
+        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)
+    bindingType CTimestamp = Right (CompatibilityType CTimestamp)
+    bindingType CBlob = Right (CompatibilityType CBlob)
+    bindingType ty = RuntimeType <$> sqlType ty
+
+-- | 执行绑定查询并校验输出类型
+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
+                (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)
+        | otherwise = Left ("bound query output type mismatch: " ++ name)

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

@@ -0,0 +1,152 @@
+module ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns, bindWriteColumns, bindSlots, orderRow) where
+
+import ChuSQL.Core.Engine.Algebra.Op
+import ChuSQL.Core.Engine.Syntax.AST
+import ChuSQL.Core.Model (Database, Row, lookupTable, tableCols)
+
+-- 按关系或写语句的输入布局绑定列槽位，并排列存储返回行。
+
+-- | 按目标表布局绑定写入表达式
+bindWriteColumns :: Database -> Statement -> Either String Statement
+bindWriteColumns db statement = case statement of
+    Insert table columns rows -> Insert table columns <$> mapM (mapM (bindSlots [] [])) rows
+    Update table assignments condition -> do
+        columns <- map fst . tableCols <$> lookupTable db table
+        bound <- mapM (bindItem columns) assignments
+        predicate <- mapM (bindSlots columns []) condition
+        Right (Update table bound predicate)
+    Delete table condition -> do
+        columns <- map fst . tableCols <$> lookupTable db table
+        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)
+
+-- | 绑定关系算子的输入列位置
+bindRelOpColumns :: Database -> [String] -> RelOp -> Either String RelOp
+bindRelOpColumns db outer = bind
+  where
+    -- \| 递归绑定每个算子的输入布局
+    bind op = case op of
+        Filter expression child -> Filter <$> expressionIn child expression <*> bind child
+        Compute items child -> Compute <$> mapM (itemIn child) items <*> bind child
+        Aggregate keys items child -> bind (BoundAggregate [(name, Col name) | name <- keys] items child)
+        BoundAggregate keys items child ->
+            BoundAggregate
+                <$> mapM (itemIn child) keys
+                <*> mapM (itemIn child) items
+                <*> bind child
+        Join kind left right condition ->
+            Join kind
+                <$> bind left
+                <*> bind right
+                <*> bindSlots (relOpCols db left ++ relOpCols db right) outer condition
+        SemiJoin kind leftKey rightKey left right query ->
+            SemiJoin kind
+                <$> expressionIn left leftKey
+                <*> expressionIn right rightKey
+                <*> bind left
+                <*> bind right
+                <*> pure query
+        Project columns child -> do
+            let names = if columns == ["*"] then relOpCols db child else columns
+            items <- mapM (itemIn child) [(name, Col name) | name <- names]
+            Compute items <$> bind child
+        Distinct child -> Distinct <$> bind child
+        Sort ordering child -> bind (BoundSort [(Col name, direction) | (name, direction) <- ordering] child)
+        BoundSort ordering child -> BoundSort <$> mapM (sortIn child) ordering <*> bind child
+        Limit count child -> Limit count <$> bind child
+        Derived alias child -> Derived alias <$> bind child
+        _ -> Right op
+    -- \| 使用子计划输出布局绑定表达式
+    expressionIn child = bindSlots (relOpCols db child) outer
+    -- \| 保留输出标签并绑定计算项
+    itemIn child (name, expression) = (,) name <$> expressionIn child expression
+    -- \| 绑定排序键并保留方向
+    sortIn child (expression, direction) = (,) <$> expressionIn child expression <*> pure direction
+
+-- | 绑定当前表达式的列引用
+bindSlots :: [String] -> [String] -> Expr -> Either String Expr
+bindSlots columns outer expression = case expression of
+    Col name -> case slots columns name of
+        slot : _ -> Right (ColumnSlot slot name)
+        [] -> outerReference name
+    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
+    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
+    BoundConstruct tid arguments -> BoundConstruct tid <$> mapM bind arguments
+    Add a b -> binary Add a b
+    Sub a b -> binary Sub a b
+    Mul a b -> binary Mul a b
+    Div a b -> binary Div a b
+    Neg a -> Neg <$> bind a
+    Gt a b -> binary Gt a b
+    Lt a b -> binary Lt a b
+    Eq a b -> binary Eq a b
+    GtE a b -> binary GtE a b
+    LtE a b -> binary LtE a b
+    NotEq a b -> binary NotEq a b
+    And a b -> binary And a b
+    Or a b -> binary Or a b
+    IsNull a -> IsNull <$> bind a
+    IsNotNull a -> IsNotNull <$> bind a
+    CountOf a -> CountOf <$> bind a
+    SumOf a -> SumOf <$> bind a
+    AvgOf a -> AvgOf <$> bind a
+    MinOf a -> MinOf <$> bind a
+    MaxOf a -> MaxOf <$> bind a
+    ScalarSub query -> ScalarSub <$> bindSubquery query
+    InSub a query negated -> InSub <$> bind a <*> bindSubquery query <*> pure negated
+    InList a values negated -> InList <$> bind a <*> mapM bind values <*> pure negated
+    ExistsSub query negated -> ExistsSub <$> bindSubquery query <*> pure negated
+    QuantCmp op a query quantifier -> QuantCmp op <$> bind a <*> bindSubquery query <*> pure quantifier
+    _ -> Right expression
+  where
+    -- \| 绑定当前布局的子表达式
+    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
+        | otherwise = case slots names name of
+            [position] -> Right position
+            [] -> Left (missing ++ name)
+            _ -> Left ("ambiguous bound column: " ++ name)
+    -- \| 在外层布局绑定并保留作用域
+    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
+            BoundSubquery _ names references
+                | 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

@@ -0,0 +1,99 @@
+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 (..))
+
+-- SQL 现有标量表示与已解析运行时函数之间的类型边界。
+
+-- | 解析 SQL 标量调用的固定签名
+resolveSQLFunction :: String -> [Maybe ColumnType] -> Either String FunctionSignature
+resolveSQLFunction name arguments = do
+    functions <- builtinFunctions builtinTypes
+    types <- mapM (traverse sqlType) arguments
+    resolveNullableFunction functions name types
+
+-- | 解析现有标量列的逻辑类型
+sqlType :: ColumnType -> Either String TypeId
+sqlType (CDomain _ base) = sqlType base
+sqlType (CRuntime tid) = describeType builtinTypes tid >> Right tid
+sqlType ty = do
+    expression <- case ty of
+        CInt -> Right intType
+        CBigInt -> Right intType
+        CSmallInt -> Right intType
+        CFloat -> Right doubleType
+        CDouble -> Right doubleType
+        CDecimal{} -> Right doubleType
+        CBool -> Right boolType
+        CStr -> Right stringType
+        CVarchar{} -> Right stringType
+        CChar{} -> Right stringType
+        _ -> Left ("unsupported runtime function argument type: " ++ show ty)
+    descriptorId <$> resolveType builtinTypes expression
+
+-- | 将函数输出类型映射为 SQL schema
+sqlResultType :: TypeId -> Either String ColumnType
+sqlResultType tid
+    | typeExpression tid == intType = Right CInt
+    | typeExpression tid == doubleType = Right CDouble
+    | typeExpression tid == boolType = Right CBool
+    | typeExpression tid == stringType = Right CStr
+    | otherwise = Left "runtime function result needs a composite SQL representation"
+
+-- | 执行固定身份的 SQL 标量函数
+invokeSQLFunction :: FunctionId -> TypeId -> [Value] -> Either String Value
+invokeSQLFunction fid expected values = do
+    functions <- builtinFunctions builtinTypes
+    sig <- functionSignature functions fid
+    if signatureResult sig /= expected
+        then Left "bound function result identity mismatch"
+        else
+            if length values /= length (signatureArguments sig)
+                then Left "function argument count mismatch"
+                else do
+                    zipWithM_
+                      validateArgument (signatureArguments sig) values
+                    if VNull `elem` values
+                        then Right VNull
+                        else do
+                            arguments <- mapM runtimeValue values
+                            result <- invokeFunction builtinTypes functions fid arguments
+                            sqlValue result
+  where
+    -- \| 校验具体参数并保留 SQL NULL
+    validateArgument _ VNull = Right ()
+    validateArgument tid value = runtimeValue value >>= validateValue builtinTypes tid
+
+-- | 转换现有 SQL 标量值
+runtimeValue :: Value -> Either String RuntimeValue
+runtimeValue (VInt n) = Right (RInt n)
+runtimeValue (VFloat n) = Right (RDouble n)
+runtimeValue (VBool b) = Right (RBool b)
+runtimeValue (VStr text) = Right (RString text)
+runtimeValue (VRuntime tid value) = validateValue builtinTypes tid value >> Right value
+runtimeValue VNull = Left "untyped SQL NULL has no runtime scalar value"
+
+-- | 转换运行时标量结果
+sqlValue :: RuntimeValue -> Either String Value
+sqlValue (RInt n) = Right (VInt n)
+sqlValue (RDouble n) = Right (VFloat n)
+sqlValue (RBool b) = Right (VBool b)
+sqlValue (RString text) = Right (VStr text)
+sqlValue _ = Left "composite runtime result has no SQL scalar representation"
+
+-- | 按已解析构造器生成类型化值
+constructSQLValue :: TypeId -> [Value] -> Either String Value
+constructSQLValue tid values = do
+    arguments <- mapM runtimeValue values
+    value <- case typeExpression tid of
+        TypeApply (TypeConstructorId 5) [_] -> Right (RList arguments)
+        TypeApply (TypeConstructorId 6) [_] -> case arguments of
+            [] -> Right (RMaybe Nothing)
+            [argument] -> Right (RMaybe (Just argument))
+            _ -> Left "Maybe constructor expects zero or one argument"
+        TypeApply (TypeConstructorId 7) _ -> Right (RTuple arguments)
+        _ -> Left "type is not a composite constructor"
+    validateValue builtinTypes tid value
+    Right (VRuntime tid value)

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

@@ -0,0 +1,5 @@
+module ChuSQL.Core.Engine.Runtime.Types (module ChuSQL.Core.Runtime) where
+
+import ChuSQL.Core.Runtime
+
+-- 导出共享的运行时类型身份和物理编码契约。

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

@@ -1,9 +1,15 @@
-module ChuSQL.Core.Engine.Semantic (check, prepare) where
+{-# LANGUAGE TupleSections #-}
+module ChuSQL.Core.Engine.Semantic (check, prepare, prepareRowExpression, prepareCheckExpression, querySchema) where
 
-import ChuSQL.Core.Engine.Algebra.Expr (bareColumns, colsInExpr, hasAggregate)
+import Control.Monad (void)
-import ChuSQL.Core.Model
+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.Types
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
+import ChuSQL.Core.Model
 import Data.Char (isAlphaNum, isAscii, toLower)
 import Data.List (intercalate, isInfixOf, isPrefixOf, isSuffixOf, nub)
 
@@ -21,24 +27,35 @@ prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
   where
     prefix = maybe "" (++ ".") mAlias
 
--- | 检查期的作用域：本层优先，外层兜底
+-- | 从 schema 推导查询输出列
+querySchema :: Database -> Statement -> Either String [(String, Column)]
+querySchema db statement = do
+    columns <- inferSubqueryOutput db (Scope [] []) (Subquery statement [])
+    Right [(name, plainColumn (derivedType ty)) | (name, ty) <- columns]
+
+-- | 从最近层到最远层保存外部作用域
+type EnclosingScopes = [[(String, Column)]]
+
+-- | 保存本层与各层外部列
 data Scope = Scope
     { scopeInner :: [(String, Column)]
-    , scopeOuter :: [(String, Column)]
+    , scopeOuter :: EnclosingScopes
     }
 
--- | 本层先查，查不到再落外层；本层同名引起歧义时不往外层让
+-- | 逐层解析列，本层歧义不向外层回退
 scopeAt :: String -> Scope -> String -> Either String (String, Column)
-scopeAt place scope c
+scopeAt place scope c = search (scopeFrames scope)
-    | null (scopeOuter scope) = columnAt place (scopeInner scope) c
+  where
-    | otherwise = case columnAt place (scopeInner scope) c of
+    -- | 在最近的可见列层停止查找
+    search [] = Left (missingColumn place c (concat (scopeFrames scope)))
+    search (columns : rest) = case columnAt place columns c of
         Right entry -> Right entry
         Left err
             | "ambiguous column:" `isInfixOf` err -> Left err
-            | otherwise -> columnAt place (scopeOuter scope) c
+            | otherwise -> search rest
 
 -- | 收集 FROM 的列，列前缀由表名推导
-checkFrom :: Database -> [(String, Column)] -> FromClause -> Either String [(String, Column)]
+checkFrom :: Database -> EnclosingScopes -> FromClause -> Either String [(String, Column)]
 checkFrom _ _ FromUnit = Right []
 checkFrom db _ (FromTable mAlias tbl) = do
     (key, t) <- resolveTable db tbl
@@ -63,13 +80,9 @@ inferredColumnType :: ColumnType -> InferredType
 inferredColumnType CNull = InferNull
 inferredColumnType ty = InferType ty
 
--- | 合并两层列，本层优先且不重复
+-- | 进入子查询时保留每层的列边界
-scopedEnv :: [(String, Column)] -> [(String, Column)] -> [(String, Column)]
+scopeFrames :: Scope -> EnclosingScopes
-scopedEnv env outer = env ++ [o | o <- outer, o `notElem` env]
+scopeFrames scope = scopeInner scope : scopeOuter scope
-
--- | 把作用域摊平成一层的列清单
-scopeFlat :: Scope -> [(String, Column)]
-scopeFlat scope = scopedEnv (scopeInner scope) (scopeOuter scope)
 
 -- | 拼“列不存在”的报错
 missingColumn :: String -> String -> [(String, Column)] -> String
@@ -82,7 +95,7 @@ missingColumn place c env =
 
 -- | 检查列是否都在环境里
 checkColumns :: String -> Scope -> [String] -> Either String ()
-checkColumns place env = mapM_ (\c -> if c == allColumns then Right () else () <$ scopeAt place env c)
+checkColumns place env = mapM_ (\c -> if c == allColumns then Right () else void (scopeAt place env c))
 
 -- | 在一层里查一列，报错时带上子句名与可用列
 columnAt :: String -> [(String, Column)] -> String -> Either String (String, Column)
@@ -98,17 +111,19 @@ checkNoAggregate place e
     | otherwise = Right ()
 
 -- | 分组查询里，没被聚合的列必须出现在 GROUP BY 里
-checkGrouping :: Scope -> [String] -> [(String, Expr)] -> Either String ()
+checkGrouping :: Scope -> [String] -> [(String, Expr)] -> Maybe Expr -> Either String ()
-checkGrouping env keys items
+checkGrouping env keys items having
-    | null keys && not (any (hasAggregate . snd) items) = Right ()
+    | null keys && null having && not (any (hasAggregate . snd) items) = Right ()
     | otherwise = do
         checkColumns "GROUP BY" env keys
-        mapM_ okCol (nub (concatMap (bareColumns . snd) items))
+        mapM_ (checkRuntimeColumn "GROUP BY" env) keys
+        mapM_ okCol (nub (concatMap (bareColumns . snd) items ++ concatMap bareColumns having))
   where
-    -- | 这一列能不能出现在分组查询里
+    -- \| 这一列能不能出现在分组查询里
     okCol c
         | c == allColumns = Left "SELECT: * cannot be selected together with GROUP BY"
         | c `elem` keys = Right ()
+        | Left _ <- resolveColumn c (scopeInner env) = Right ()
         | otherwise = Left ("SELECT: column " ++ c ++ " must appear in GROUP BY or be aggregated")
 
 -- | 渲染一个推导类型
@@ -119,6 +134,8 @@ renderType (InferType t) = typeLabel t
 -- | 推导表达式的类型（子查询也在这里整条查一遍）
 inferExpr :: Database -> String -> Scope -> Expr -> Either String InferredType
 inferExpr _ place env (Col c) = inferredColumnType . columnType . snd <$> scopeAt place env c
+inferExpr _ _ _ ColumnSlot{} = Left "execution column cannot be used in semantic input"
+inferExpr _ _ _ OuterColumnSlot{} = Left "execution column cannot be used in semantic input"
 inferExpr _ _ _ LitNull = Right InferNull
 inferExpr _ _ _ (LitInt _) = Right (InferType CInt)
 inferExpr _ _ _ (LitFloat _) = Right (InferType CFloat)
@@ -127,6 +144,23 @@ inferExpr _ _ _ (LitBool _) = Right (InferType CBool)
 inferExpr _ _ _ (LitDate _) = Right (InferType CDate)
 inferExpr _ _ _ (LitTimestamp _) = Right (InferType CTimestamp)
 inferExpr _ _ _ (LitBlob _) = Right (InferType CBlob)
+inferExpr db place env (Construct ty arguments) = InferType . CRuntime <$> inferConstruction db place env ty arguments
+inferExpr db place env (BoundConstruct tid arguments) = do
+    inferred <- inferConstruction db place env (typeExpression tid) arguments
+    if inferred == tid then Right (InferType (CRuntime tid)) else Left "constructor result identity mismatch"
+inferExpr _ _ _ (RuntimeLiteral tid value) = validateValue builtinTypes tid value >> Right (InferType (CRuntime tid))
+inferExpr db place env (FunctionCall name arguments) = do
+    inferred <- mapM (inferExpr db place env) arguments
+    sig <- resolveSQLFunction name (map inferredArgument inferred)
+    InferType <$> sqlResultType (signatureResult sig)
+inferExpr db place env (BoundFunction fid tid arguments) = do
+    functions <- builtinFunctions builtinTypes
+    expected <- functionSignature functions fid
+    inferred <- mapM (inferExpr db place env) arguments
+    resolved <- resolveSQLFunction (signatureName expected) (map inferredArgument inferred)
+    if signatureId resolved == fid && signatureResult resolved == tid
+        then InferType <$> sqlResultType tid
+        else Left "bound function signature identity mismatch"
 inferExpr db place env (Add a b) = arithmetic db place env a b
 inferExpr db place env (Sub a b) = arithmetic db place env a b
 inferExpr db place env (Mul a b) = arithmetic db place env a b
@@ -160,8 +194,8 @@ inferExpr db place env (AvgOf a) = do
         InferType x
             | numericType x -> Right (InferType CFloat)
             | otherwise -> Left (place ++ ": AVG needs a number, got " ++ typeLabel x)
-inferExpr db place env (MinOf a) = aggregateArg db place env a
+inferExpr db place env (MinOf a) = aggregateArg db place env a >>= requireOrdering "MIN"
-inferExpr db place env (MaxOf a) = aggregateArg db place env a
+inferExpr db place env (MaxOf a) = aggregateArg db place env a >>= requireOrdering "MAX"
 inferExpr db place env (ScalarSub sq) = do
     cols <- inferSubqueryOutput db env sq
     case cols of
@@ -203,22 +237,20 @@ itemType place want got
 
 -- | 推导子查询的输出列与类型
 inferSubqueryOutput :: Database -> Scope -> Subquery -> Either String [(String, InferredType)]
+inferSubqueryOutput _ _ BoundSubquery{} = Left "execution subquery cannot be used in semantic input"
 inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
-    q@Select { selectCols = cols } -> do
+    SelectDistinct q -> do
+        columns <- inferSubqueryOutput db outerScope sq{subqueryStatement = q}
+        mapM_ (requireOrdering "DISTINCT" . snd) columns
+        _ <- distinctOrdering q
+        Right columns
+    q@Select{selectItems = items} -> do
         env <- checkFrom db enclosing (selectFrom q)
         checkResolvedWith db enclosing q
-        mapM (columnTypeOf env) cols
+        mapM (\(l, e) -> (l,) <$> inferExpr db "SELECT" (Scope env enclosing) e) items
-    q@SelectExpr { selectItems = items } -> do
-        env <- checkFrom db enclosing (selectFrom q)
-        checkResolvedWith db enclosing q
-        mapM (\(l, e) -> (\t -> (l, t)) <$> inferExpr db "SELECT" (Scope env enclosing) e) items
     _ -> Left "subquery must be a SELECT"
   where
-    enclosing = scopeFlat outerScope
+    enclosing = scopeFrames outerScope
-    -- | 查这一列的推导类型
-    columnTypeOf env c = do
-        (_, col) <- scopeAt "SELECT" (Scope env enclosing) c
-        Right (c, inferredColumnType (columnType col))
 
 -- | 聚合的参数：列要在，且不能嵌套聚合
 aggregateArg :: Database -> String -> Scope -> Expr -> Either String InferredType
@@ -251,7 +283,7 @@ arithmetic db place env a b = do
     mapM_ (numericOperand place (InferType want) (InferType want)) [ta, tb]
     Right (arithResult ta tb)
   where
-    -- | 是不是浮点类型
+    -- \| 是不是浮点类型
     isFloatSide (InferType x) = numericType x && not (integerType x)
     isFloatSide _ = False
 
@@ -285,7 +317,7 @@ boolean db place env a b = do
     mapM_ (boolOperand place ta) [ta, tb]
     Right (InferType CBool)
   where
-    -- | 挨个查操作数是不是布尔
+    -- \| 挨个查操作数是不是布尔
     boolOperand _ _ InferNull = Right ()
     boolOperand _ _ (InferType ty) | typeClassOf ty == BooleanClass = Right ()
     boolOperand p other t = Left (p ++ ": operator needs TBool on both sides, got " ++ renderType other ++ " and " ++ renderType t)
@@ -321,7 +353,7 @@ checkAssign db t = checkTyped db "UPDATE" (Scope (tableCols t) []) t
 
 -- | 按语句类型分派检查
 check :: Database -> Statement -> Either String ()
-check db q = () <$ prepare db q
+check db q = void (prepare db q)
 
 -- | 执行前解析列名并检查类型
 prepare :: Database -> Statement -> Either String Statement
@@ -386,19 +418,19 @@ ddlTargets statement = case statement of
 -- | 从 schema 解析列上的命名类型
 resolveDomainTypes :: Database -> Statement -> Either String Statement
 resolveDomainTypes db statement = case statement of
-    CreateDomain name base -> CreateDomain name <$> resolveType base
+    CreateDomain name base -> CreateDomain name <$> resolveDomainType base
     CreateTable name cols -> CreateTable name <$> mapM resolveColumnType cols
     AddColumn name col -> AddColumn name <$> resolveColumnType col
-    AlterColumnType name col ty -> AlterColumnType name col <$> resolveType ty
+    AlterColumnType name col ty -> AlterColumnType name col <$> resolveDomainType ty
     _ -> Right statement
   where
-    -- | 解析一列的类型
+    -- \| 解析一列的类型
     resolveColumnType (name, col) = do
-        ty <- resolveType (columnType col)
+        ty <- resolveDomainType (columnType col)
-        Right (name, col {columnType = ty})
+        Right (name, col{columnType = ty})
-    -- | 从类型目录取基础类型
+    -- \| 从类型目录取基础类型
-    resolveType = resolveWith []
+    resolveDomainType = resolveWith []
-    -- | 递归解析类型并拒绝循环定义
+    -- \| 递归解析类型并拒绝循环定义
     resolveWith seen (CDomain name _)
         | map toLower name `elem` seen = Left ("cyclic domain definition: " ++ name)
         | otherwise = do
@@ -413,33 +445,25 @@ checkResolved :: Database -> Statement -> Either String ()
 checkResolved db = checkResolvedWith db []
 
 -- | 检查已解析的语句；outer 是相关子查询能看见的外层列
-checkResolvedWith :: Database -> [(String, Column)] -> Statement -> Either String ()
+checkResolvedWith :: Database -> EnclosingScopes -> Statement -> Either String ()
 checkResolvedWith db outer q = case q of
-    Select
+    SelectDistinct inner -> void (inferSubqueryOutput db (Scope [] outer) (Subquery (SelectDistinct inner) []))
-        { selectCols = cols
+    Select items fromC mWhere groupBy having orderBy _ -> do
-        , selectFrom = fromC
-        , selectWhere = mWhere
-        , selectGroupBy = groupBy
-        , selectOrderBy = orderBy
-        } -> do
         env <- checkFrom db outer fromC
         let full = Scope env outer
-            checkColumns "SELECT" full cols
+        mapM_ (inferExpr db "SELECT" full . snd) items
-            checkGrouping full groupBy (map (\c -> (c, Col c)) cols)
+        ordering <- mapM (orderExpression items . fst) orderBy
-            checkColumns "ORDER BY" full (map fst orderBy)
+        mapM_ (checkBool db "HAVING" full) having
-            mapM_ (checkNoAggregate "WHERE") mWhere
+        checkGrouping full groupBy (items ++ zip (map (show . fst) orderBy) ordering) having
-            mapM_ (checkBool db "WHERE" full) mWhere
+        mapM_ (checkOrder db full items . fst) orderBy
-    SelectExpr items fromC mWhere groupBy orderBy _ -> do
-        env <- checkFrom db outer fromC
-        let full = Scope env outer
-        mapM_ (\item -> () <$ inferExpr db "SELECT" full (snd item)) items
-        checkGrouping full groupBy (items ++ [(c, Col c) | (c, _) <- orderBy, c `notElem` map fst items])
-        mapM_ (checkOrder full items . fst) orderBy
         mapM_ (checkNoAggregate "WHERE") mWhere
         mapM_ (checkBool db "WHERE" full) mWhere
     Insert tbl cols rows -> do
         t <- lookupTable db tbl
         checkColumns "INSERT" (Scope (tableCols t) []) cols
+        case [name | name <- cols, length (filter (== name) cols) > 1] of
+            name : _ -> Left ("INSERT: duplicate target column: " ++ name)
+            [] -> Right ()
         if null rows
             then Left "INSERT: no values"
             else mapM_ (mapM_ (checkValue db t) . zip cols) rows
@@ -460,7 +484,7 @@ checkResolvedWith db outer q = case q of
                 if length names /= length (nub names)
                     then Left ("CREATE TABLE: duplicate column names in " ++ name)
                     else Right ()
-                checkColumnDefs (map fst cols) cols
+                checkColumnDefs cols cols
     DropTable name ->
         if null name
             then Left "DROP TABLE: empty table name"
@@ -468,7 +492,7 @@ checkResolvedWith db outer q = case q of
     CreateIndex tbl col -> do
         t <- lookupTable db tbl
         if col `elem` tableCols' t
-            then Right ()
+            then checkRuntimeColumn "CREATE INDEX" (Scope (tableCols t) []) col
             else Left ("CREATE INDEX: unknown column: " ++ col)
     DropIndex tbl col -> do
         t <- lookupTable db tbl
@@ -483,12 +507,14 @@ checkResolvedWith db outer q = case q of
                 if col == idColumn
                     then Left "DROP COLUMN: the built-in id column cannot be dropped"
                     else Right ()
+        let remaining = filter ((/= col) . fst) (tableCols t)
+        checkChecks remaining remaining
     AddColumn tbl def -> do
         t <- lookupTable db tbl
         if fst def `elem` tableCols' t
             then Left ("ADD COLUMN: column already exists: " ++ fst def)
             else Right ()
-        checkColumnDefs (tableCols' t ++ [fst def]) [def]
+        checkColumnDefs (tableCols t ++ [def]) [def]
     RenameColumn tbl old new -> do
         t <- lookupTable db tbl
         if old `notElem` tableCols' t
@@ -500,6 +526,8 @@ checkResolvedWith db outer q = case q of
                 if new `elem` tableCols' t
                     then Left ("RENAME COLUMN: column already exists: " ++ new)
                     else Right ()
+        let renamed = [(if name == old then new else name, column) | (name, column) <- tableCols t]
+        checkChecks renamed renamed
     AlterColumnType tbl col ty -> do
         t <- lookupTable db tbl
         c <- requireColumn "ALTER COLUMN" t col
@@ -507,10 +535,12 @@ checkResolvedWith db outer q = case q of
         if columnAutoIncrement c && not (integerType ty)
             then Left "ALTER COLUMN: AUTO_INCREMENT column must stay an integer type"
             else Right ()
+        let changed = [(name, if name == col then column{columnType = ty} else column) | (name, column) <- tableCols t]
+        checkColumnDefs changed changed
     AlterColumnDefault tbl col def -> do
         t <- lookupTable db tbl
         c <- requireColumn "ALTER COLUMN" t col
-        mapM_ (\v -> checkDefault c v) def
+        mapM_ (checkDefault c) def
     AlterColumnNull tbl col nullable -> do
         t <- lookupTable db tbl
         c <- requireColumn "ALTER COLUMN" t col
@@ -524,6 +554,7 @@ checkResolvedWith db outer q = case q of
         if length (nub (map fst attributes)) == length attributes
             then Right ()
             else Left "duplicate identity attribute"
+    ShowGrants -> Right ()
     ShowRoles -> Right ()
     DropUser name -> checkUserName name
     CreateRole name -> checkRoleName name
@@ -532,6 +563,7 @@ checkResolvedWith db outer q = case q of
         mapM_ checkPrivilege privs
         checkGrantObject obj
         checkRoleName role
+    RevokeGrantOption privs obj role -> checkResolvedWith db outer (RevokePrivileges privs obj role)
     RevokePrivileges privs obj role -> do
         mapM_ checkPrivilege privs
         checkGrantObject obj
@@ -549,11 +581,11 @@ checkResolvedWith db outer q = case q of
     CreateDomain{} -> Right ()
     DropDomain{} -> Right ()
     ShowDomains -> Right ()
-    -- | 事务控制由会话层执行，语义层不做列检查
+    -- \| 事务控制由会话层执行，语义层不做列检查
     BeginTransaction -> Right ()
     CommitTransaction -> Right ()
     RollbackTransaction -> Right ()
-    -- | 保存点名字只是会话层的记号，不做列检查
+    -- \| 保存点名字只是会话层的记号，不做列检查
     Savepoint _ -> Right ()
     RollbackToSavepoint _ -> Right ()
     ReleaseSavepoint _ -> Right ()
@@ -575,20 +607,29 @@ checkInsertTargets t cols = mapM_ checkTarget (tableCols t)
         | Just _ <- columnDefault c = Right ()
         | otherwise = Left ("INSERT: column " ++ name ++ " is NOT NULL and has no default")
 
--- | 检查一列定义是否合法（names 给 CHECK 用）
+-- | 依据完整 schema 校验新增列定义
-checkColumnDefs :: [String] -> [(String, Column)] -> Either String ()
+checkColumnDefs :: [(String, Column)] -> [(String, Column)] -> Either String ()
-checkColumnDefs names cols = do
+checkColumnDefs schemaColumns cols = do
     mapM_ (checkTypeParameters . columnType . snd) cols
     mapM_ (\(_, c) -> mapM_ (checkDefault c) (columnDefault c)) cols
     mapM_ (\(_, c) -> checkAutoIncrement c) cols
+    mapM_ checkRuntimeKey cols
     if length [() | (_, c) <- cols, columnAutoIncrement c] > 1
         then Left "CREATE TABLE: at most one AUTO_INCREMENT column is allowed"
         else Right ()
-    checkChecks names cols
+    checkChecks schemaColumns cols
+  where
+    -- \| 拒绝缺少能力实现的运行时键
+    checkRuntimeKey (_, column)
+        | typeClassOf (columnType column) == RuntimeClass
+        , columnUnique column || columnPrimaryKey column =
+            Left "runtime type key capability is not registered"
+        | otherwise = Right ()
 
 -- | 校验列类型的长度和精度参数
 checkTypeParameters :: ColumnType -> Either String ()
 checkTypeParameters (CDomain _ base) = checkTypeParameters base
+checkTypeParameters (CRuntime tid) = void (describeType builtinTypes tid)
 checkTypeParameters CNull = Left "NULL is only valid as an inferred query output"
 checkTypeParameters (CDecimal p s)
     | p <= 0 || p > 308 || s < 0 || s > p = Left "invalid decimal precision or scale"
@@ -606,23 +647,20 @@ checkAutoIncrement c
 checkDefault :: Column -> Value -> Either String ()
 checkDefault c v
     | VNull <- v = Right ()
-    | valueFits (columnType c) v = () <$ coerceValue (columnType c) v
+    | valueFits (columnType c) v = void (coerceValue (columnType c) v)
     | otherwise = Left ("DEFAULT: value does not fit column type " ++ typeLabel (columnType c))
 
--- | CHECK 里的列必须存在
+-- | 按完整 schema 校验 CHECK 条件
-checkChecks :: [String] -> [(String, Column)] -> Either String ()
+checkChecks :: [(String, Column)] -> [(String, Column)] -> Either String ()
-checkChecks names = mapM_ checkOne
+checkChecks columns = mapM_ checkOne
   where
-    -- | 查这一列的 CHECK
+    -- \| 查这一列的 CHECK
     checkOne (_, c) = case columnCheck c of
         Nothing -> Right ()
         Just text -> case parseExpression text of
             Left err -> Left ("CHECK: " ++ firstLine err)
-            Right e -> mapM_ (known e) (colsInExpr e)
+            Right e -> void (prepareCheckExpression columns e)
-    -- | 这个列名在不在定义里
+    -- | 只保留解析错误的第一行
-    known _ col
-        | col `elem` names = Right ()
-        | otherwise = Left ("CHECK: unknown column: " ++ col)
     firstLine = takeWhile (/= '\n')
 
 -- | 账号名上限
@@ -647,7 +685,7 @@ checkUserName name
     | not (all allowed name) = Left "USER: account name may only contain ASCII letters, digits, dot, dash or underscore"
     | otherwise = Right ()
   where
-    -- | 账号名字符规则
+    -- \| 账号名字符规则
     allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
 
 -- | 建号 / 改口令：名字合法且口令不空
@@ -670,7 +708,7 @@ checkRoleName name
     | map toLower name `elem` privilegeNames = Left "ROLE: role name must not be a privilege keyword"
     | otherwise = Right ()
   where
-    -- | 角色名字符规则
+    -- \| 角色名字符规则
     allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
 
 -- | 权限关键字（小写，只用于比较）
@@ -692,21 +730,33 @@ checkGrantObject obj
     | not (all allowed obj) = Left "GRANT: object name may only contain ASCII letters, digits, dot, dash or underscore"
     | otherwise = Right ()
   where
-    -- | 授权对象字符规则
+    -- \| 授权对象字符规则
     allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
 
 -- | 内置 id 列名
 idColumn :: String
 idColumn = "id"
+
 -- | 把列引用统一为执行期名字（子查询一起解析）
 resolveExpr ::
     Database ->
     [(String, Column)] ->
-    [(String, Column)] ->
+    EnclosingScopes ->
     (String -> Either String String) ->
     Expr ->
     Either String Expr
 resolveExpr db env outer f e = case e of
+    Construct ty arguments -> do
+        tid <- inferConstruction db "constructor" (Scope env outer) ty arguments
+        bound <- mapM (resolveExpr db env outer f) arguments
+        Right (BoundConstruct tid bound)
+    BoundConstruct tid arguments -> BoundConstruct tid <$> mapM (resolveExpr db env outer f) arguments
+    FunctionCall name arguments -> do
+        inferred <- mapM (inferExpr db "function" (Scope env outer)) arguments
+        sig <- resolveSQLFunction name (map inferredArgument inferred)
+        bound <- mapM (resolveExpr db env outer f) arguments
+        Right (BoundFunction (signatureId sig) (signatureResult sig) bound)
+    BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM (resolveExpr db env outer f) arguments
     Col c -> Col <$> f c
     Add a b -> binary Add a b
     Sub a b -> binary Sub a b
@@ -729,44 +779,88 @@ resolveExpr db env outer f e = case e of
     AvgOf a -> AvgOf <$> resolveExpr db env outer f a
     MinOf a -> MinOf <$> resolveExpr db env outer f a
     MaxOf a -> MaxOf <$> resolveExpr db env outer f a
-    ScalarSub sq -> ScalarSub <$> resolveSubquery db (env ++ outer) sq
+    ScalarSub sq -> ScalarSub <$> resolveSubquery db (env : outer) sq
-    InSub a sq negated -> InSub <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure negated
+    InSub a sq negated -> InSub <$> resolveExpr db env outer f a <*> resolveSubquery db (env : outer) sq <*> pure negated
     InList a es negated -> InList <$> resolveExpr db env outer f a <*> mapM (resolveExpr db env outer f) es <*> pure negated
-    ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env ++ outer) sq <*> pure negated
+    ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env : outer) sq <*> pure negated
-    QuantCmp op a sq q -> QuantCmp op <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure q
+    QuantCmp op a sq q -> QuantCmp op <$> resolveExpr db env outer f a <*> resolveSubquery db (env : outer) sq <*> pure q
     _ -> Right e
   where
-    -- | 递归处理两个子表达式
+    -- \| 递归处理两个子表达式
     binary ctor a b = ctor <$> resolveExpr db env outer f a <*> resolveExpr db env outer f b
 
+-- | 校验具体构造器和参数逻辑类型
+inferConstruction :: Database -> String -> Scope -> TypeExpr -> [Expr] -> Either String TypeId
+inferConstruction db place env ty@(TypeApply cid parameters) arguments = do
+    descriptor <- resolveType builtinTypes ty
+    expected <- case (cid, parameters) of
+        (TypeConstructorId 5, [child]) -> Right (replicate (length arguments) child)
+        (TypeConstructorId 6, [child]) | length arguments <= 1 -> Right (replicate (length arguments) child)
+        (TypeConstructorId 7, fields) | length fields == length arguments -> Right fields
+        _ -> Left "composite constructor argument count mismatch"
+    inferred <- mapM (inferExpr db place env) arguments
+    supplied <- mapM argumentIdentity inferred
+    required <- mapM (fmap descriptorId . resolveType builtinTypes) expected
+    if supplied == required then Right (descriptorId descriptor) else Left "composite constructor argument type mismatch"
+  where
+    -- \| 解析非空参数的逻辑类型身份
+    argumentIdentity InferNull = Left "SQL NULL needs Maybe construction inside a runtime value"
+    argumentIdentity (InferType column) = sqlType column
+
+-- | 使用单行 schema 绑定表达式
+prepareRowExpression :: [(String, Column)] -> Expr -> Either String Expr
+prepareRowExpression columns expression = do
+    bound <- resolveExpr [] columns [] (nameIn columns "expression") expression
+    _ <- inferExpr [] "expression" (Scope columns []) bound
+    bindSlots (map fst columns) [] bound
+
+-- | 统一绑定 DDL 与写入使用的 CHECK
+prepareCheckExpression :: [(String, Column)] -> Expr -> Either String Expr
+prepareCheckExpression columns expression = do
+    checkNoAggregate "CHECK" expression
+    if hasSubquery expression
+        then Left "CHECK: subqueries are not allowed here"
+        else Right ()
+    resolved <- resolveExpr [] columns [] (nameIn columns "CHECK") expression
+    checkBool [] "CHECK" (Scope columns []) resolved
+    bindSlots (map fst columns) [] resolved
+
+-- | 将推导类型转换为可空参数类型
+inferredArgument :: InferredType -> Maybe ColumnType
+inferredArgument InferNull = Nothing
+inferredArgument (InferType ty) = Just ty
+
 -- | 解析子查询，并记下它引用的外层列
-resolveSubquery :: Database -> [(String, Column)] -> Subquery -> Either String Subquery
+resolveSubquery :: Database -> EnclosingScopes -> Subquery -> Either String Subquery
+resolveSubquery _ _ BoundSubquery{} = Left "execution subquery cannot be used in semantic input"
 resolveSubquery db outer sq = do
     stmt <- resolveSubqueryStatement db outer (subqueryStatement sq)
-    pure (Subquery stmt (outerRefsOf db stmt))
+    references <- outerRefsOf db outer stmt
+    pure (Subquery stmt references)
 
 -- | 子查询里指向外层作用域的列（内层查不到的列就是外层引用）
-outerRefsOf :: Database -> Statement -> [String]
+outerRefsOf :: Database -> EnclosingScopes -> Statement -> Either String [String]
-outerRefsOf db stmt = nub [c | c <- statementColumns stmt, not (inInner c)]
+outerRefsOf db outer stmt = do
+    inner <- checkFrom db outer (statementFrom stmt)
+    columns <- statementColumns stmt
+    Right (nub [c | c <- columns, not (inInner inner c)])
   where
-    inner = case checkFrom db [] (statementFrom stmt) of
+    -- \| 这一列能不能在内层解析到
-        Right env -> env
+    inInner inner c = case resolveColumn c inner of
-        Left _ -> []
-    -- | 这一列能不能在内层解析到
-    inInner c = case resolveColumn c inner of
         Right _ -> True
         Left _ -> False
 
 -- | 一条语句里出现的所有列引用
-statementColumns :: Statement -> [String]
+statementColumns :: Statement -> Either String [String]
 statementColumns stmt = case stmt of
-    Select cols fromC mWhere groupBy orderBy _ ->
+    SelectDistinct q -> statementColumns q
-        cols ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
+    Select items fromC mWhere groupBy having orderBy _ -> do
-    SelectExpr items fromC mWhere groupBy orderBy _ ->
+        ordering <- mapM (orderExpression items . fst) orderBy
-        concatMap (colsInExpr . snd) items ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
+        Right (concatMap (colsInExpr . snd) items ++ fromColumns fromC
-    _ -> []
+            ++ concatMap colsInExpr mWhere ++ groupBy ++ concatMap colsInExpr having ++ concatMap colsInExpr ordering)
+    _ -> Right []
   where
-    -- | 取 FROM 里出现的列
+    -- \| 取 FROM 里出现的列
     fromColumns FromUnit = []
     fromColumns (FromTable _ _) = []
     fromColumns (FromSubquery _ _) = []
@@ -774,26 +868,26 @@ statementColumns stmt = case stmt of
 
 -- | 取语句的 FROM 子句，没有就是 FromUnit
 statementFrom :: Statement -> FromClause
-statementFrom Select { selectFrom = fromC } = fromC
+statementFrom (SelectDistinct q) = statementFrom q
-statementFrom SelectExpr { selectFrom = fromC } = fromC
+statementFrom Select{selectFrom = fromC} = fromC
 statementFrom _ = FromUnit
 
 -- | 解析子查询里的 SELECT
-resolveSubqueryStatement :: Database -> [(String, Column)] -> Statement -> Either String Statement
+resolveSubqueryStatement :: Database -> EnclosingScopes -> Statement -> Either String Statement
-resolveSubqueryStatement db outer q@Select{} = resolveQuery db outer q (map (\c -> (c, Col c)) (selectCols q))
+resolveSubqueryStatement db outer (SelectDistinct q) = SelectDistinct <$> resolveSubqueryStatement db outer q
-resolveSubqueryStatement db outer q@SelectExpr{} = resolveQuery db outer q (selectItems q)
+resolveSubqueryStatement db outer q@Select{} = resolveQuery db outer q (selectItems q)
 resolveSubqueryStatement _ _ _ = Left "subquery must be a SELECT"
 
 -- | 列名解析入口：查询走连接解析，改数据的语句按本表列解析
 resolveStatement :: Database -> Statement -> Either String Statement
 resolveStatement db q = case q of
+    SelectDistinct inner -> SelectDistinct <$> resolveStatement db inner
     Select{} -> resolveSelect db q
-    SelectExpr{} -> resolveSelect db q
     Update tbl assigns mWhere -> do
         (key, t) <- resolveTable db tbl
         let env = tableCols t
             name = nameIn env "UPDATE"
-        assigns' <- mapM (\(c, e) -> (\e' -> (c, e')) <$> resolveExpr db env [] name e) assigns
+        assigns' <- mapM (\(c, e) -> (c,) <$> resolveExpr db env [] name e) assigns
         w <- mapM (resolveExpr db env [] (nameIn env "WHERE")) mWhere
         pure (Update key assigns' w)
     Delete tbl mWhere -> do
@@ -811,64 +905,90 @@ resolveStatement db q = case q of
 nameIn :: [(String, Column)] -> String -> String -> Either String String
 nameIn env place c = fst <$> columnAt place env c
 
--- | 内层先查，查不到再落到外层；内层同名引起的歧义不往外层让
+-- | 解析原始引用，最近来源限定名遮蔽远层
-scopedColumnAt :: String -> [(String, Column)] -> [(String, Column)] -> String -> Either String (String, Column)
+scopedColumnAt :: String -> [(String, Column)] -> EnclosingScopes -> String -> Either String (String, Column)
-scopedColumnAt place inner outer c = scopeAt place (Scope inner outer) c
+scopedColumnAt place inner outer c
+    | length (filter (== '.') c) == 1
+    , 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)
 
 -- | 单表保留原表头，连接使用唯一前缀
 resolveSelect :: Database -> Statement -> Either String Statement
-resolveSelect db q@Select{} = resolveQuery db [] q (map (\c -> (c, Col c)) (selectCols q))
+resolveSelect db q@Select{} = resolveQuery db [] q (selectItems q)
-resolveSelect db q@SelectExpr{} = resolveQuery db [] q (selectItems q)
 resolveSelect _ q = Right q
 
--- | 检查排序输出别名或来源列
+-- | 检查排序表达式的类型能力
-checkOrder :: Scope -> [(String, Expr)] -> String -> Either String ()
+checkOrder :: Database -> Scope -> [(String, Expr)] -> OrderKey -> Either String ()
-checkOrder env items column = case [e | (label, e) <- items, label == column] of
+checkOrder db env items column = do
-    [] -> checkColumns "ORDER BY" env [column]
+    expression <- orderExpression items column
-    [_] -> Right ()
+    void (inferExpr db "ORDER BY" env expression >>= requireOrdering "ORDER BY")
-    _ -> Left ("ORDER BY: ambiguous projection alias: " ++ column)
+
+-- | 校验列已有排序能力
+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")
+    | otherwise = Right inferred
+requireOrdering _ inferred = Right inferred
 
 -- | 解析投影、条件、排序与连接引用
-resolveQuery :: Database -> [(String, Column)] -> Statement -> [(String, Expr)] -> Either String Statement
+resolveQuery :: Database -> EnclosingScopes -> Statement -> [(String, Expr)] -> Either String Statement
 resolveQuery db outer q items = do
     source <- resolveSource db outer (selectFrom q)
     env <- checkFrom db outer source
-    -- | 单表无别名时把裸列名换成物理列名；带别名时表头保留别名限定名
+    -- \| 单表无别名时把裸列名换成物理列名；带别名时表头保留别名限定名
     let physical c = case selectFrom q of
             FromTable Nothing tbl -> unqualify (Just (deriveQualifier Nothing tbl)) c
             _ -> c
-        -- | 查一列并换算成物理名
+        -- \| 查一列并换算成物理名
         name place c
             | length (filter (== '.') c) == 2, not (qualifiedReference c) = Left (missingColumn place c env)
             | otherwise = physical . fst <$> scopedColumnAt place env outer c
-        -- | 库限定列只引用来源中的真实表名
+        -- \| 库限定列只引用来源中的真实表名
-        qualifiedReference c = qualifiedReferenceIn db (selectFrom q) c
+        qualifiedReference c =
-            || (any (\(key, _) -> length (filter (== '.') key) == 1 && ("." ++ key) `isSuffixOf` c) outer
+            qualifiedReferenceIn db (selectFrom q) c
-                && (not (any (elem '.' . fst) db) || any (\(table, _) -> (table ++ ".") `isPrefixOf` c) db))
+                || ( any
-        -- | 换算一个投影项：带别名时保留别名做输出列名
+                       (any
+                          (\ (key, _)
+                             -> length (filter (== '.') key) == 1
+                                  && ("." ++ key) `isSuffixOf` c))
+                       outer
+                        && (not (any (elem '.' . fst) db) || any (\(table, _) -> (table ++ ".") `isPrefixOf` c) db)
+                   )
+        -- \| 换算一个投影项：带别名时保留别名做输出列名
         output (label, Col c) = do
             k <- name "SELECT" c
             pure (if label == c then (k, Col k) else (label, Col k))
         output (label, e) = do
             e' <- resolveExpr db env outer (name "SELECT") e
             pure (label, e')
-    projected <- if items == [("*", Col "*")]
+    projected <-
-        then if null env && selectFrom q == FromUnit
+        if items == [("*", Col "*")]
+            then
+                if null env && selectFrom q == FromUnit
                     then Left "SELECT: * requires FROM"
                     else Right [(physical c, Col (physical c)) | (c, _) <- env]
             else mapM output items
     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 orderName c = case [label | (label, _) <- projected, label == c, qIsExpression] of
+    -- | 整项名称可用输出别名，复合表达式只查来源
-            [] -> name "ORDER BY" c
+    let orderKey key@(OrderColumn column)
-            [label] -> Right label
+            | column `elem` map fst projected = key <$ orderExpression projected key
-            _ -> Left ("ORDER BY: ambiguous projection alias: " ++ c)
+            | otherwise = OrderColumn <$> name "ORDER BY" column
-        qIsExpression = case q of SelectExpr{} -> True; _ -> False
+        orderKey key@(OrderPosition _) = key <$ orderPosition (length projected) key
-    ordering <- mapM (\(c, d) -> (\k -> (k, d)) <$> orderName c) (selectOrderBy q)
+        orderKey (OrderExpression expression) = OrderExpression <$> resolveExpr db env outer (name "ORDER BY") expression
-    pure $ case q of
+    ordering <- mapM (\(key, direction) -> (, direction) <$> orderKey key) (selectOrderBy q)
-        Select{} -> Select (map fst projected) source condition grouping ordering (selectLimit q)
+    pure (Select projected source condition grouping having ordering (selectLimit q))
-        _ -> SelectExpr projected source condition grouping ordering (selectLimit q)
 
 -- | 收集没有别名遮蔽的来源表名
 sourceTableNames :: FromClause -> [String]
@@ -883,7 +1003,7 @@ qualifiedReferenceIn db source c = any (\table -> (table ++ ".") `isPrefixOf` c)
     tables = sourceTableNames source ++ [key | table <- sourceTableNames source, Right (key, _) <- [resolveTable db table]]
 
 -- | 单表不加限定名，其余来源交给 resolveFrom
-resolveSource :: Database -> [(String, Column)] -> FromClause -> Either String FromClause
+resolveSource :: Database -> EnclosingScopes -> FromClause -> Either String FromClause
 resolveSource db outer fromC = case fromC of
     FromTable mAlias tbl -> do
         (key, _) <- resolveTable db tbl
@@ -891,7 +1011,7 @@ resolveSource db outer fromC = case fromC of
     other -> resolveFrom db outer other
 
 -- | 连接两侧与派生表都要先解析，再取环境解析 ON
-resolveFrom :: Database -> [(String, Column)] -> FromClause -> Either String FromClause
+resolveFrom :: Database -> EnclosingScopes -> FromClause -> Either String FromClause
 resolveFrom _ _ FromUnit = Right FromUnit
 resolveFrom db _ (FromTable alias tbl) = do
     (key, _) <- resolveTable db tbl
@@ -904,31 +1024,20 @@ resolveFrom db outer (FromJoin kind left right cond) = do
     l <- resolveFrom db outer left
     r <- resolveFrom db outer right
     env <- checkFrom db outer (FromJoin kind l r cond)
-    -- | 连接条件也拒绝不存在的库前缀
+    -- \| 连接条件也拒绝不存在的库前缀
     let joinName column
             | length (filter (== '.') column) == 2, not (qualifiedReferenceIn db (FromJoin kind left right cond) column) = Left (missingColumn "ON" column env)
-            | otherwise = fst <$> columnAt "ON" env column
+            | otherwise = fst <$> scopedColumnAt "ON" env outer column
     c <- resolveExpr db env outer joinName cond
     pure (FromJoin kind l r c)
 
 -- | 派生表的输出列名：列取裸名，表达式保留原标签
 nameDerivedColumns :: Statement -> Either String Statement
-nameDerivedColumns q@Select { selectCols = cols, selectFrom = fromC } = do
+nameDerivedColumns (SelectDistinct q) = SelectDistinct <$> nameDerivedColumns q
-    let names = map lastTablePart cols
+nameDerivedColumns q@Select{selectItems = items} = do
-    checkDerivedNames names
-    Right
-        ( SelectExpr
-            [(n, Col c) | (n, c) <- zip names cols]
-            fromC
-            (selectWhere q)
-            (selectGroupBy q)
-            (selectOrderBy q)
-            (selectLimit q)
-        )
-nameDerivedColumns q@SelectExpr { selectItems = items } = do
     let names = map derivedItemName items
     checkDerivedNames names
-    Right q { selectItems = zip names (map snd items) }
+    Right q{selectItems = zip names (map snd items)}
 nameDerivedColumns _ = Left "FROM: subquery must be a SELECT"
 
 -- | 派生表里一个投影项的输出名：没写别名的列取裸名
@@ -942,7 +1051,7 @@ derivedItemName (label, _) = label
 checkDerivedNames :: [String] -> Either String ()
 checkDerivedNames = go []
   where
-    -- | 逐个查有没有见过
+    -- \| 逐个查有没有见过
     go _ [] = Right ()
     go seen (n : ns)
         | n `elem` seen = Left ("FROM: duplicate column name in subquery: " ++ n)

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

@@ -13,15 +13,26 @@ data IndexResult
     deriving (Show, Eq)
 
 class (Monad m) => MonadStorage m where
+    -- \| 在实际读写前验证绑定依赖
+    withSchemaGuard :: Database -> m (Either String a) -> m (Either String a)
+    withSchemaGuard _ _ = pure (Left "bound schema guards are unavailable in this storage")
+
+    -- | 确认写守卫能力后执行绑定写入
+    withWriteSchemaGuard :: Database -> m (Either String a) -> m (Either String a)
+    withWriteSchemaGuard _ _ = pure (Left "bound write schema guards are unavailable in this storage")
+
     -- \| 建一个库
     createDatabase :: String -> m (Either String ())
     createDatabase _ = pure (Left "database management is unavailable in this storage")
+
     -- \| 删一个库
     dropDatabase :: String -> m (Either String ())
     dropDatabase _ = pure (Left "database management is unavailable in this storage")
+
     -- \| 切当前库
     useDatabase :: String -> m (Either String ())
     useDatabase _ = pure (Left "database selection is unavailable in this storage")
+
     -- \| 列出现有库
     listDatabases :: m (Either String [String])
     listDatabases = pure (Right [])
@@ -41,7 +52,7 @@ class (Monad m) => MonadStorage m where
 
     -- \| 按分片并行扫描并按分片序拼接；默认退回顺序扫描
     scanShards :: Int -> String -> Maybe [String] -> m (Either String [Row])
-    scanShards _ t cols = maybe (scan t) (scanColumns t) cols
+    scanShards _ t = maybe (scan t) (scanColumns t)
 
     -- \| 追加一行
     insert :: String -> Row -> m (Either String ())
@@ -50,7 +61,7 @@ class (Monad m) => MonadStorage m where
     insertMany :: String -> [Row] -> m (Either String ())
     insertMany t = go
       where
-        -- | 逐行插入，出错就停
+        -- \| 逐行插入，出错就停
         go [] = pure (Right ())
         go (r : rs) = do
             x <- insert t r
@@ -66,7 +77,7 @@ class (Monad m) => MonadStorage m where
             Left e -> pure (Left e)
             Right rs -> replaceAll t [r | r <- rs, not (doomed r)]
       where
-        -- | 这一行要不要删
+        -- \| 这一行要不要删
         doomed r = case lookup "id" r of
             Just (VInt k) -> k `elem` ks
             _ -> False
@@ -108,11 +119,11 @@ class (Monad m) => MonadStorage m where
     replaceSchema :: String -> [(String, Column)] -> [Row] -> m (Either String ())
 
     -- \| 取全库快照（表名 + 列 + 全部行）
-    snapshot :: m Database
+    snapshot :: m (Either String Database)
 
     -- \| 取全库结构：只要表名和列，不要行
-    schema :: m Database
+    schema :: m (Either String Database)
-    schema = fmap (map withoutRows) snapshot
+    schema = fmap (fmap (map withoutRows)) snapshot
       where
-        -- | 表定义去掉所有行
+        -- \| 表定义去掉所有行
-        withoutRows (name, t) = (name, t {tableRows = []})
+        withoutRows (name, t) = (name, t{tableRows = []})

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

@@ -10,7 +10,8 @@ module ChuSQL.Core.Engine.Storage.FFI (
     maintainStorage,
 ) where
 
-import Control.Exception (SomeException, try)
+import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread)
+import Control.Exception (SomeException, finally, mask_, try)
 import Data.ByteString qualified as BS
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
@@ -19,6 +20,7 @@ import Foreign
 import Foreign.C
 
 -- Rust 存储库 cdylib 的 C ABI 绑定（ffi.rs），收发单行 JSON。
+-- 错误读取绑定同一 OS 线程；响应复制期间屏蔽取消并归还缓冲。
 
 -- | 存储实例句柄（Rust 侧的 *mut Storage）
 newtype StorageHandle = StorageHandle (Ptr ())
@@ -46,15 +48,8 @@ foreign import ccall safe "chusql_storage_maintenance"
 
 -- | 离线修复系统目录并返回结果
 maintainStorage :: FilePath -> BS.ByteString -> IO (Either String BS.ByteString)
-maintainStorage path payload = withCString path $ \config ->
+maintainStorage path payload = BS.useAsCString (TE.encodeUtf8 (T.pack path)) $ \config ->
-    BS.useAsCStringLen payload $ \(input, size) -> alloca $ \outRef -> alloca $ \lenRef -> do
+    callStorage (cStorageMaintenance config) payload
-        code <- cStorageMaintenance config input (fromIntegral size) outRef lenRef
-        if code /= 0 then Left <$> lastError else do
-            output <- peek outRef
-            len <- peek lenRef
-            bytes <- BS.packCStringLen (output, fromIntegral len)
-            cStorageFree output len
-            pure (Right bytes)
 
 -- | 库版本（Rust 侧的 CARGO_PKG_VERSION）
 storageVersion :: IO String
@@ -62,7 +57,7 @@ storageVersion = cStorageVersion >>= peekCString
 
 -- | 打开存储实例，失败给错误文本
 openStorage :: Maybe FilePath -> IO (Either String StorageHandle)
-openStorage path = do
+openStorage path = onStorageThread $ mask_ $ do
     result <- try (withCStringOrNull path cStorageOpen) :: IO (Either SomeException (Ptr ()))
     case result of
         Left e -> pure (Left ("storage library call failed: " ++ show e))
@@ -70,9 +65,9 @@ openStorage path = do
             | ptr == nullPtr -> Left <$> lastError
             | otherwise -> pure (Right (StorageHandle ptr))
   where
-    -- | 没有路径就传空指针，否则转成 C 字符串
+    -- \| 没有路径就传空指针，否则转成 C 字符串
     withCStringOrNull Nothing f = f nullPtr
-    withCStringOrNull (Just s) f = withCString s f
+    withCStringOrNull (Just s) f = BS.useAsCString (TE.encodeUtf8 (T.pack s)) f
 
 -- | 关掉存储实例
 closeStorage :: StorageHandle -> IO ()
@@ -80,20 +75,32 @@ closeStorage (StorageHandle handle) = cStorageClose handle
 
 -- | 一条 JSON 请求换一条 JSON 响应
 storageRequest :: StorageHandle -> BS.ByteString -> IO (Either String BS.ByteString)
-storageRequest (StorageHandle handle) payload =
+storageRequest (StorageHandle handle) = callStorage (cStorageRequest handle)
-    BS.useAsCStringLen payload $ \(inPtr, inLen) ->
+
-        alloca $ \outPtrRef ->
+-- | 调用存储并复制和归还响应缓冲
-            alloca $ \outLenRef -> do
+callStorage ::
-                code <- cStorageRequest handle (castPtr inPtr) (fromIntegral inLen) outPtrRef outLenRef
+    (Ptr CChar -> CSize -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt) ->
+    BS.ByteString ->
+    IO (Either String BS.ByteString)
+callStorage call payload = onStorageThread $
+    mask_ $
+        BS.useAsCStringLen payload $ \(input, size) ->
+            alloca $ \outRef -> alloca $ \lenRef -> do
+                code <- call input (fromIntegral size) outRef lenRef
                 if code /= 0
                     then Left <$> lastError
                     else do
-                        outPtr <- peek outPtrRef
+                        output <- peek outRef
-                        outLen <- peek outLenRef
+                        len <- peek lenRef
-                        bytes <- BS.packCStringLen (castPtr outPtr, fromIntegral outLen)
+                        bytes <-
-                        cStorageFree outPtr outLen
+                            BS.packCStringLen (output, fromIntegral len)
+                                `finally` cStorageFree output len
                         pure (Right bytes)
 
+-- | 多线程运行时绑定存储调用线程
+onStorageThread :: IO a -> IO a
+onStorageThread = if rtsSupportsBoundThreads then runInBoundThread else id
+
 -- | 当前线程最近一次失败的文本
 lastError :: IO String
 lastError = alloca $ \lenRef -> do

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -30,14 +31,19 @@ module ChuSQL.Core.Engine.Storage.IPC (
     doListCatalog,
 ) where
 
-import ChuSQL.Core.Model
+import Data.Foldable (for_)
-import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
+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)
+import ChuSQL.Core.Model
+import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
 import Control.Concurrent (getNumCapabilities)
-import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, putMVar, readMVar, takeMVar, withMVar)
+import Control.Exception (bracket, mask_)
 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.Maybe (fromMaybe)
@@ -48,6 +54,7 @@ import System.IO.Unsafe (unsafePerformIO)
 -- | 一条会话的存储环境：当前库名随会话走，不共享
 data Env = Env
     { envDatabase :: Maybe String
+    , envSchemaGuard :: Maybe Database
     }
 
 newtype IPCStorage a = IPCStorage
@@ -56,11 +63,11 @@ newtype IPCStorage a = IPCStorage
 
 -- | 按库名造一个会话环境
 envForDatabase :: Maybe String -> Env
-envForDatabase = Env
+envForDatabase name = Env name Nothing
 
 -- | 进程默认环境：读全局库名，给测试与 CLI 用
 defaultEnv :: IO Env
-defaultEnv = Env <$> readMVar databaseRef
+defaultEnv = envForDatabase <$> readMVar databaseRef
 
 -- | 用进程默认环境跑（兼容既有调用点）
 runIPCStorage :: IPCStorage a -> IO a
@@ -85,19 +92,45 @@ data StorageLink = StorageLink
     }
 
 {-# NOINLINE linkRef #-}
+
 -- | 进程全局的存储链路
 linkRef :: MVar (Maybe StorageLink)
 linkRef = unsafePerformIO (newMVar Nothing)
 
+{-# NOINLINE linkUsers #-}
+
+-- | 在途请求计数与空闲信号
+linkUsers :: (MVar Int, MVar ())
+linkUsers = unsafePerformIO $ (,) <$> newMVar 0 <*> newMVar ()
+
+-- | 登记请求并在结束时释放链路占用
+withStorageLink :: (Maybe StorageLink -> IO a) -> IO a
+withStorageLink = bracket enter leave
+  where
+    (users, idle) = linkUsers
+    -- \| 登记当前链路的在途请求
+    enter = withMVar linkRef $ \current -> do
+        case current of
+            Nothing -> pure ()
+            Just _ -> modifyMVar_ users $ \count -> do
+                when (count == 0) $ takeMVar idle
+                pure (count + 1)
+        pure current
+    -- \| 最后一个请求结束后发出空闲信号
+    leave Nothing = pure ()
+    leave (Just _) = mask_ $ modifyMVar_ users $ \count -> do
+        when (count == 1) $ putMVar idle ()
+        pure (count - 1)
+
 -- | 装入一条链路；一个进程只装一次
 setStorageLink :: StorageLink -> IO ()
-setStorageLink link = modifyMVar_ linkRef (const (pure (Just link)))
+setStorageLink link = modifyMVar_ linkRef $ \_ -> withMVar (snd linkUsers) (const (pure (Just link)))
 
 -- | 打开本地的存储动态库，得到一条链路
 localStorageLink :: Maybe FilePath -> IO (Either String StorageLink)
 localStorageLink path = fmap (fmap toLink) (openStorage path)
   where
-    -- | 把句柄包成一条链路
+    -- \| 把句柄包成一条链路
     toLink handle =
         StorageLink
             { slRequest = storageRequest handle
@@ -106,35 +139,32 @@ localStorageLink path = fmap (fmap toLink) (openStorage path)
 
 -- | 关掉当前链路（进程退出前调用）；没有链路就什么都不做
 closeConnection :: IO ()
-closeConnection = modifyMVar_ linkRef $ \current -> do
+closeConnection = modifyMVar_ linkRef $ \current -> withMVar (snd linkUsers) $ \_ -> do
-    case current of
+    for_ current slClose
-        Nothing -> pure ()
-        Just link -> slClose link
     pure Nothing
 
 -- | 发一条请求并解码应答；链路没装就报错，不崩
 sendRequest :: Request -> IO Response
-sendRequest req = do
+sendRequest req = withStorageLink $ \case
-    current <- readMVar linkRef
-    case current of
                                       Nothing -> pure (RespError "storage not configured")
-        Just link -> do
+                                      Just link
-            raw <- slRequest link (BL.toStrict (encode req))
+                                        -> 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
 
 -- | 原样转发一条载荷给存储库
 sendRawRequest :: BS.ByteString -> IO (Either String BS.ByteString)
-sendRawRequest payload = do
+sendRawRequest payload = withStorageLink $ \current -> do
-    current <- readMVar linkRef
     case current of
         Nothing -> pure (Left "storage not configured")
         Just link -> slRequest link payload
 
 {-# NOINLINE databaseRef #-}
+
 -- | 进程全局的当前库名
 databaseRef :: MVar (Maybe String)
 databaseRef = unsafePerformIO (newMVar Nothing)
@@ -147,7 +177,6 @@ setDatabaseName name = modifyMVar_ databaseRef (const (pure name))
 getDatabaseName :: IO (Maybe String)
 getDatabaseName = readMVar databaseRef
 
-
 -- | 给语句类请求盖上当前库名
 stampDatabase :: Maybe String -> Request -> Request
 stampDatabase Nothing req = req
@@ -170,13 +199,43 @@ globalRequest _ = False
 -- | 发请求并把响应翻成 Either
 ask :: Env -> String -> Request -> (Response -> Maybe a) -> IO (Either String a)
 ask env what req recognize = do
-    resp <- sendRequest (stampDatabase (envDatabase env) req)
+    resp <- case envSchemaGuard env of
+        Nothing -> sendRequest (stampDatabase (envDatabase env) req)
+        Just dependencies -> guardedRequest env dependencies req
     pure $ case resp of
         RespError e -> Left e
         other -> case recognize other of
             Just a -> Right a
             Nothing -> Left ("unexpected response to " ++ what)
 
+-- | 发送依赖守卫并要求存储确认执行
+guardedRequest :: Env -> Database -> Request -> IO Response
+guardedRequest env dependencies req = do
+    let payload = case A.toJSON (stampDatabase (envDatabase env) req) of
+            A.Object fields -> A.Object (KM.insert "schema_guard" (A.toJSON (map guardOf dependencies)) fields)
+            other -> other
+    result <- sendRawRequest (BL.toStrict (encode payload))
+    pure $ case result >>= eitherDecodeStrict of
+        Left err -> RespError err
+        Right (A.Object fields)
+            | KM.lookup "status" fields == Just (A.String "guarded")
+            , Just response <- KM.lookup "response" fields -> case A.fromJSON response of
+                A.Success decoded -> decoded
+                A.Error err -> RespError ("decode error: " ++ err)
+        Right value -> case A.fromJSON value of
+            A.Success (RespError err) -> RespError err
+            _ -> RespError "storage did not confirm bound schema guard"
+  where
+    -- \| 编码依赖身份、版本与完整列定义
+    guardOf (name, table) =
+        A.object
+            [ "table" A..= name
+            , "database_id" A..= fmap (\(TableIdentity database _) -> show database) (tableIdentity table)
+            , "object_id" A..= fmap (\(TableIdentity _ object) -> show object) (tableIdentity table)
+            , "schema_version" A..= fmap show (tableSchemaVersion table)
+            , "columns" A..= map toWire (tableCols table)
+            ]
+
 -- | 只认"成了"（多数写操作都这样）
 okOnly :: Response -> Maybe ()
 okOnly RespOk = Just ()
@@ -184,19 +243,21 @@ okOnly _ = Nothing
 
 -- | 发 Scan
 doScan :: Env -> String -> IO (Either String [Row])
-doScan env t = ask env "scan" (ReqScan t) $ \resp -> case resp of
+doScan env t = ask env "scan" (ReqScan t) $ \case
                                               RespRows rows -> Just rows
                                               _ -> Nothing
 
 -- | 发带投影的 Scan
 doScanColumns :: Env -> String -> [String] -> IO (Either String [Row])
-doScanColumns env t cols = ask env "scan" (ReqScanColumns t cols) $ \resp -> case resp of
+doScanColumns env t cols = ask env "scan" (ReqScanColumns t cols) $ \case
-    RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
+                                                                      RespRows rows
+                                                                        -> Just
+                                                                             [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
                                                                       _ -> Nothing
 
 -- | 发分片 Scan：只取第 shard 片
 doScanShard :: Env -> String -> Maybe [String] -> Int -> Int -> IO (Either String [Row])
-doScanShard env t cols shard shards = ask env "scan_shard" (ReqScanShard t cols shard shards) $ \resp -> case resp of
+doScanShard env t cols shard shards = ask env "scan_shard" (ReqScanShard t cols shard shards) $ \case
                                                                                                   RespRows rows -> Just rows
                                                                                                   _ -> Nothing
 
@@ -212,25 +273,21 @@ doInsertMany env t rs = ask env "insert_batch" (ReqInsertBatch t rs) okOnly
 doDeleteKeys :: Env -> String -> [Int] -> IO (Either String ())
 doDeleteKeys env t ks = ask env "delete_keys" (ReqDeleteKeys t ks) okOnly
 
--- | 发 ReplaceAll
-doReplaceAll :: Env -> String -> [Row] -> IO (Either String ())
-doReplaceAll env t rs = ask env "replace_all" (ReqReplaceAll t rs) okOnly
-
 -- | 发 ListTables
 doListTables :: Env -> IO (Either String [String])
-doListTables env = ask env "list_tables" ReqListTables $ \resp -> case resp of
+doListTables env = ask env "list_tables" ReqListTables $ \case
                                                            RespTables ts -> Just ts
                                                            _ -> Nothing
 
 -- | 一次拿全库 schema
 doListCatalog :: Env -> IO (Either String [TableInfo])
-doListCatalog env = ask env "list_catalog" ReqListCatalog $ \resp -> case resp of
+doListCatalog env = ask env "list_catalog" ReqListCatalog $ \case
                                                               RespCatalog xs -> Just xs
                                                               _ -> Nothing
 
 -- | 按某一列的索引取一行（键可以是整数或字符串）
 doLookupByColumn :: Env -> String -> String -> Value -> IO (Either String IndexResult)
-doLookupByColumn env t c k = ask env "lookup_by_index" (ReqLookupByColumn t c k) $ \resp -> case resp of
+doLookupByColumn env t c k = ask env "lookup_by_index" (ReqLookupByColumn t c k) $ \case
                                                                                      RespRows rows -> Just (IndexRows rows)
                                                                                      RespNoIndex -> Just NoIndex
                                                                                      _ -> Nothing
@@ -243,37 +300,17 @@ doScanRange ::
     Maybe (Value, Bool) ->
     Maybe (Value, Bool) ->
     IO (Either String (Maybe [Row]))
-doScanRange env t c lo hi = ask env "range_by_index" (ReqRangeByIndex t c lo hi) $ \resp -> case resp of
+doScanRange env t c lo hi = ask env "range_by_index" (ReqRangeByIndex t c lo hi) $ \case
                                                                                      RespRows rows -> Just (Just rows)
                                                                                      RespNoIndex -> Just Nothing
                                                                                      _ -> Nothing
 
 -- | 发 DescribeTable
 doDescribeTable :: Env -> String -> IO (Either String TableInfo)
-doDescribeTable env t = ask env "describe_table" (ReqDescribeTable t) $ \resp -> case resp of
+doDescribeTable env t = ask env "describe_table" (ReqDescribeTable t) $ \case
                                                                           RespSchema info -> Just info
                                                                           _ -> Nothing
 
--- | 给某一列建索引
-doCreateIndex :: Env -> String -> String -> IO (Either String ())
-doCreateIndex env t c = ask env "create_index" (ReqCreateIndex t c) okOnly
-
--- | 去掉某一列的索引
-doDropIndex :: Env -> String -> String -> IO (Either String ())
-doDropIndex env t c = ask env "drop_index" (ReqDropIndex t c) okOnly
-
--- | 删一列（列定义、这一列上的索引、每行里的那一格一起没）
-doDropColumn :: Env -> String -> String -> IO (Either String ())
-doDropColumn env t c = ask env "drop_column" (ReqDropColumn t c) okOnly
-
--- | 发 ReplaceSchema（ALTER 用）
-doReplaceSchema :: Env -> String -> [SchemaColumn] -> [Row] -> IO (Either String ())
-doReplaceSchema env t cols rs = ask env "replace_schema" (ReqReplaceSchema t cols rs) okOnly
-
--- | 发 CreateTable
-doCreateTable :: Env -> String -> [SchemaColumn] -> IO (Either String ())
-doCreateTable env t cols = ask env "create_table" (ReqCreateTable t cols) okOnly
-
 -- | 发 DropTable
 doDropTable :: Env -> String -> IO (Either String ())
 doDropTable env t = ask env "drop_table" (ReqDropTable t) okOnly
@@ -312,25 +349,42 @@ toWire (n, c) =
         }
 
 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
+            ready <- guardedRequest env dependencies (ReqValidateWrite target)
+            case ready of
+                RespOk -> runIPCStorageIn (withSchemaGuard dependencies action) env
+                RespError err -> pure (Left err)
+                _ -> pure (Left "unexpected response to validate_write")
+
     -- \| 建一个库
     createDatabase name = IPCStorage $ \env -> ask env "create_database" (ReqDatabase "create_database" name) okOnly
+
     -- \| 删一个库
     dropDatabase name = IPCStorage $ \env -> ask env "drop_database" (ReqDatabase "drop_database" name) okOnly
+
     -- \| 切当前库
     useDatabase name = IPCStorage $ \env -> ask env "use_database" (ReqDatabase "use_database" name) okOnly
+
     -- \| 列出现有库
-    listDatabases = IPCStorage $ \env -> ask env "list_databases" (ReqDatabase "list_databases" "") $ \resp -> case resp of
+    listDatabases = IPCStorage $ \env -> ask env "list_databases" (ReqDatabase "list_databases" "") $ \case
                                                                                                         RespTables names -> Just names
                                                                                                         _ -> Nothing
+
     -- \| 发 Scan
-    scan t = IPCStorage (\env -> doScan env t)
+    scan t = IPCStorage (`doScan` t)
+
     -- \| 只取指定列
     scanColumns t cols = IPCStorage (\env -> doScanColumns env t cols)
 
     -- \| 并行分片数：按 RTS 能力数，封顶在 parallelShardLimit
-    parallelShards = IPCStorage $ \_ -> do
+    parallelShards = IPCStorage $ \_ -> do max 1 . min parallelShardLimit <$> getNumCapabilities
-        caps <- getNumCapabilities
-        pure (max 1 (min parallelShardLimit caps))
 
     -- \| 分片并行扫，再按分片序拼接
     scanShards width t cols
@@ -350,7 +404,7 @@ instance MonadStorage IPCStorage where
     deleteKeys t ks = IPCStorage (\env -> doDeleteKeys env t ks)
 
     -- \| 发 ReplaceAll
-    replaceAll t rs = IPCStorage (\env -> doReplaceAll env t rs)
+    replaceAll t rs = IPCStorage $ \env -> ask env "replace_all" (ReqReplaceAll t rs) okOnly
 
     -- \| 按某一列的索引取一行（没有索引就回 NoIndex）
     lookupByColumn t c k = IPCStorage (\env -> doLookupByColumn env t c k)
@@ -359,45 +413,48 @@ instance MonadStorage IPCStorage where
     scanRange t c lo hi = IPCStorage (\env -> doScanRange env t c lo hi)
 
     -- \| 发 CreateTable
-    createTable name cols = IPCStorage (\env -> doCreateTable env name (map toWire cols))
+    createTable name cols = IPCStorage $ \env -> ask env "create_table" (ReqCreateTable name (map toWire cols)) okOnly
 
     -- \| ALTER：整表换列定义与全部行
-    replaceSchema name cols rows = IPCStorage (\env -> doReplaceSchema env name (map toWire cols) rows)
+    replaceSchema name cols rows = IPCStorage $ \env -> ask env "replace_schema" (ReqReplaceSchema name (map toWire cols) rows) okOnly
 
     -- \| 发 DropTable
-    dropTable name = IPCStorage (\env -> doDropTable env name)
+    dropTable name = IPCStorage (`doDropTable` name)
 
     -- \| 建索引
-    createIndex t c = IPCStorage (\env -> doCreateIndex env t c)
+    createIndex t c = IPCStorage $ \env -> ask env "create_index" (ReqCreateIndex t c) okOnly
 
     -- \| 删索引
-    dropIndex t c = IPCStorage (\env -> doDropIndex env t c)
+    dropIndex t c = IPCStorage $ \env -> ask env "drop_index" (ReqDropIndex t c) okOnly
 
     -- \| 删一列
-    dropColumn t c = IPCStorage (\env -> doDropColumn env t c)
+    dropColumn t c = IPCStorage $ \env -> ask env "drop_column" (ReqDropColumn t c) okOnly
 
     -- \| 列表 + 逐表扫描拼库
     snapshot = IPCStorage $ \env -> do
         result <- doListCatalog env
         case result of
-            Left _ -> pure []
+            Left err -> pure (Left err)
-            Right xs -> mapM (loadEntry env) xs
+            Right xs -> fmap sequence (mapM (loadEntry env) xs)
       where
+        -- \| 读取表数据并保留扫描错误
         loadEntry env info = do
             rows <- doScan env (tiTable info)
-            pure
+            pure $
+                fmap
+                    ( \rs ->
                         ( tiTable info
-                , Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows) (Just (metaOf info))
+                        , Table (tiTable info) (schemaToColumns (tiColumns info)) rs (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info)
                         )
+                    )
+                    rows
 
     -- \| 只问数据字典要结构，设了当前库只留它的表
     schema = IPCStorage $ \env -> do
-        result <- ask env "all_catalogs" ReqAllCatalog $ \resp -> case resp of
+        result <- ask env "all_catalogs" ReqAllCatalog $ \case
                                                            RespCatalog infos -> Just infos
                                                            _ -> Nothing
-        pure $ case result of
+        pure (fmap (concatMap (visibleTables (envDatabase env))) result)
-            Left _ -> []
-            Right xs -> concatMap (visibleTables (envDatabase env)) xs
 
 -- | 线上表信息转引擎侧统计
 metaOf :: TableInfo -> TableMeta
@@ -407,11 +464,9 @@ metaOf info = TableMeta (tiRows info) (tiStats info) (tiHistograms info) (tiInde
 visibleTables :: Maybe String -> TableInfo -> [(String, Table)]
 visibleTables current info
     | Just db <- current =
-        if unqualify (Just db) (tiTable info) /= tiTable info
+        [bare named | unqualify (Just db) (tiTable info) /= tiTable info]
-            then [bare named]
-            else []
     | otherwise = [bare info]
   where
-    named = info {tiTable = unqualify current (tiTable info)}
+    named = info{tiTable = unqualify current (tiTable info)}
-    -- | 组装成不带行的表
+    -- \| 组装成不带行的表
-    bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [] (Just (metaOf i)))
+    bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [] (Just (metaOf i)) (tiIdentity i) (tiSchemaVersion i))

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

@@ -1,8 +1,9 @@
 module ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage)) where
 
-import ChuSQL.Core.Model
 import ChuSQL.Core.Engine.Storage
-import qualified Data.HashSet as HS
+import ChuSQL.Core.Model
+import Data.HashSet qualified as HS
+import Data.Word (Word64)
 
 -- 内存实现：Database 上的状态，错误通道是 Either String。
 
@@ -26,6 +27,12 @@ instance Monad MemoryStorage where
         runMemoryStorage (k a) db'
 
 instance MonadStorage MemoryStorage where
+    -- \| 纯状态视图在求值期间不受外部修改
+    withSchemaGuard _ action = action
+
+    -- | 纯状态写入不受外部结构变更影响
+    withWriteSchemaGuard _ action = action
+
     -- \| 全表扫描
     scan t = MemoryStorage $ \db -> do
         tbl <- lookupTable db t
@@ -45,7 +52,7 @@ instance MonadStorage MemoryStorage where
     createTable name cols = MemoryStorage $ \db ->
         if any ((== name) . fst) db
             then Right (Left ("table already exists: " ++ name), db)
-            else Right (Right (), db ++ [(name, Table name cols [] Nothing)])
+            else Right (Right (), db ++ [(name, Table name cols [] Nothing Nothing (Just 1))])
 
     -- \| 删表；不存在报错
     dropTable name = MemoryStorage $ \db ->
@@ -60,7 +67,8 @@ instance MonadStorage MemoryStorage where
             Just tbl ->
                 if col `notElem` map fst (tableCols tbl)
                     then Right (Left ("unknown column: " ++ col), db)
-                    else
+                    else do
+                        version <- nextSchemaVersion tbl
                         Right
                             ( Right ()
                             , replaceTable
@@ -68,19 +76,20 @@ instance MonadStorage MemoryStorage where
                                 tbl
                                     { tableCols = filter ((/= col) . fst) (tableCols tbl)
                                     , tableRows = map (filter ((/= col) . fst)) (tableRows tbl)
+                                    , tableSchemaVersion = Just version
                                     }
                                 db
                             )
 
     -- \| 原样返回当前库
-    snapshot = MemoryStorage $ \db -> Right (db, db)
+    snapshot = MemoryStorage $ \db -> Right (Right db, db)
 
     -- \| 返回实时行数与去重统计的无数据结构
-    schema = MemoryStorage $ \db -> Right (map describe db, db)
+    schema = MemoryStorage $ \db -> Right (Right (map describe db), db)
       where
-        -- | 将存储数据汇总为结构统计
+        -- \| 将存储数据汇总为结构统计
         describe (name, table) =
-            (name, table {tableRows = [], tableMeta = Just metadata})
+            (name, table{tableRows = [], tableMeta = Just metadata})
           where
             metadata = TableMeta (length (tableRows table)) distinct [] []
             distinct = [columnStatistics column (tableRows table) | (column, _) <- tableCols table]
@@ -88,13 +97,25 @@ instance MonadStorage MemoryStorage where
     -- \| 改表结构：列定义与行一起换
     replaceSchema name cols rows = MemoryStorage $ \db -> case lookup name db of
         Nothing -> Right (Left ("unknown table: " ++ name), db)
-        Just tbl -> Right (Right (), replaceTable name tbl{tableCols = cols, tableRows = rows} db)
+        Just tbl -> do
+            version <-
+                if tableCols tbl == cols
+                    then Right (tableSchemaVersion tbl)
+                    else Just <$> nextSchemaVersion tbl
+            Right (Right (), replaceTable name tbl{tableCols = cols, tableRows = rows, tableSchemaVersion = version} db)
+
+-- | 递增结构版本并拒绝耗尽
+nextSchemaVersion :: Table -> Either String Word64
+nextSchemaVersion table = case tableSchemaVersion table of
+    Just version | version == maxBound -> Left "catalog schema version exhausted"
+    Just version -> Right (version + 1)
+    Nothing -> Right 1
 
 -- | 对列值去重并限制统计内存
 columnStatistics :: String -> [Row] -> (String, Int, Bool)
 columnStatistics column rows = go rows HS.empty
   where
-    -- | 累积规范化值，达到上限后停止
+    -- \| 累积规范化值，达到上限后停止
     go remaining values
         | HS.size values >= 4096 = (column, 4096, True)
         | otherwise = case remaining of
@@ -105,4 +126,3 @@ columnStatistics column rows = go rows HS.empty
 replaceTable :: String -> Table -> Database -> Database
 replaceTable name table =
     map (\(n, t) -> if n == name then (n, table) else (n, t))
-

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

@@ -1,26 +1,23 @@
-module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), makeSelect) where
+module ChuSQL.Core.Engine.Syntax.AST (Statement (..), 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)
 
 -- 语法树：语句、数据来源、条件表达式、排序方向。
 
 data Statement
     = Select
-        { selectCols :: [String]
+        -- | 输出名称与投影表达式，普通列用 Col
-        , selectFrom :: FromClause
-        , selectWhere :: Maybe Expr
-        , selectGroupBy :: [String]
-        , selectOrderBy :: [(String, SortDir)]
-        , selectLimit :: Maybe Int
-        }
-    | SelectExpr
         { selectItems :: [(String, Expr)]
         , selectFrom :: FromClause
         , selectWhere :: Maybe Expr
         , selectGroupBy :: [String]
-        , selectOrderBy :: [(String, SortDir)]
+        , selectHaving :: Maybe Expr
+        , selectOrderBy :: [(OrderKey, SortDir)]
         , selectLimit :: Maybe Int
         }
+    | SelectDistinct Statement
     | Insert String [String] [[Expr]]
     | Delete String (Maybe Expr)
     | Update String [(String, Expr)] (Maybe Expr)
@@ -40,6 +37,7 @@ data Statement
     | CreateUser String String
     | AlterUser String String
     | AlterIdentity String [(String, Bool)]
+    | ShowGrants
     | ShowRoles
     | DropUser String
     -- | 新角色：权限的载体，用户靠成员资格继承它的权限
@@ -50,6 +48,7 @@ data Statement
     | GrantPrivileges [String] String String Bool
     -- | REVOKE 权限 ON 表 FROM 角色
     | RevokePrivileges [String] String String
+    | RevokeGrantOption [String] String String
     -- | GRANT 角色 TO 用户：给用户加角色
     | GrantRole String [String]
     -- | REVOKE <角色> FROM <用户>[, ...]
@@ -91,6 +90,11 @@ data Subquery = Subquery
     { subqueryStatement :: Statement
     , subqueryRefs :: [String]
     }
+    | BoundSubquery
+    { subqueryStatement :: Statement
+    , subqueryRefs :: [String]
+    , subquerySlots :: [(String, Expr)]
+    }
     deriving (Show, Eq)
 
 -- | 量词：ANY 至少一行成立，ALL 每一行都成立
@@ -112,6 +116,13 @@ data CompareOp
 -- | 条件表达式：列、字面量、算术、比较、逻辑、聚合与子查询
 data Expr
     = Col String
+    | ColumnSlot Int String
+    | OuterColumnSlot Int Int String
+    | FunctionCall String [Expr]
+    | BoundFunction FunctionId TypeId [Expr]
+    | Construct TypeExpr [Expr]
+    | BoundConstruct TypeId [Expr]
+    | RuntimeLiteral TypeId RuntimeValue
     | LitNull
     | LitInt Int
     | LitFloat Double
@@ -154,14 +165,72 @@ data SortDir
     | Desc
     deriving (Show, Eq)
 
+-- | 区分排序列、输出序号与来源表达式
+data OrderKey = OrderColumn String | OrderPosition Int | OrderExpression Expr
+    deriving (Show, Eq)
+
 -- | 造一个最简单的 SELECT
 makeSelect :: [String] -> String -> Maybe Expr -> Statement
 makeSelect cols tbl w =
     Select
-        { selectCols = cols
+        { selectItems = [(c, Col c) | c <- cols]
         , selectFrom = FromTable Nothing tbl
         , selectWhere = w
         , selectGroupBy = []
+        , selectHaving = Nothing
         , selectOrderBy = []
         , selectLimit = Nothing
         }
+
+-- | 将去重排序映射到输出列
+distinctOrdering :: Statement -> Either String [(OrderKey, SortDir)]
+distinctOrdering q@Select{} = resolveDistinctOrdering q
+distinctOrdering _ = Left "DISTINCT requires SELECT"
+
+-- | 校验排序序号并返回从零开始的位置
+orderPosition :: Int -> OrderKey -> Either String (Maybe Int)
+orderPosition width (OrderPosition position)
+    | position > 0, position <= width = Right (Just (position - 1))
+    | otherwise = Left "ORDER BY: position is outside the select list"
+orderPosition _ _ = Right Nothing
+
+-- | 按序号、唯一别名或来源列解析排序表达式
+orderExpression :: [(String, Expr)] -> OrderKey -> Either String Expr
+orderExpression _ (OrderExpression expression) = Right expression
+orderExpression items key@(OrderPosition _) = do
+    position <- orderPosition (length items) key
+    case position of
+        Just slot -> Right (snd (items !! slot))
+        Nothing -> Left "ORDER BY: missing output position"
+orderExpression items (OrderColumn column) = case [expression | (label, expression) <- items, label == column] of
+    [] -> Right (Col column)
+    [expression] -> Right expression
+    expressions | all (== Col column) expressions -> Right (Col column)
+    _ -> Left ("ORDER BY: ambiguous projection alias: " ++ column)
+
+-- | 收集原始排序键中可能含子查询的表达式
+orderKeyExpression :: OrderKey -> Maybe Expr
+orderKeyExpression (OrderColumn column) = Just (Col column)
+orderKeyExpression (OrderExpression expression) = Just expression
+orderKeyExpression (OrderPosition _) = Nothing
+
+-- | 解析去重输出的排序列
+resolveDistinctOrdering :: Statement -> Either String [(OrderKey, SortDir)]
+resolveDistinctOrdering q = mapM resolve (selectOrderBy q)
+  where
+    items = case q of
+        Select { selectItems = projected } -> projected
+        _ -> []
+    -- | 排序键必须出现在去重结果中
+    resolve (key, direction) = do
+        position <- orderPosition (length items) key
+        case position of
+            Just _ -> Right (key, direction)
+            Nothing -> case [slot | (slot, (label, expression)) <- zip [1 ..] items, matches key label expression] of
+                [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,10 +1,13 @@
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 
 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 Control.Monad (void)
 import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
 import Data.Char (isAlpha, isAlphaNum, isHexDigit, isSpace, toLower, toUpper)
@@ -167,6 +170,8 @@ atom =
         , LitInt <$> integer
         , LitStr <$> stringLit
         , try aggregateCall
+        , try constructorCall
+        , try scalarFunctionCall
         , try existsPredicate
         , Col <$> qualifiedName
         , try scalarSubquery
@@ -202,6 +207,33 @@ inPredicate = do
 subquerySelect :: Parser Subquery
 subquerySelect = Subquery <$> queryStatement <*> pure []
 
+-- | 读取带具体类型参数的构造器
+constructorCall :: Parser Expr
+constructorCall = do
+    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 ","))
+    pure (Construct (TypeApply cid arguments) values)
+
+-- | 解析运行时逻辑类型语法
+runtimeTypeP :: Parser TypeExpr
+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)
+    , tupleType <$> between (symbol "(") (symbol ")") (sepBy runtimeTypeP (symbol ","))
+    ]
+
+-- | 读取待绑定的标量函数调用
+scalarFunctionCall :: Parser Expr
+scalarFunctionCall = do
+    name <- identifier
+    arguments <- between (symbol "(") (symbol ")") (sepBy expr (symbol ","))
+    pure (FunctionCall name arguments)
+
 -- | 聚合调用：名称与节点都由内置函数表给出
 aggregateCall :: Parser Expr
 aggregateCall = choice (countAll : map named builtinNames)
@@ -229,15 +261,19 @@ literalValue =
     -- | 负浮点字面量
     negateLit d = VFloat (negate d)
 
--- | 一个排序列
+-- | 一个排序键：输出序号、列名或表达式
-orderItem :: Parser (String, SortDir)
+orderItem :: Parser (OrderKey, SortDir)
 orderItem = do
-    col <- qualifiedName
+    expression <- expr
     dir <- sortDir
-    return (col, dir)
+    let key = case expression of
+            LitInt position -> OrderPosition position
+            Col column -> OrderColumn column
+            _ -> OrderExpression expression
+    return (key, dir)
 
 -- | ORDER BY 的列表
-orderByClause :: Parser [(String, SortDir)]
+orderByClause :: Parser [(OrderKey, SortDir)]
 orderByClause = do
     keyword "order"
     keyword "by"
@@ -307,6 +343,7 @@ reservedWords =
     , "auto_increment"
     , "type"
     , "group"
+    , "having"
     , "with"
     , "any"
     , "all"
@@ -328,9 +365,10 @@ tableRef = do
 -- | 连接类型：内连接 / 左外连接
 joinKind :: Parser JoinKind
 joinKind =
-    try (keyword "left" *> optional (keyword "outer") *> keyword "join" *> return LeftJoin)
+    try ((keyword "left" *> optional (keyword "outer") *> keyword "join")
-        <|> try (keyword "inner" *> keyword "join" *> return InnerJoin)
+           $> LeftJoin)
-        <|> (keyword "join" *> return InnerJoin)
+        <|> try ((keyword "inner" *> keyword "join") $> InnerJoin)
+        <|> (keyword "join" $> InnerJoin)
 
 -- | FROM 里的一个来源：表或派生表
 fromSource :: Parser FromClause
@@ -392,11 +430,9 @@ createTableStatement = do
 
 -- | 读 DROP TABLE
 dropTableStatement :: Parser Statement
-dropTableStatement = do
+dropTableStatement = do keyword "drop"
-    keyword "drop"
                         keyword "table"
-    name <- tableName
+                        DropTable <$> tableName
-    return (DropTable name)
 
 -- | 读 CREATE INDEX（列名即索引名）
 createIndexStatement :: Parser Statement
@@ -455,12 +491,10 @@ alterTableStatement = do
 
 -- | 读 CREATE USER，口令是明文
 createUserStatement :: Parser Statement
-createUserStatement = do
+createUserStatement = do keyword "create"
-    keyword "create"
                          keyword "user"
                          name <- userName
-    pw <- identifiedBy
+                         CreateUser name <$> identifiedBy
-    return (CreateUser name pw)
 
 -- | 读 IDENTIFIED BY '口令'
 identifiedBy :: Parser String
@@ -480,7 +514,9 @@ alterUserStatement = do
 -- | 读身份属性开关
 identityAttribute :: Parser (String, Bool)
 identityAttribute = choice
-    [ ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
+    [ ("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"
@@ -497,11 +533,9 @@ alterRoleStatement = do
 
 -- | 读 DROP USER
 dropUserStatement :: Parser Statement
-dropUserStatement = do
+dropUserStatement = do keyword "drop"
-    keyword "drop"
                        keyword "user"
-    name <- userName
+                       DropUser <$> userName
-    return (DropUser name)
 
 -- | 读 CREATE ROLE
 createRoleStatement :: Parser Statement
@@ -525,12 +559,16 @@ privilegeName =
         , "INSERT" <$ keyword "insert"
         , "UPDATE" <$ keyword "update"
         , "DELETE" <$ keyword "delete"
+        , "CONNECT" <$ keyword "connect"
+        , "CREATE" <$ keyword "create"
         , "ALL" <$ keyword "all"
         ]
 
 -- | ON 后面的授权对象：* 或一张表
 grantObject :: Parser String
-grantObject = ("*" <$ symbol "*") <|> tableName
+grantObject = try (("database:" ++) <$> (keyword "database" *> identifier))
+    <|> try ((++ ".*") <$> (identifier <* symbol "." <* symbol "*"))
+    <|> ("*" <$ symbol "*") <|> (optional (keyword "table") *> tableName)
 
 -- | 可选的 WITH GRANT OPTION
 grantOption :: Parser Bool
@@ -554,14 +592,15 @@ grantStatement = do
 revokeStatement :: Parser Statement
 revokeStatement = do
     keyword "revoke"
+    optionOnly <- fromMaybe False <$> optional (True <$ (keyword "grant" *> keyword "option" *> keyword "for"))
     choice
         [ try $ do
             privs <- sepBy1 privilegeName (symbol ",")
             keyword "on"
             obj <- grantObject
             keyword "from"
-            RevokePrivileges privs obj <$> userName
+            (if optionOnly then RevokeGrantOption else RevokePrivileges) privs obj <$> userName
-        , RevokeRole <$> userName <*> (keyword "from" *> sepBy1 userName (symbol ","))
+        , if optionOnly then fail "GRANT OPTION FOR requires object privileges" else RevokeRole <$> userName <*> (keyword "from" *> sepBy1 userName (symbol ","))
         ]
 
 -- | 建表时的一列：类型后面跟若干约束
@@ -576,11 +615,18 @@ columnDef = do
 columnConstraint :: Parser (Column -> Column)
 columnConstraint =
     choice
-        [ try (keyword "not" *> keyword "null" *> pure (\c -> c{columnNullable = False}))
+        [ try ((keyword "not" *> keyword "null")
-        , keyword "null" *> pure (\c -> c{columnNullable = True})
+                 $> (\ c -> c {columnNullable = False}))
-        , keyword "auto_increment" *> pure (\c -> c{columnAutoIncrement = True, columnNullable = False})
+        , keyword "null" $> (\ c -> c {columnNullable = True})
-        , try (keyword "primary" *> keyword "key" *> pure (\c -> c{columnPrimaryKey = True, columnUnique = True, columnNullable = False}))
+        , keyword "auto_increment"
-        , keyword "unique" *> pure (\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)
         ]
@@ -597,28 +643,43 @@ sizeParen = try (between (symbol "(") (symbol ")") integer)
 columnTypeP :: Parser ColumnType
 columnTypeP =
     choice
-        [ keyword "integer" >> pure CInt
+        [ try runtimeColumnType
+        , keyword "integer" >> pure CInt
         , keyword "int" >> pure CInt
         , keyword "bigint" >> pure CBigInt
         , keyword "smallint" >> pure CSmallInt
-        , (keyword "varchar" >>) (maybe CStr CVarchar <$> optional sizeParen)
+        , keyword "varchar" >> (maybe CStr CVarchar <$> optional sizeParen)
-        , (keyword "char" >>) (maybe (CChar 1) CChar <$> optional sizeParen)
+        , keyword "char" >> (maybe (CChar 1) CChar <$> optional sizeParen)
         , keyword "text" >> pure CStr
         , keyword "str" >> pure CStr
         , keyword "boolean" >> pure CBool
         , keyword "bool" >> pure CBool
         , keyword "float" >> pure CFloat
         , keyword "real" >> pure CFloat
-        , try (keyword "double" *> keyword "precision" *> pure CDouble)
+        , try ((keyword "double" *> keyword "precision") $> CDouble)
         , keyword "double" >> pure CDouble
-        , (keyword "decimal" >>) decimalType
+        , keyword "decimal" >> decimalType
-        , (keyword "numeric" >>) decimalType
+        , keyword "numeric" >> decimalType
         , keyword "date" >> pure CDate
         , keyword "timestamp" >> pure CTimestamp
         , keyword "blob" >> pure CBlob
         , (\name -> CDomain (map toLower name) CStr) <$> identifier
         ]
 
+-- | 解析复合列的稳定类型身份
+runtimeColumnType :: Parser ColumnType
+runtimeColumnType = do
+    expression <- choice
+        [ listType <$> between (symbol "[") (symbol "]") runtimeTypeP
+        , listType <$> (keyword "list" *> runtimeTypeP)
+        , maybeType <$> (keyword "maybe" *> runtimeTypeP)
+        , tupleType <$> between (symbol "(") (symbol ")") (sepBy runtimeTypeP (symbol ","))
+        , stringType <$ keyword "string"
+        ]
+    case resolveType builtinTypes expression of
+        Left err -> fail err
+        Right descriptor -> pure (CRuntime (descriptorId descriptor))
+
 -- | DECIMAL 的精度与小数位
 decimalType :: Parser ColumnType
 decimalType = do
@@ -638,15 +699,15 @@ decimalArgs = do
 selectStatement :: Parser Statement
 selectStatement = do
     keyword "select"
+    distinct <- fromMaybe False <$> optional ((True <$ keyword "distinct") <|> (False <$ keyword "all"))
     cols <- selectList
     fromC <- fromMaybe FromUnit <$> optional (keyword "from" *> fromClause)
     mWhere <- optional (keyword "where" *> expr)
     groupBy <- fromMaybe [] <$> optional groupByClause
+    having <- optional (keyword "having" *> expr)
     orderBy <- fromMaybe [] <$> optional orderByClause
     mLimit <- optional limitClause
-    pure $ if all (\(name, e) -> e == Col name) cols
+    pure $ (if distinct then SelectDistinct else id) (Select cols fromC mWhere groupBy having orderBy mLimit)
-        then Select (map fst cols) fromC mWhere groupBy orderBy mLimit
-        else SelectExpr cols fromC mWhere groupBy orderBy mLimit
 
 -- | 读 WITH：展开每个 CTE 再读主查询
 withStatement :: Parser Statement
@@ -687,27 +748,20 @@ cteKey = map toLower
 -- | CTE 带列清单时改本体的输出名
 renameColumns :: String -> [String] -> Statement -> Either String Statement
 renameColumns _ [] q = Right q
-renameColumns name cols q@Select { selectCols = names } = do
+renameColumns name cols (SelectDistinct q) = SelectDistinct <$> renameColumns name cols q
-    checkCteArity name cols names
+renameColumns name cols q@Select { selectItems = items } = do
-    Right
-        ( SelectExpr
-            [(c, Col n) | (c, n) <- zip cols names]
-            (selectFrom q)
-            (selectWhere q)
-            (selectGroupBy q)
-            (selectOrderBy q)
-            (selectLimit q)
-        )
-renameColumns name cols q@SelectExpr { selectItems = items } = do
     checkCteArity name cols (map snd items)
-    ordering <- mapM renameOrder (selectOrderBy q)
+    ordering <- if all (\(label, expression) -> expression == Col label) items
+        then Right (selectOrderBy q)
+        else mapM renameOrder (selectOrderBy q)
     Right q { selectItems = zip cols (map snd items), selectOrderBy = ordering }
   where
     -- | 列清单同步改写内层排序输出别名
-    renameOrder (column, direction) = case [new | ((old, _), new) <- zip items cols, old == column] of
+    renameOrder (OrderColumn column, direction) = case [new | ((old, _), new) <- zip items cols, old == column] of
-        [] -> Right (column, direction)
+        [] -> Right (OrderColumn column, direction)
-        [new] -> Right (new, direction)
+        [new] -> Right (OrderColumn new, direction)
         _ -> Left ("WITH: ambiguous ORDER BY alias: " ++ column)
+    renameOrder ordering = Right ordering
 renameColumns _ _ _ = Left "WITH: a CTE must be a SELECT"
 
 -- | 列清单个数必须和本体输出一致
@@ -719,16 +773,19 @@ checkCteArity name cols out
 -- | 把语句里对 CTE 的引用换成派生表
 expandStatement :: [(String, Statement)] -> Statement -> Either String Statement
 expandStatement env stmt = case stmt of
-    q@Select { selectFrom = fromC, selectWhere = mWhere } -> do
+    SelectDistinct q -> SelectDistinct <$> expandStatement env q
+    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
-        Right q { selectFrom = fromC', selectWhere = w }
+        having <- traverse (expandExpr env) (selectHaving q)
-    q@SelectExpr { selectFrom = fromC, selectItems = items, selectWhere = mWhere } -> do
+        ordering <- mapM expandOrder (selectOrderBy q)
-        fromC' <- expandClause env fromC
+        Right q { selectFrom = fromC', selectItems = items', selectWhere = w, selectHaving = having, selectOrderBy = ordering }
-        items' <- traverse (\(name, e) -> fmap ((,) name) (expandExpr env e)) items
-        w <- traverse (expandExpr env) mWhere
-        Right q { selectFrom = fromC', selectItems = items', selectWhere = w }
     _ -> Right stmt
+  where
+    -- | 展开排序表达式中的 CTE 子查询
+    expandOrder (OrderExpression expression, direction) = (,) . OrderExpression <$> expandExpr env expression <*> pure direction
+    expandOrder ordering = Right ordering
 
 -- | 来源树里的 CTE 引用换成派生表
 expandClause :: [(String, Statement)] -> FromClause -> Either String FromClause
@@ -744,6 +801,10 @@ expandClause env fromC = case fromC of
 -- | 表达式里的子查询也要展开
 expandExpr :: [(String, Statement)] -> Expr -> Either String Expr
 expandExpr env e = case e of
+    Construct tid arguments -> Construct tid <$> mapM go arguments
+    BoundConstruct tid arguments -> BoundConstruct tid <$> mapM go arguments
+    FunctionCall name arguments -> FunctionCall name <$> mapM go arguments
+    BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM go arguments
     Add a b -> Add <$> go a <*> go b
     Sub a b -> Sub <$> go a <*> go b
     Mul a b -> Mul <$> go a <*> go b
@@ -767,7 +828,7 @@ expandExpr env e = case e of
     ScalarSub sq -> ScalarSub <$> goSub sq
     InSub x sq neg -> (\x' sq' -> InSub x' sq' neg) <$> go x <*> goSub sq
     InList x es neg -> (\x' es' -> InList x' es' neg) <$> go x <*> traverse go es
-    ExistsSub sq neg -> (\sq' -> ExistsSub sq' neg) <$> goSub sq
+    ExistsSub sq neg -> (`ExistsSub` neg) <$> goSub sq
     QuantCmp op x sq q -> (\x' sq' -> QuantCmp op x' sq' q) <$> go x <*> goSub sq
     _ -> Right e
   where
@@ -854,6 +915,7 @@ parseStatement input =
             <|> try createUserStatement
             <|> try alterUserStatement
             <|> try alterRoleStatement
+            <|> try (ShowGrants <$ (keyword "show" *> keyword "grants"))
             <|> try (ShowRoles <$ (keyword "show" *> keyword "roles"))
             <|> try dropUserStatement
             <|> try createRoleStatement

chusql-core/engine/test/NormalizationSpec.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module NormalizationSpec (spec) where
+
+import ChuSQL.Core.Engine.Normalization
+import ChuSQL.Core.Model (pattern TInt)
+import Test.Hspec
+
+-- 范式分析回归：公理闭包、候选键、信息不足与分解性质。
+
+-- 执行范式检查回归。
+spec :: Spec
+spec = do
+    describe "Armstrong normalization" $ do
+        it "computes reflexivity, augmentation and transitivity" $ do
+            attributeClosure [Dependency ["a"] ["b"], Dependency ["b"] ["c"]] ["a"]
+                `shouldBe` ["a", "b", "c"]
+            implies [Dependency ["a"] ["b"]] (Dependency ["a", "c"] ["b", "c"])
+                `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)))
+                `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)))
+                `shouldBe` Right [Satisfied, Violated, Violated, Violated]
+        it "detects transitive dependencies and a preserving split" $ do
+            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
+                    (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)))
+                `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)
+        it "propagates a declared 1NF violation" $ do
+            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))
+                `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 [[]]
+        it "rejects excessive exhaustive searches" $ do
+            analyzeNormalization [(show n, TInt) | n <- [1 :: Int .. 13]]
+                (Declaration [] [] True (Just True))
+                `shouldBe` Left "normalization: exhaustive analysis supports at most 12 columns"
+  where
+    schema = [("a", TInt), ("b", TInt), ("c", TInt)]

chusql-core/engine/test/RuntimeSpec.hs

@@ -0,0 +1,870 @@
+module RuntimeSpec (spec) where
+
+import ChuSQL.Core.Engine.Runtime.Types
+import ChuSQL.Core.Engine.Runtime.Functions
+import ChuSQL.Core.Engine.Runtime.Binding
+import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns, bindWriteColumns)
+import qualified ChuSQL.Core.Engine.Algebra.Op as Rel
+import ChuSQL.Core.Engine.Algebra.Expr (evalExpr, subquerySlotsIn)
+import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp)
+import ChuSQL.Core.Engine.Algebra.Sort (sortBoundRows)
+import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage)
+import qualified ChuSQL.Core.Engine.Runtime.Query as Query
+import ChuSQL.Core.Engine (rowsOf, runStatement, runStatementM, bindWrite, executeWriteM)
+import ChuSQL.Core.Engine.Semantic (prepare, prepareRowExpression)
+import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
+import ChuSQL.Core.Engine.Syntax.AST (Expr (..), Statement (..), Subquery (..), FromClause (..), SortDir (..))
+import qualified ChuSQL.Core.Model as SQL
+import ChuSQL.Core.Protocol (valueToJSON, valueFromJSON, TableInfo (..))
+import qualified Data.Aeson as A
+import Data.Word (Word64)
+import Data.Aeson.Types (parseEither)
+import Data.Hashable (hash)
+import Control.Monad (foldM)
+import qualified Data.ByteString.Lazy.Char8 as BS
+import Data.List (isInfixOf)
+import Data.Bifunctor (second)
+import Test.Hspec
+
+-- 运行时类型、函数绑定、物理编码和类型化查询测试。
+
+-- | 执行语句建立测试目录
+sqlCatalog :: [String] -> Either String SQL.Database
+sqlCatalog = foldM apply []
+  where
+    -- | 更新当前测试数据库
+    apply db source = do
+        statement <- parseStatement source
+        fst <$> runStatement db statement
+
+-- | 检查运行时类型基础契约
+spec :: Spec
+spec = do
+    describe "bound write plans" $ do
+        it "reuses INSERT targets and constraints while refreshing the auto counter" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN cached_quantity AS INT"
+                        , "CREATE TABLE cached_insert (id INT AUTO_INCREMENT PRIMARY KEY, qty cached_quantity DEFAULT 2, tag TEXT CHECK (length(tag) > 1))"]
+                    statement <- parseStatement "INSERT INTO cached_insert (tag) VALUES ('abc')"
+                    bound <- bindWrite db statement
+                    (first, inserted) <- runMemoryStorage (executeWriteM bound) db
+                    first
+                    let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- inserted]
+                    (secondResult, final) <- runMemoryStorage (executeWriteM bound) reversed
+                    secondResult
+                    select <- parseStatement "SELECT id, qty, tag FROM cached_insert"
+                    map (map snd) <$> rowsOf (runStatement final select)
+            result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 2, SQL.VStr "abc"], [SQL.VInt 2, SQL.VInt 2, SQL.VStr "abc"]]
+        it "reuses ordered UPDATE targets and final-row uniqueness checks" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE cached_update (id INT PRIMARY KEY, qty INT NOT NULL UNIQUE CHECK (qty < 10))"
+                        , "INSERT INTO cached_update (id, qty) VALUES (1, 1), (2, 8)"]
+                    statement <- parseStatement "UPDATE cached_update SET qty = qty + 1, qty = qty + id WHERE id = 1"
+                    bound <- bindWrite db statement
+                    duplicate <- parseStatement "UPDATE cached_update SET qty = 8 WHERE id = 1" >>= bindWrite db
+                    (first, updated) <- runMemoryStorage (executeWriteM bound) db
+                    first
+                    (secondResult, twice) <- runMemoryStorage (executeWriteM bound) updated
+                    secondResult
+                    (rejected, unchanged) <- runMemoryStorage (executeWriteM duplicate) twice
+                    Right (SQL.tableRows <$> lookup "cached_update" twice, rejected
+                        , SQL.tableRows <$> lookup "cached_update" unchanged)
+                rows = Just [[("id", SQL.VInt 1), ("qty", SQL.VInt 5)], [("id", SQL.VInt 2), ("qty", SQL.VInt 8)]]
+            result `shouldBe` Right (rows, Left "UNIQUE: duplicate value in column qty", rows)
+        it "defers assignment errors until a reused plan matches a current row" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE deferred_write (id INT, qty INT CHECK (qty > 0))"]
+                    statement <- parseStatement "UPDATE deferred_write SET qty = 1 / 0 WHERE id = 9"
+                    bound <- bindWrite db statement
+                    (empty, initial) <- runMemoryStorage (executeWriteM bound) db
+                    empty
+                    inserted <- parseStatement "INSERT INTO deferred_write (id, qty) VALUES (9, 5)" >>= runStatement initial
+                    (rejected, final) <- runMemoryStorage (executeWriteM bound) (fst inserted)
+                    Right (rejected, SQL.tableRows <$> lookup "deferred_write" final)
+            result `shouldBe` Right (Left "division by zero", Just [[("id", SQL.VInt 9), ("qty", SQL.VInt 5)]])
+        it "rejects stale INSERT UPDATE and DELETE plans before changing rows" $ do
+            mapM_ (\source -> do
+                let result = do
+                        db <- sqlCatalog ["CREATE TABLE saved_write (id INT, qty INT)", "INSERT INTO saved_write (id, qty) VALUES (1, 5)"]
+                        statement <- parseStatement source
+                        bound <- bindWrite db statement
+                        added <- parseStatement "ALTER TABLE saved_write ADD COLUMN extra TEXT" >>= runStatement db
+                        restored <- parseStatement "ALTER TABLE saved_write DROP COLUMN extra" >>= runStatement (fst added)
+                        (rejected, final) <- runMemoryStorage (executeWriteM bound) (fst restored)
+                        Right (rejected, SQL.tableRows <$> lookup "saved_write" final)
+                result `shouldBe` Right (Left "bound query schema changed: saved_write", Just [[("id", SQL.VInt 1), ("qty", SQL.VInt 5)]]))
+                [ "INSERT INTO saved_write (id, qty) VALUES (2, 8)"
+                , "UPDATE saved_write SET qty = qty + 1"
+                , "DELETE FROM saved_write WHERE id = 1"
+                ]
+        it "reuses a write plan across data and unrelated schema changes" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE reusable_write (id INT, qty INT)", "CREATE TABLE unrelated_write (id INT)", "INSERT INTO reusable_write (id, qty) VALUES (1, 5)"]
+                    statement <- parseStatement "UPDATE reusable_write SET qty = qty + 1 WHERE id = 1"
+                    bound <- bindWrite db statement
+                    changed <- parseStatement "INSERT INTO reusable_write (id, qty) VALUES (2, 9)" >>= runStatement db
+                    unrelated <- parseStatement "ALTER TABLE unrelated_write ADD COLUMN extra TEXT" >>= runStatement (fst changed)
+                    (first, updated) <- runMemoryStorage (executeWriteM bound) (fst unrelated)
+                    first
+                    (secondResult, final) <- runMemoryStorage (executeWriteM bound) updated
+                    secondResult
+                    Right (SQL.tableRows <$> lookup "reusable_write" final)
+            result `shouldBe` Right (Just [[("id", SQL.VInt 1), ("qty", SQL.VInt 7)], [("id", SQL.VInt 2), ("qty", SQL.VInt 9)]])
+        it "rejects replaced targets and changed subquery or DOMAIN dependencies" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN quantity AS INT", "CREATE TABLE dependent_write (id quantity)", "CREATE TABLE source_write (id INT)"]
+                    statement <- parseStatement "UPDATE dependent_write SET id = (SELECT MAX(id) FROM source_write)"
+                    let identified = [(name, table {SQL.tableIdentity = Just (SQL.TableIdentity 1 1)}) | (name, table) <- db]
+                    bound <- bindWrite identified statement
+                    let replaced = [(name, if name == "dependent_write" then table {SQL.tableIdentity = Just (SQL.TableIdentity 1 2)} else table) | (name, table) <- identified]
+                        domainChanged = [(name, if name == SQL.domainTableName "quantity" then table {SQL.tableSchemaVersion = Just 2} else table) | (name, table) <- identified]
+                    changed <- parseStatement "ALTER TABLE source_write ADD COLUMN extra TEXT" >>= runStatement identified
+                    target <- fst <$> runMemoryStorage (executeWriteM bound) replaced
+                    dependency <- fst <$> runMemoryStorage (executeWriteM bound) (fst changed)
+                    domain <- fst <$> runMemoryStorage (executeWriteM bound) domainChanged
+                    Right (target, dependency, domain)
+            result `shouldBe` Right (Left "bound query object changed: dependent_write", Left "bound query schema changed: source_write", Left "bound query schema changed: __system_domain_quantity")
+    describe "runtime type registry" $ do
+        it "keeps a fixed identity encoding across releases" $ withType (listType intType) $ \tid ->
+            encodeType tid `shouldBe` BS.pack "[1,[5,[[1,[]]]]]"
+        it "parses nested Haskell-style type expressions" $
+            parseTypeExpr "(Int, [Maybe String])" `shouldBe` Right (tupleType [intType, listType (maybeType stringType)])
+        it "rejects constructor names without a token boundary" $
+            parseTypeExpr "MaybeInt" `shouldSatisfy` isFailure
+        it "restores stable nested identities from bootstrap metadata" $ do
+            let ty = tupleType [listType intType, maybeType stringType]
+            fmap descriptorPhysical (resolveType builtinTypes ty)
+                `shouldBe` Right (Product [Sequence SignedInteger, Optional Utf8])
+        it "distinguishes logical String from List Int" $
+            fmap descriptorId (resolveType builtinTypes stringType)
+                `shouldNotBe` fmap descriptorId (resolveType builtinTypes (listType intType))
+        it "rejects unknown constructors" $
+            resolveType builtinTypes (TypeApply (TypeConstructorId 99) []) `shouldSatisfy` isFailure
+        it "rejects unapplied List" $
+            resolveType builtinTypes (TypeApply (TypeConstructorId 5) []) `shouldSatisfy` isFailure
+        it "rejects arguments to Int" $
+            resolveType builtinTypes (TypeApply (TypeConstructorId 1) [intType]) `shouldSatisfy` isFailure
+    describe "bound write expressions" $ do
+        it "rejects missing existing key columns instead of skipping uniqueness checks" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE constraint_slots (id INT PRIMARY KEY, qty INT UNIQUE)"]
+                    insert <- parseStatement "INSERT INTO constraint_slots (id, qty) VALUES (2, 3)"
+                    let damaged = [(name, table {SQL.tableRows = [[("qty", SQL.VInt 9)]]}) | (name, table) <- db]
+                    Right (runStatement damaged insert)
+            case result of
+                Right rejected -> rejected `shouldSatisfy` either (isInfixOf "missing bound column: id") (const False)
+                Left err -> expectationFailure err
+        it "checks existing INSERT keys and ALTER constraints with reversed physical columns" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE constraint_order (id INT PRIMARY KEY, qty INT UNIQUE)"
+                        , "INSERT INTO constraint_order (id, qty) VALUES (1, 2), (2, 3)"]
+                    let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
+                    insert <- parseStatement "INSERT INTO constraint_order (qty, id) VALUES (4, 3)"
+                    (inserted, _) <- runStatement reversed insert
+                    alter <- parseStatement "ALTER TABLE constraint_order ALTER COLUMN qty SET NOT NULL"
+                    (altered, _) <- runStatement inserted alter
+                    select <- parseStatement "SELECT id, qty FROM constraint_order"
+                    map (map snd) <$> rowsOf (runStatement altered select)
+            result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 2], [SQL.VInt 2, SQL.VInt 3], [SQL.VInt 3, SQL.VInt 4]]
+        it "rejects missing ALTER input before evaluating bound constraints" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE altered_missing (id INT, qty INT UNIQUE)"]
+                    alter <- parseStatement "ALTER TABLE altered_missing ALTER COLUMN qty SET NOT NULL"
+                    let damaged = [(name, table {SQL.tableRows = [[("id", SQL.VInt 1)]]}) | (name, table) <- db]
+                    Right (runStatement damaged alter)
+            case result of
+                Right rejected -> rejected `shouldSatisfy` either (isInfixOf "missing bound column: qty") (const False)
+                Left err -> expectationFailure err
+        it "rejects UPDATE nullability and final-row uniqueness violations" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE update_constraints (id INT PRIMARY KEY, qty INT NOT NULL UNIQUE)"
+                        , "INSERT INTO update_constraints (id, qty) VALUES (1, 2), (2, 3)"]
+                    nullable <- parseStatement "UPDATE update_constraints SET qty = NULL WHERE id = 1"
+                    duplicate <- parseStatement "UPDATE update_constraints SET qty = 3 WHERE id = 1"
+                    primary <- parseStatement "UPDATE update_constraints SET id = 2 WHERE id = 1"
+                    Right (db, [(nullable, "NOT NULL"), (duplicate, "UNIQUE"), (primary, "UNIQUE")])
+            case result of
+                Right (db, statements) -> mapM_ (\(statement, marker) ->
+                    case runMemoryStorage (runStatementM statement) db of
+                        Right (Left err, unchanged) -> do
+                            err `shouldSatisfy` isInfixOf marker
+                            map (second SQL.tableRows) unchanged
+                                `shouldBe` map (second SQL.tableRows) db
+                        other -> expectationFailure (show other)) statements
+                Left err -> expectationFailure err
+        it "checks UPDATE uniqueness after all rows rather than each replacement" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE update_unique (id INT PRIMARY KEY, qty INT UNIQUE)"
+                        , "INSERT INTO update_unique (id, qty) VALUES (1, 2), (2, 3), (3, NULL), (4, NULL)"
+                        , "UPDATE update_unique SET qty = qty + 1 WHERE id < 3"]
+                    select <- parseStatement "SELECT id, qty FROM update_unique"
+                    map (map snd) <$> rowsOf (runStatement db select)
+            result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 3], [SQL.VInt 2, SQL.VInt 4]
+                , [SQL.VInt 3, SQL.VNull], [SQL.VInt 4, SQL.VNull]]
+        it "rejects repeated INSERT targets instead of discarding later values" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE insert_targets (id INT, qty INT)"]
+                    statement <- parseStatement "INSERT INTO insert_targets (id, qty, qty) VALUES (1, 2, 9)"
+                    runStatement db statement
+            result `shouldSatisfy` either (isInfixOf "INSERT: duplicate target column: qty") (const False)
+        it "binds reordered INSERT inputs while retaining defaults, NULL and auto numbering" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN insert_label AS VARCHAR(4)"
+                        , "CREATE TABLE insert_slots (id INT AUTO_INCREMENT PRIMARY KEY, label insert_label DEFAULT 'ok', qty INT DEFAULT 7)"
+                        , "INSERT INTO insert_slots (qty, label, id) VALUES (NULL, 'ab', 10), (3, 'cd', NULL), (4, 'ef', 2)"
+                        , "INSERT INTO insert_slots (label) VALUES ('gh')"
+                        , "INSERT INTO insert_slots (qty) VALUES (8)"]
+                    select <- parseStatement "SELECT id, label, qty FROM insert_slots"
+                    map (map snd) <$> rowsOf (runStatement db select)
+            result `shouldBe` Right [[SQL.VInt 10, SQL.VStr "ab", SQL.VNull]
+                , [SQL.VInt 11, SQL.VStr "cd", SQL.VInt 3]
+                , [SQL.VInt 2, SQL.VStr "ef", SQL.VInt 4]
+                , [SQL.VInt 12, SQL.VStr "gh", SQL.VInt 7]
+                , [SQL.VInt 13, SQL.VStr "ok", SQL.VInt 8]]
+        it "binds write predicates and assignments to target schema positions" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE write_slots (id INT, qty INT)"]
+                    statement <- parseStatement "UPDATE write_slots SET qty = qty + id WHERE id = 1"
+                    prepare db statement >>= bindWriteColumns db
+            result `shouldBe` Right (Update "write_slots"
+                [("qty", Add (ColumnSlot 1 "qty") (ColumnSlot 0 "id"))]
+                (Just (Eq (ColumnSlot 0 "id") (LitInt 1))))
+        it "binds CHECK columns inside resolved function calls" $ do
+            let columns = [("id", SQL.plainColumn SQL.CInt), ("name", SQL.plainColumn SQL.CStr)]
+                result = prepareRowExpression columns (Gt (FunctionCall "length" [Col "name"]) (LitInt 1))
+            case result of
+                Right (Gt (BoundFunction (FunctionId 1) _ [ColumnSlot 1 "name"]) (LitInt 1)) -> pure ()
+                _ -> expectationFailure (show result)
+        it "preserves sequential updates and row order with reversed physical columns" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE write_slots (id INT, qty INT CHECK (qty >= 0))"
+                        , "INSERT INTO write_slots (id, qty) VALUES (1, 2), (2, 10), (3, 5)"]
+                    let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
+                    update <- parseStatement "UPDATE write_slots SET qty = qty + 1, qty = qty + id WHERE id = 1"
+                    (updated, _) <- runStatement reversed update
+                    delete <- parseStatement "DELETE FROM write_slots WHERE qty = 10"
+                    (remaining, _) <- runStatement updated delete
+                    select <- parseStatement "SELECT id, qty FROM write_slots"
+                    map (map snd) <$> rowsOf (runStatement remaining select)
+            result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 4], [SQL.VInt 3, SQL.VInt 5]]
+        it "keeps nested DOMAIN coercion, defaults and nullable writes" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN short_label AS VARCHAR(4)", "CREATE DOMAIN label AS short_label"
+                        , "CREATE TABLE write_domains (id INT, name label CHECK (length(name) > 1), qty INT DEFAULT 2)"
+                        , "INSERT INTO write_domains (id, name) VALUES (1, 'abc')"]
+                    select <- parseStatement "SELECT id, name, qty FROM write_domains"
+                    original <- map (map snd) <$> rowsOf (runStatement db select)
+                    update <- parseStatement "UPDATE write_domains SET qty = NULL WHERE id = 1"
+                    (updated, _) <- runStatement db update
+                    rejected <- parseStatement "UPDATE write_domains SET name = 'abcde' WHERE id = 1"
+                    rows <- map (map snd) <$> rowsOf (runStatement updated select)
+                    Right (original, rows, runStatement updated rejected)
+            case result of
+                Right (original, rows, rejected) -> do
+                    original `shouldBe` [[SQL.VInt 1, SQL.VStr "abc", SQL.VInt 2]]
+                    rows `shouldBe` [[SQL.VInt 1, SQL.VStr "abc", SQL.VNull]]
+                    rejected `shouldSatisfy` isFailure
+                Left err -> expectationFailure err
+        it "keeps correlated subqueries in bound assignments and DELETE predicates" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE write_outer (id INT, qty INT)"
+                        , "CREATE TABLE write_inner (id INT)"
+                        , "INSERT INTO write_outer (id, qty) VALUES (1, 2), (2, 10)"
+                        , "INSERT INTO write_inner (id) VALUES (2)"]
+                    update <- parseStatement "UPDATE write_outer SET qty = qty + (SELECT i.id FROM write_inner i WHERE i.id = qty) WHERE id = 1"
+                    (updated, _) <- runStatement db update
+                    select <- parseStatement "SELECT id, qty FROM write_outer"
+                    changed <- map (map snd) <$> rowsOf (runStatement updated select)
+                    delete <- parseStatement "DELETE FROM write_outer WHERE EXISTS (SELECT i.id FROM write_inner i WHERE i.id = qty - 2)"
+                    (remaining, _) <- runStatement updated delete
+                    kept <- map (map snd) <$> rowsOf (runStatement remaining select)
+                    Right (changed, kept)
+            result `shouldBe` Right ([[SQL.VInt 1, SQL.VInt 4], [SQL.VInt 2, SQL.VInt 10]]
+                , [[SQL.VInt 2, SQL.VInt 10]])
+        it "checks altered rows using schema order and keeps CHECK failures explicit" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE write_checks (id INT, qty INT CHECK (qty > id))"
+                        , "INSERT INTO write_checks (id, qty) VALUES (1, 3)"]
+                    let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
+                    alter <- parseStatement "ALTER TABLE write_checks ADD COLUMN note TEXT DEFAULT 'ok'"
+                    (altered, _) <- runStatement reversed alter
+                    invalid <- parseStatement "UPDATE write_checks SET qty = 0 WHERE id = 1"
+                    Right (runStatement altered invalid)
+            case result of
+                Right (Left err) -> err `shouldSatisfy` isInfixOf "CHECK on qty failed"
+                other -> expectationFailure (show other)
+        it "does not evaluate skipped assignments or empty DELETE predicates" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE write_lazy (id INT, qty INT)"
+                        , "INSERT INTO write_lazy (id, qty) VALUES (1, 2)"]
+                    update <- parseStatement "UPDATE write_lazy SET qty = 1 / 0 WHERE id = 99"
+                    (updated, _) <- runStatement db update
+                    delete <- parseStatement "DELETE FROM write_lazy"
+                    (empty, _) <- runStatement updated delete
+                    invalid <- parseStatement "DELETE FROM write_lazy WHERE 1 / 0 = 1"
+                    runStatement empty invalid
+            result `shouldSatisfy` either (const False) (const True)
+        it "rejects missing physical columns before a write" $ do
+            let db = [("write_missing", SQL.Table "write_missing"
+                    [("id", SQL.plainColumn SQL.CInt), ("qty", SQL.plainColumn SQL.CInt)]
+                    [[("id", SQL.VInt 1)]] Nothing Nothing Nothing)]
+            mapM_ (\source -> rowsOf (parseStatement source >>= runStatement db)
+                `shouldBe` Left "missing bound column: qty")
+                ["UPDATE write_missing SET id = 2", "DELETE FROM write_missing WHERE id = 1"]
+    describe "runtime encoding" $ do
+        it "round trips nested lists, optional values and tuples" $ do
+            let ty = tupleType [listType (maybeType intType), stringType, doubleType, boolType]
+                value = RTuple [RList [RMaybe Nothing, RMaybe (Just (RInt 42))], RString "你好", RDouble 1.25, RBool True]
+            withType ty $ \tid -> do
+                (encodeValue builtinTypes tid value >>= decodeValue builtinTypes tid) `shouldBe` Right value
+                decodeType builtinTypes (encodeType tid) `shouldBe` Right tid
+        it "round trips the empty tuple" $ withType (tupleType []) $ \tid ->
+            (encodeValue builtinTypes tid (RTuple []) >>= decodeValue builtinTypes tid) `shouldBe` Right (RTuple [])
+        it "rejects mismatched list elements" $ withType (listType intType) $ \tid ->
+            encodeValue builtinTypes tid (RList [RString "bad"]) `shouldSatisfy` isFailure
+        it "rejects tuple arity mismatch" $ withType (tupleType [intType]) $ \tid ->
+            encodeValue builtinTypes tid (RTuple []) `shouldSatisfy` isFailure
+        it "rejects non-finite floating point values" $ withType doubleType $ \tid ->
+            encodeValue builtinTypes tid (RDouble (1 / 0)) `shouldSatisfy` isFailure
+        it "rejects unsupported type encoding versions" $
+            decodeType builtinTypes (BS.pack "[2,[1,[]]]") `shouldSatisfy` isFailure
+        it "rejects overflowed constructor identities" $
+            decodeType builtinTypes (BS.pack "[1,[18446744073709551617,[]]]") `shouldSatisfy` isFailure
+        it "rejects fractional integer payloads" $ withType intType $ \tid ->
+            decodeValue builtinTypes tid (BS.pack "[1,[1,[]],1.5]") `shouldSatisfy` isFailure
+        it "rejects encoded identity mismatch" $ withType intType $ \tid ->
+            decodeValue builtinTypes tid (BS.pack "[1,[4,[]],\"x\"]") `shouldSatisfy` isFailure
+    describe "runtime binder and executor" $ do
+        it "resolves case-insensitive length to a stable FunctionId" $ withFunctions $ \functions ->
+            withType stringType $ \string -> withType intType $ \int ->
+                resolveFunction functions "LENGTH" [string]
+                    `shouldBe` Right (FunctionSignature (FunctionId 1) "length" [string] int)
+        it "binds and executes nested calls" $ withFunctions $ \functions -> do
+            let expression = Apply "not" [Apply "not" [Literal boolType (RBool True)]]
+            (bindExpression builtinTypes functions [] expression >>= evaluateExpression builtinTypes functions [])
+                `shouldBe` Right (RBool True)
+        it "uses the bound column slot and rejects reordered expression input" $ withFunctions $ \functions ->
+            withType intType $ \int -> withType stringType $ \string -> do
+                let bound = bindExpression builtinTypes functions [("count", int), ("name", string)]
+                        (Apply "length" [Reference "name"])
+                (bound >>= evaluateExpression builtinTypes functions [("count", RInt 1), ("name", RString "abc")])
+                    `shouldBe` Right (RInt 3)
+                (bound >>= evaluateExpression builtinTypes functions [("name", RString "abc"), ("count", RInt 1)])
+                    `shouldBe` Left "bound column position mismatch: name"
+                (bound >>= evaluateExpression builtinTypes functions [("count", RInt 1)])
+                    `shouldBe` Left "missing bound column: name"
+        it "rejects ambiguous references before binding a slot" $ withFunctions $ \functions ->
+            withType intType $ \int ->
+                bindExpression builtinTypes functions [("id", int), ("id", int)] (Reference "id")
+                    `shouldSatisfy` isFailure
+        it "normalizes storage order at scan boundaries before evaluating slots" $ withFunctions $ \functions -> do
+            let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
+                query = Projection [("size", Apply "length" [Reference "name"])]
+                    (Selection (Reference "enabled") (TableScan "items"))
+                scan _ = Right [[("enabled", RBool True), ("name", RString "abc")]]
+            (bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
+                `shouldBe` Right [[("size", RInt 3)]]
+        it "rebinds slots to each projection output schema" $ withFunctions $ \functions -> do
+            let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
+                source = Projection [("enabled", Reference "enabled"), ("label", Reference "name")]
+                    (TableScan "items")
+                query = Projection [("size", Apply "length" [Reference "label"])] source
+                scan _ = Right [[("name", RString "abc"), ("enabled", RBool True)]]
+            (bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
+                `shouldBe` Right [[("size", RInt 3)]]
+        it "rejects a wrong function argument type during binding" $ withFunctions $ \functions ->
+            bindExpression builtinTypes functions [] (Apply "length" [Literal intType (RInt 1)]) `shouldSatisfy` isFailure
+        it "rejects unknown function identities" $ withFunctions $ \functions ->
+            invokeFunction builtinTypes functions (FunctionId 99) [] `shouldSatisfy` isFailure
+        it "rejects wrong runtime argument types" $ withFunctions $ \functions ->
+            invokeFunction builtinTypes functions (FunctionId 1) [RInt 1] `shouldSatisfy` isFailure
+        it "binds empty List and Nothing using explicit element types" $ withFunctions $ \functions -> do
+            let expression = TupleLiteral [ListLiteral intType [], NothingLiteral stringType]
+            (bindExpression builtinTypes functions [] expression >>= evaluateExpression builtinTypes functions [])
+                `shouldBe` Right (RTuple [RList [], RMaybe Nothing])
+        it "rejects mixed logical list types" $ withFunctions $ \functions ->
+            bindExpression builtinTypes functions [] (ListLiteral intType [Literal doubleType (RDouble 1)]) `shouldSatisfy` isFailure
+        it "binds queries using schema without reading storage" $ withFunctions $ \functions -> do
+            let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
+                query = Projection [("size", Apply "length" [Reference "name"])]
+                    (Selection (Reference "enabled") (TableScan "items"))
+                scan name = if name == "items" then Right
+                    [[("name", RString "甲乙"), ("enabled", RBool True)]
+                    ,[("name", RString "hidden"), ("enabled", RBool False)]] else Left "unknown storage table"
+            (bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
+                `shouldBe` Right [[("size", RInt 2)]]
+        it "uses catalog existence even when storage could return rows" $ withFunctions $ \functions ->
+            bindPlan builtinTypes functions [] (TableScan "missing") `shouldSatisfy` isFailure
+        it "rejects non-boolean filters" $ withFunctions $ \functions ->
+            bindPlan builtinTypes functions [] (Selection (Literal intType (RInt 1)) SingleRow) `shouldSatisfy` isFailure
+        it "rejects schema drift returned by storage" $ withFunctions $ \functions ->
+            (bindPlan builtinTypes functions [("t", [("x", intType)])] (TableScan "t")
+                >>= executePlan builtinTypes functions (const (Right [[("x", RString "wrong")]]))) `shouldSatisfy` isFailure
+        it "propagates storage failures" $ withFunctions $ \functions ->
+            (bindPlan builtinTypes functions [("t", [])] (TableScan "t")
+                >>= executePlan builtinTypes functions (const (Left "storage unavailable"))) `shouldBe` Left "storage unavailable"
+    describe "SQL runtime functions" $ do
+        it "validates transitive DOMAIN dependencies and ignores unrelated definitions" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN amount AS INT", "CREATE DOMAIN total AS amount"
+                        , "CREATE DOMAIN unrelated AS TEXT", "CREATE TABLE amounts (value total)"]
+                    statement <- parseStatement "SELECT value FROM amounts"
+                    bound <- Query.bindQuery db statement
+                    let change target = [(name, if name == target then table {SQL.tableCols = [("base", SQL.plainColumn SQL.CBool)]}
+                            else table) | (name, table) <- db]
+                    accepted <- fst <$> runMemoryStorage (Query.executeQueryM bound) (change "__system_domain_unrelated")
+                    rejected <- fst <$> runMemoryStorage (Query.executeQueryM bound) (change "__system_domain_amount")
+                    Right (accepted, rejected)
+            result `shouldBe` Right (Right [], Left "bound query schema changed: __system_domain_amount")
+        it "preserves exact catalog identities and rejects malformed identifiers" $ do
+            let identity = SQL.TableIdentity (maxBound :: Word64) (maxBound :: Word64)
+                info = TableInfo "items" [] 0 [] [] [] (Just identity) Nothing
+                decode text = A.eitherDecode (BS.pack text) :: Either String TableInfo
+            A.fromJSON (A.toJSON info) `shouldBe` A.Success info
+            fmap tiIdentity (decode "{\"table\":\"items\",\"columns\":[],\"row_count\":0}") `shouldBe` Right Nothing
+            fmap tiIdentity (decode "{\"table\":\"items\",\"columns\":[],\"row_count\":0,\"database_id\":0,\"object_id\":1}")
+                `shouldBe` Right (Just (SQL.TableIdentity 0 1))
+            mapM_ (\fields -> decode ("{\"table\":\"items\",\"columns\":[],\"row_count\":0," ++ fields ++ "}")
+                `shouldSatisfy` isFailure)
+                ["\"database_id\":1", "\"database_id\":1,\"object_id\":-1"
+                , "\"database_id\":1,\"object_id\":1.5", "\"database_id\":1,\"object_id\":\"18446744073709551616\""
+                , "\"database_id\":1,\"object_id\":1e99999999"]
+        it "rejects a same-schema replacement or loss of object identity" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE bound_items (id INT)"]
+                    let identified = [(name, table {SQL.tableIdentity = Just (SQL.TableIdentity 1 1)}) | (name, table) <- db]
+                    statement <- parseStatement "SELECT id FROM bound_items"
+                    bound <- Query.bindQuery identified statement
+                    let replaced = [(name, table {SQL.tableIdentity = Just (SQL.TableIdentity 1 2)}) | (name, table) <- db]
+                    changed <- fst <$> runMemoryStorage (Query.executeQueryM bound) replaced
+                    lost <- fst <$> runMemoryStorage (Query.executeQueryM bound) db
+                    Right (changed, lost)
+            result `shouldBe` Right (Left "bound query object changed: bound_items", Left "bound query object changed: bound_items")
+        it "preserves exact schema versions and rejects malformed versions" $ do
+            let info = TableInfo "items" [] 0 [] [] [] Nothing (Just maxBound)
+                decode version = A.eitherDecode (BS.pack ("{\"table\":\"items\",\"columns\":[],\"row_count\":0,\"schema_version\":" ++ version ++ "}")) :: Either String TableInfo
+            A.fromJSON (A.toJSON info) `shouldBe` A.Success info
+            fmap tiSchemaVersion (decode "0") `shouldBe` Right Nothing
+            fmap tiSchemaVersion (decode "7") `shouldBe` Right (Just 7)
+            mapM_ (\version -> decode version `shouldSatisfy` isFailure)
+                ["-1", "1.5", "\"18446744073709551616\"", "\"+1\"", "1e99999999"]
+        it "invalidates a bound query after restoring its original columns" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE versioned (id INT)"]
+                    statement <- parseStatement "SELECT id FROM versioned"
+                    bound <- Query.bindQuery db statement
+                    added <- parseStatement "ALTER TABLE versioned ADD COLUMN extra TEXT" >>= runStatement db
+                    restored <- parseStatement "ALTER TABLE versioned DROP COLUMN extra" >>= runStatement (fst added)
+                    fst <$> runMemoryStorage (Query.executeQueryM bound) (fst restored)
+            result `shouldBe` Right (Left "bound query schema changed: versioned")
+        it "rejects loss of a bound schema version" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE versioned (id INT)"]
+                    statement <- parseStatement "SELECT id FROM versioned"
+                    bound <- Query.bindQuery db statement
+                    fst <$> runMemoryStorage (Query.executeQueryM bound)
+                        [(name, table {SQL.tableSchemaVersion = Nothing}) | (name, table) <- db]
+            result `shouldBe` Right (Left "bound query schema changed: versioned")
+        it "ignores unrelated table changes but validates nested query dependencies" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE referenced (id INT)", "CREATE TABLE unrelated (id INT)"]
+                    statement <- parseStatement "SELECT length((SELECT MIN(name) FROM (SELECT 'abc' AS name FROM referenced) d)) AS n"
+                    bound <- Query.bindQuery db statement
+                    unrelated <- parseStatement "ALTER TABLE unrelated ADD COLUMN extra TEXT" >>= runStatement db
+                    accepted <- fst <$> runMemoryStorage (Query.executeQueryM bound) (fst unrelated)
+                    referenced <- parseStatement "ALTER TABLE referenced ADD COLUMN extra TEXT" >>= runStatement db
+                    rejected <- fst <$> runMemoryStorage (Query.executeQueryM bound) (fst referenced)
+                    Right (accepted, rejected)
+            result `shouldBe` Right (Right [[("n", SQL.VNull)]], Left "bound query schema changed: referenced")
+        it "guards tables referenced only by HAVING or expression ordering" $ do
+            let result query = do
+                    db <- sqlCatalog ["CREATE TABLE main_rows (id INT)", "CREATE TABLE dependency_rows (id INT)"]
+                    bound <- parseStatement query >>= Query.bindQuery db
+                    changed <- parseStatement "ALTER TABLE dependency_rows ADD COLUMN extra TEXT" >>= runStatement db
+                    fst <$> runMemoryStorage (Query.executeQueryM bound) (fst changed)
+            mapM_ (\query -> result query `shouldBe` Right (Left "bound query schema changed: dependency_rows"))
+                [ "SELECT COUNT(*) FROM main_rows HAVING COUNT(*) > (SELECT COUNT(*) FROM dependency_rows)"
+                , "SELECT id FROM main_rows ORDER BY (SELECT COUNT(*) FROM dependency_rows) + id"
+                ]
+        it "rejects schema drift before executing an empty bound query" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE bound_items (id INT)"]
+                    statement <- parseStatement "SELECT id FROM bound_items"
+                    bound <- Query.bindQuery db statement
+                    changed <- parseStatement "ALTER TABLE bound_items ADD COLUMN extra TEXT" >>= runStatement db
+                    fst <$> runMemoryStorage (Query.executeQueryM bound) (fst changed)
+            result `shouldBe` Right (Left "bound query schema changed: bound_items")
+        it "keeps binding valid across row and statistics changes" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE bound_items (id INT)"]
+                    statement <- parseStatement "SELECT id FROM bound_items"
+                    bound <- Query.bindQuery db statement
+                    changed <- parseStatement "INSERT INTO bound_items (id) VALUES (7)" >>= runStatement db
+                    let current = [(name, table {SQL.tableMeta = Just (SQL.TableMeta 100 [] [] [])})
+                            | (name, table) <- fst changed]
+                    fst <$> runMemoryStorage (Query.executeQueryM bound) current
+            result `shouldBe` Right (Right [[("id", SQL.VInt 7)]])
+        it "binds grouping keys and then sorting to the grouped output" $ do
+            let source = Rel.Compute [("first", LitInt 1), ("key", LitInt 2)] Rel.Unit
+                plan = Rel.Sort [("key", Desc)] (Rel.Aggregate ["key"] [("n", CountAll)] source)
+                bound = Rel.BoundSort [(ColumnSlot 0 "key", Desc)]
+                    (Rel.BoundAggregate [("key", ColumnSlot 1 "key")] [("n", CountAll)] source)
+            bindRelOpColumns [] [] plan `shouldBe` Right bound
+            evalRelOp [] bound `shouldBe` Right [[("key", SQL.VInt 2), ("n", SQL.VInt 1)]]
+            evalRelOp [] (Rel.BoundAggregate [("key", ColumnSlot 0 "key")] [] source)
+                `shouldBe` Left "bound column position mismatch: key"
+        it "sorts bound NULL keys stably and rejects wrong slots" $ do
+            let a = [("id", SQL.VInt 1), ("key", SQL.VInt 2)]
+                b = [("id", SQL.VInt 2), ("key", SQL.VNull)]
+                c = [("id", SQL.VInt 3), ("key", SQL.VInt 2)]
+            sortBoundRows [(ColumnSlot 1 "key", Asc)] [] [a, b, c] `shouldBe` Right [b, a, c]
+            sortBoundRows [(ColumnSlot 1 "key", Desc)] [] [a, b, c] `shouldBe` Right [a, c, b]
+            sortBoundRows [(ColumnSlot 0 "key", Asc)] [] [a]
+                `shouldBe` Left "bound column position mismatch: key"
+        it "preserves NULL group order and empty-input global aggregates" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE grouped_slots (id INT, tag TEXT)"
+                        , "INSERT INTO grouped_slots (id, tag) VALUES (1, 'b'), (2, NULL), (3, 'b')"]
+                    grouped <- parseStatement "SELECT tag, COUNT(*) AS n FROM grouped_slots GROUP BY tag"
+                    groups <- rowsOf (runStatement db grouped)
+                    empty <- parseStatement "SELECT COUNT(*) AS n, SUM(id) AS total FROM grouped_slots WHERE id < 0"
+                    aggregates <- rowsOf (runStatement db empty)
+                    Right (map (map snd) groups, map (map snd) aggregates)
+            result `shouldBe` Right ([[SQL.VStr "b", SQL.VInt 2], [SQL.VNull, SQL.VInt 1]]
+                , [[SQL.VInt 0, SQL.VNull]])
+        it "binds SQL relation expressions to the optimized input slots" $ do
+            let plan = Rel.Compute [("value", Col "second")]
+                    (Rel.Compute [("first", LitInt 1), ("second", LitInt 2)] Rel.Unit)
+            bindRelOpColumns [] [] plan `shouldBe` Right (Rel.Compute [("value", ColumnSlot 1 "second")]
+                (Rel.Compute [("first", LitInt 1), ("second", LitInt 2)] Rel.Unit))
+            bindRelOpColumns [] [] (Rel.Filter (Col "missing") Rel.Unit)
+                `shouldBe` Left "unknown column: missing"
+        it "checks SQL slot position instead of searching another column" $ do
+            evalExpr (ColumnSlot 1 "name") [("name", SQL.VStr "abc"), ("id", SQL.VInt 1)]
+                `shouldBe` Left "bound column position mismatch: name"
+            evalExpr (ColumnSlot (-1) "name") [("name", SQL.VStr "abc")]
+                `shouldBe` Left "bound column position mismatch: name"
+        it "binds projections without losing repeated outputs or empty rows" $ do
+            let source = Rel.Compute [("first", LitInt 1), ("second", LitInt 2)] Rel.Unit
+            bindRelOpColumns [] [] (Rel.Project ["second", "first", "second"] source)
+                `shouldBe` Right (Rel.Compute [("second", ColumnSlot 1 "second")
+                    , ("first", ColumnSlot 0 "first"), ("second", ColumnSlot 1 "second")] source)
+            bindRelOpColumns [] [] (Rel.Project [] source)
+                `shouldBe` Right (Rel.Compute [] source)
+            bindRelOpColumns [] [] (Rel.Project ["*"] source)
+                `shouldBe` Right (Rel.Compute [("first", ColumnSlot 0 "first"), ("second", ColumnSlot 1 "second")] source)
+        it "preserves repeated SQL outputs and correlated projection values" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE slot_items (id INT)"
+                        , "INSERT INTO slot_items (id) VALUES (1), (2)"]
+                    repeated <- parseStatement "SELECT id, id FROM slot_items"
+                    repeatedRows <- rowsOf (runStatement db repeated)
+                    correlated <- parseStatement "SELECT o.id, (SELECT o.id FROM slot_items i WHERE i.id = o.id) AS echoed FROM slot_items o"
+                    correlatedRows <- rowsOf (runStatement db correlated)
+                    Right (map (map snd) repeatedRows, map (map snd) correlatedRows)
+            result `shouldBe` Right ([[SQL.VInt 1, SQL.VInt 1], [SQL.VInt 2, SQL.VInt 2]]
+                , [[SQL.VInt 1, SQL.VInt 1], [SQL.VInt 2, SQL.VInt 2]])
+        it "binds outer references after the local relation layout" $ do
+            bindRelOpColumns [] ["outer.id"] (Rel.Compute [("id", Col "outer.id")] Rel.Unit)
+                `shouldBe` Right (Rel.Compute [("id", OuterColumnSlot 0 0 "outer.id")] Rel.Unit)
+        it "binds subquery references to parent slots before execution" $ do
+            let statement = Select [("value", Col "parent.id")] FromUnit Nothing [] Nothing [] Nothing
+                query = Subquery statement ["parent.id"]
+                source = Rel.Compute [("id", LitInt 1)] Rel.Unit
+                plan = Rel.Compute [("value", ScalarSub query)] source
+            bindRelOpColumns [] [] plan `shouldBe` Right (Rel.Compute
+                [("value", ScalarSub (BoundSubquery statement ["parent.id"] [("parent.id", ColumnSlot 0 "id")]))] source)
+            case bindRelOpColumns [] [] plan of
+                Left err -> expectationFailure err
+                Right bound -> evalRelOp [] bound `shouldBe` Right [[("value", SQL.VInt 1)]]
+        it "keeps exact outer subquery references ahead of local physical fallbacks" $ do
+            let statement = Select [("value", Col "parent.id")] FromUnit Nothing [] Nothing [] Nothing
+                query = Subquery statement ["parent.id"]
+                source = Rel.Compute [("id", LitInt 1)] Rel.Unit
+            bindRelOpColumns [] ["parent.id"] (Rel.Compute [("value", ScalarSub query)] source)
+                `shouldBe` Right (Rel.Compute [("value", ScalarSub (BoundSubquery statement ["parent.id"]
+                    [("parent.id", OuterColumnSlot 1 0 "parent.id")]))] source)
+        it "uses distinct bound positions when subqueries share a diagnostic name" $ do
+            let statement = Select [("value", Col "x")] FromUnit Nothing [] Nothing [] Nothing
+                first = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 0 "a")])
+                second = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 1 "b")])
+                table = SQL.Table "slot_cache" [("a", SQL.plainColumn SQL.CInt), ("b", SQL.plainColumn SQL.CInt)]
+                    [[("a", SQL.VInt 1), ("b", SQL.VInt 2)], [("a", SQL.VInt 1), ("b", SQL.VInt 3)]] Nothing Nothing Nothing
+                plan = Rel.Compute [("first", first), ("second", second)] (Rel.Scan Nothing "slot_cache" Nothing)
+            subquerySlotsIn (Add first second) `shouldBe` [ColumnSlot 0 "a", ColumnSlot 1 "b"]
+            evalRelOp [("slot_cache", table)] plan `shouldBe` Right
+                [[("first", SQL.VInt 1), ("second", SQL.VInt 2)]
+                , [("first", SQL.VInt 1), ("second", SQL.VInt 3)]]
+        it "rejects bound subquery layout mismatches instead of looking up names" $ do
+            let statement = Select [("value", Col "id")] FromUnit Nothing [] Nothing [] Nothing
+                query = BoundSubquery statement ["id"] [("id", ColumnSlot 0 "id")]
+                wrongLayout = Rel.Compute [("other", LitInt 2), ("id", LitInt 1)] Rel.Unit
+            evalRelOp [] (Rel.Compute [("value", ScalarSub query)] wrongLayout)
+                `shouldBe` Left "bound column position mismatch: id"
+            prepareRowExpression [] (ScalarSub query)
+                `shouldBe` Left "execution subquery cannot be used in semantic input"
+            bindRelOpColumns [] [] (Rel.Compute [("value", ScalarSub
+                (BoundSubquery statement ["id"] []))] Rel.Unit)
+                `shouldBe` Left "bound subquery references mismatch"
+        it "preserves outer scope identity when rebinding beside a local name" $ do
+            let source = Rel.Compute [("id", LitInt 1)] Rel.Unit
+                expression = OuterColumnSlot 0 0 "id"
+                bound = bindRelOpColumns [] ["id"] (Rel.Compute [("outer", expression)] source)
+            bound `shouldBe` Right (Rel.Compute [("outer", OuterColumnSlot 1 0 "id")] source)
+            evalExpr (OuterColumnSlot 1 0 "id") [("id", SQL.VInt 1), ("id", SQL.VInt 9)]
+                `shouldBe` Right (SQL.VInt 9)
+            bindRelOpColumns [] [] (Rel.Compute [("outer", expression)] source)
+                `shouldBe` Left "unknown column: id"
+            prepareRowExpression [] expression `shouldBe` Left "execution column cannot be used in semantic input"
+            prepareRowExpression [] (ColumnSlot 0 "id") `shouldBe` Left "execution column cannot be used in semantic input"
+        it "preserves duplicate column positions when rebinding local and outer slots" $ do
+            let source = Rel.Compute [("id", LitInt 1), ("id", LitInt 9)] Rel.Unit
+                plan = Rel.Compute [("value", ColumnSlot 1 "id")] source
+            bindRelOpColumns [] [] plan `shouldBe` Right plan
+            (bindRelOpColumns [] [] plan >>= evalRelOp [])
+                `shouldBe` Right [[("value", SQL.VInt 9)]]
+            bindRelOpColumns [] ["id", "id"] (Rel.Compute [("value", OuterColumnSlot 0 1 "id")] source)
+                `shouldBe` Right (Rel.Compute [("value", OuterColumnSlot 2 1 "id")] source)
+        it "rejects ambiguous slot relocation and invalid bound positions" $ do
+            let source = Rel.Compute [("other", LitInt 0), ("id", LitInt 1), ("id", LitInt 9)] Rel.Unit
+            bindRelOpColumns [] [] (Rel.Compute [("value", ColumnSlot 0 "id")] source)
+                `shouldBe` Left "ambiguous bound column: id"
+            bindRelOpColumns [] ["other", "id", "id"] (Rel.Compute [("value", OuterColumnSlot 0 0 "id")] Rel.Unit)
+                `shouldBe` Left "ambiguous bound column: id"
+            bindRelOpColumns [] [] (Rel.Compute [("value", ColumnSlot (-1) "id")] source)
+                `shouldBe` Left "bound column position mismatch: id"
+            bindRelOpColumns [] ["id"] (Rel.Compute [("value", OuterColumnSlot (-1) 0 "id")] Rel.Unit)
+                `shouldBe` Left "bound column position mismatch: id"
+            bindRelOpColumns [] [] (Rel.Compute [("value", ColumnSlot 0 "id")]
+                (Rel.Compute [("other", LitInt 0), ("id", LitInt 9)] Rel.Unit))
+                `shouldBe` Right (Rel.Compute [("value", ColumnSlot 1 "id")]
+                    (Rel.Compute [("other", LitInt 0), ("id", LitInt 9)] Rel.Unit))
+        it "keeps duplicate parent slots distinct through subquery rebinding and caching" $ do
+            let statement = Select [("value", Col "x")] FromUnit Nothing [] Nothing [] Nothing
+                first = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 0 "id")])
+                second = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 1 "id")])
+                source = Rel.Compute [("id", LitInt 1), ("id", LitInt 9)] Rel.Unit
+                plan = Rel.Compute [("first", first), ("second", second)] source
+            bindRelOpColumns [] [] plan `shouldBe` Right plan
+            (bindRelOpColumns [] [] plan >>= evalRelOp [])
+                `shouldBe` Right [[("first", SQL.VInt 1), ("second", SQL.VInt 9)]]
+        it "keeps inner shadowing and multi-level correlated SQL references" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE scoped_items (id INT)"
+                        , "INSERT INTO scoped_items (id) VALUES (1), (2)"]
+                    statement <- parseStatement "SELECT o.id, (SELECT id FROM scoped_items i WHERE i.id = o.id) AS inner_id, (SELECT (SELECT o.id FROM scoped_items j WHERE j.id = i.id) FROM scoped_items i WHERE i.id = o.id) AS nested_id FROM scoped_items o"
+                    rows <- rowsOf (runStatement db statement)
+                    Right (map (map snd) rows)
+            result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 1, SQL.VInt 1], [SQL.VInt 2, SQL.VInt 2, SQL.VInt 2]]
+        it "resolves the nearest of several enclosing column scopes" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (id INT)"
+                        , "INSERT INTO scope_far (id) VALUES (1), (2)", "INSERT INTO scope_near (id) VALUES (10), (11)"]
+                    statement <- parseStatement "SELECT o.id, (SELECT (SELECT id) FROM scope_near n WHERE n.id = o.id + 9) AS nearest FROM scope_far o"
+                    map (map snd) <$> rowsOf (runStatement db statement)
+            result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 10], [SQL.VInt 2, SQL.VInt 11]]
+        it "keeps enclosing scopes separate when aliases and DOMAIN types overlap" $ withType stringType $ \tid -> do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN scope_label AS VARCHAR(4)"
+                        , "CREATE TABLE scope_far (value INT)", "CREATE TABLE scope_near (value scope_label)"
+                        , "INSERT INTO scope_far (value) VALUES (7)", "INSERT INTO scope_near (value) VALUES ('abc')"]
+                    statement <- parseStatement "SELECT (SELECT (SELECT length(s.value)) FROM scope_near s) AS size FROM scope_far s"
+                    rows <- map (map snd) <$> rowsOf (runStatement db statement)
+                    domain <- parseStatement "SELECT (SELECT (SELECT s.value) FROM scope_near s) AS label FROM scope_far s"
+                    bound <- Query.bindQuery db domain
+                    Right (rows, Query.queryTypes bound)
+            result `shouldBe` Right ([[SQL.VInt 3]], [("label", Query.DomainType "scope_label" (Query.RuntimeType tid))])
+        it "skips empty or unrelated enclosing scopes and preserves NULL" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (name TEXT)"
+                        , "INSERT INTO scope_far (id) VALUES (NULL), (4)", "INSERT INTO scope_near (name) VALUES ('n')"]
+                    statement <- parseStatement "SELECT (SELECT (SELECT (SELECT id)) FROM scope_near n) AS echoed FROM scope_far o"
+                    map (map snd) <$> rowsOf (runStatement db statement)
+            result `shouldBe` Right [[SQL.VNull], [SQL.VInt 4]]
+        it "does not resolve an ambiguous nearer scope against a farther one" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (id INT)"]
+                    statement <- parseStatement "SELECT (SELECT (SELECT id) FROM scope_near a JOIN scope_near b ON a.id = b.id) FROM scope_far o"
+                    rowsOf (runStatement db statement)
+            result `shouldSatisfy` either (isInfixOf "ambiguous column") (const False)
+        it "does not take a missing column from a shadowed source alias" $ do
+            let result source = do
+                    db <- sqlCatalog ["CREATE TABLE source_far (id INT)", "CREATE TABLE source_near (other INT)"
+                        , "INSERT INTO source_far (id) VALUES (1)", "INSERT INTO source_near (other) VALUES (10)"]
+                    statement <- parseStatement source
+                    rowsOf (runStatement db statement)
+            mapM_ (\source -> result source `shouldSatisfy` either (isInfixOf "unknown column") (const False))
+                ["SELECT (SELECT s.id FROM source_near s) FROM source_far s"
+                , "SELECT (SELECT (SELECT s.id) FROM source_near s) FROM source_far s"]
+        it "keeps bare far columns visible when the nearer alias has no such column" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE source_far (id INT)", "CREATE TABLE source_near (other INT)"
+                        , "INSERT INTO source_far (id) VALUES (1), (2)", "INSERT INTO source_near (other) VALUES (10)"]
+                    statement <- parseStatement "SELECT (SELECT (SELECT id) FROM source_near s) AS inherited FROM source_far s"
+                    map (map snd) <$> rowsOf (runStatement db statement)
+            result `shouldBe` Right [[SQL.VInt 1], [SQL.VInt 2]]
+        it "uses lexical scopes in IN, EXISTS and quantified subqueries" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (id INT)"
+                        , "INSERT INTO scope_far (id) VALUES (1)", "INSERT INTO scope_near (id) VALUES (10)"]
+                    statement <- parseStatement "SELECT (SELECT 10 IN (SELECT id) AND EXISTS (SELECT 1 WHERE id = 10) AND 10 = ALL (SELECT id) FROM scope_near n) AS matched FROM scope_far o"
+                    map (map snd) <$> rowsOf (runStatement db statement)
+            result `shouldBe` Right [[SQL.VBool True]]
+        it "resolves JOIN conditions against the nearest enclosing scope" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE scope_far (value INT)", "CREATE TABLE scope_near (value INT)"
+                        , "CREATE TABLE scope_join (id INT)", "INSERT INTO scope_far (value) VALUES (1)"
+                        , "INSERT INTO scope_near (value) VALUES (10)", "INSERT INTO scope_join (id) VALUES (10)"]
+                    statement <- parseStatement "SELECT (SELECT (SELECT a.id FROM scope_join a JOIN scope_join b ON a.id = value AND b.id = a.id) FROM scope_near n) AS matched FROM scope_far o"
+                    map (map snd) <$> rowsOf (runStatement db statement)
+            result `shouldBe` Right [[SQL.VInt 10]]
+        it "executes SQL against reversed physical column order" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE TABLE slot_items (id INT, name TEXT)"
+                        , "INSERT INTO slot_items (id, name) VALUES (1, 'abc'), (2, 'xy')"]
+                    let reordered = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
+                    statement <- parseStatement "SELECT length(name) AS size, id + 1 AS next FROM slot_items WHERE id > 0 ORDER BY size"
+                    rowsOf (runStatement reordered statement)
+            fmap (map (map snd)) result `shouldBe` Right [[SQL.VInt 2, SQL.VInt 3], [SQL.VInt 3, SQL.VInt 2]]
+        it "binds the SQL entry point to output TypeIds" $ withType intType $ \tid -> do
+            let result = parseStatement "SELECT length('abc') AS size" >>= Query.bindQuery []
+            fmap Query.queryTypes result `shouldBe` Right [("size", Query.RuntimeType tid)]
+        it "retains compatibility for existing temporal SQL types" $ do
+            let result = parseStatement "SELECT DATE '2026-10-05' AS today" >>= Query.bindQuery []
+            fmap Query.queryTypes result `shouldBe` Right [("today", Query.CompatibilityType SQL.CDate)]
+        it "retains nested DOMAIN identities through derived aliases and DISTINCT" $ withType intType $ \tid -> do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN quantity AS INT", "CREATE DOMAIN stock AS quantity"
+                        , "CREATE TABLE inventory (qty stock)", "INSERT INTO inventory (qty) VALUES (2), (NULL)"]
+                    statement <- parseStatement "SELECT DISTINCT d.qty AS available FROM (SELECT qty FROM inventory) d"
+                    bound <- Query.bindQuery db statement
+                    rows <- rowsOf (runStatement db statement)
+                    Right (Query.queryTypes bound, map (map snd) rows)
+            result `shouldBe` Right ([("available", Query.DomainType "stock"
+                (Query.DomainType "quantity" (Query.RuntimeType tid)))], [[SQL.VInt 2], [SQL.VNull]])
+        it "preserves temporal and binary DOMAIN wrappers" $ do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN day AS DATE", "CREATE DOMAIN payload AS BLOB"
+                        , "CREATE TABLE documents (created day, contents payload)"]
+                    statement <- parseStatement "SELECT created, contents FROM documents"
+                    Query.queryTypes <$> Query.bindQuery db statement
+            result `shouldBe` Right [("created", Query.DomainType "day" (Query.CompatibilityType SQL.CDate))
+                , ("contents", Query.DomainType "payload" (Query.CompatibilityType SQL.CBlob))]
+        it "uses base function semantics without labeling function results as DOMAIN" $ withType intType $ \tid -> do
+            let result = do
+                    db <- sqlCatalog ["CREATE DOMAIN label AS VARCHAR(3)", "CREATE TABLE names (name label)"
+                        , "INSERT INTO names (name) VALUES ('abc')"]
+                    statement <- parseStatement "SELECT length(name) AS size FROM names"
+                    bound <- Query.bindQuery db statement
+                    rows <- rowsOf (runStatement db statement)
+                    Right (Query.queryTypes bound, map (map snd) rows)
+            result `shouldBe` Right ([("size", Query.RuntimeType tid)], [[SQL.VInt 3]])
+        it "rejects composite ordering without an Ord implementation" $
+            sql "SELECT LIST<Int>(1) AS xs ORDER BY xs" `shouldSatisfy` isFailure
+        it "rejects composite extrema without an Ord implementation" $
+            sql "SELECT MIN(LIST<Int>(1))" `shouldSatisfy` isFailure
+        it "rejects unique runtime columns without a key implementation" $
+            (parseStatement "CREATE TABLE keyed (xs [Int] UNIQUE)" >>= runStatement []) `shouldSatisfy` isFailure
+        it "rejects primary runtime keys without a key implementation" $
+            (parseStatement "CREATE TABLE keyed (xs [Int] PRIMARY KEY)" >>= runStatement []) `shouldSatisfy` isFailure
+        it "constructs nested compound values in SQL" $ withType (listType (maybeType intType)) $ \tid ->
+            sql "SELECT LIST<Maybe Int>(MAYBE<Int>(), MAYBE<Int>(42))"
+                `shouldBe` Right [[SQL.VRuntime tid (RList [RMaybe Nothing, RMaybe (Just (RInt 42))])]]
+        it "constructs heterogeneous tuples with stable type identity" $ withType (tupleType [intType, stringType]) $ \tid ->
+            sql "SELECT TUPLE<Int, String>(1, 'a')" `shouldBe` Right [[SQL.VRuntime tid (RTuple [RInt 1, RString "a"])]]
+        it "rejects constructor argument type mismatch" $
+            sql "SELECT LIST<Int>('bad')" `shouldSatisfy` isFailure
+        it "rejects constructor arity mismatch" $
+            sql "SELECT MAYBE<Int>(1, 2)" `shouldSatisfy` isFailure
+        it "rejects SQL NULL inside a typed compound value" $
+            sql "SELECT LIST<Int>(NULL)" `shouldSatisfy` isFailure
+        it "round trips typed runtime values through the shared wire protocol" $
+            withType (maybeType (listType intType)) $ \tid -> do
+                let value = SQL.VRuntime tid (RMaybe (Just (RList [RInt 1, RInt 2])))
+                parseEither valueFromJSON (valueToJSON value) `shouldBe` Right value
+        it "round trips typed schema identities through catalog type names" $
+            withType (tupleType [intType, listType stringType]) $ \tid ->
+                SQL.parseColumnType (SQL.typeName (SQL.CRuntime tid)) `shouldBe` Just (SQL.CRuntime tid)
+        it "keeps hashing consistent for signed floating zero" $ withType (listType doubleType) $ \tid -> do
+            let positive = SQL.VRuntime tid (RList [RDouble 0])
+                negative = SQL.VRuntime tid (RList [RDouble (-0)])
+            positive `shouldBe` negative
+            hash positive `shouldBe` hash negative
+        it "creates and writes compound columns through SQL" $ do
+            let result = do
+                    create <- parseStatement "CREATE TABLE composite (xs [Int], opt Maybe String, pair (Int, String))"
+                    (db, _) <- runStatement [] create
+                    insert <- parseStatement "INSERT INTO composite (xs, opt, pair) VALUES (LIST<Int>(1, 2), MAYBE<String>(), TUPLE<Int, String>(3, 'x'))"
+                    (updated, _) <- runStatement db insert
+                    select <- parseStatement "SELECT xs, opt, pair FROM composite"
+                    rowsOf (runStatement updated select)
+            result `shouldSatisfy` either (const False) ((== 1) . length)
+        it "stores logical String with the generic runtime encoding" $ do
+            let result = do
+                    create <- parseStatement "CREATE TABLE strings (text String)"
+                    (db, _) <- runStatement [] create
+                    insert <- parseStatement "INSERT INTO strings (text) VALUES ('abc')"
+                    (updated, _) <- runStatement db insert
+                    select <- parseStatement "SELECT length(text) FROM strings"
+                    map (map snd) <$> rowsOf (runStatement updated select)
+            result `shouldBe` Right [[SQL.VInt 3]]
+        it "runs length and not through resolved identities" $
+            sql "SELECT length('你好'), not(TRUE)" `shouldBe` Right [[SQL.VInt 2, SQL.VBool False]]
+        it "preserves nullable SQL function semantics" $
+            sql "SELECT length(NULL), not(NULL)" `shouldBe` Right [[SQL.VNull, SQL.VNull]]
+        it "binds calls before execution" $ do
+            let bound = parseStatement "SELECT length('abc')" >>= prepare []
+            case bound of
+                Right Select {selectItems = [(_, BoundFunction (FunctionId 1) _ [_])]} -> pure ()
+                _ -> expectationFailure (show bound)
+        it "rejects unknown SQL functions before scanning" $
+            sql "SELECT missing('abc')" `shouldSatisfy` isFailure
+        it "rejects wrong argument count" $
+            sql "SELECT length('a', 'b')" `shouldSatisfy` isFailure
+        it "rejects wrong SQL argument type" $
+            sql "SELECT length(1)" `shouldSatisfy` isFailure
+        it "finds references inside calls for projection pushdown" $
+            sql "SELECT length(name) FROM t WHERE not(enabled)" `shouldBe` Right [[SQL.VInt 3]]
+        it "rewrites aggregates nested in calls" $
+            sql "SELECT length(MIN(name)) FROM t" `shouldBe` Right [[SQL.VInt 2]]
+        it "executes subqueries nested in function arguments" $
+            sql "SELECT length((SELECT MIN(name) FROM t))" `shouldBe` Right [[SQL.VInt 2]]
+        it "expands CTEs inside function arguments" $
+            sql "WITH names AS (SELECT name FROM t) SELECT length((SELECT MIN(name) FROM names))"
+                `shouldBe` Right [[SQL.VInt 2]]
+        it "binds CHECK functions using the row schema" $ do
+            let result = do
+                    statement <- parseStatement "CREATE TABLE checked (name TEXT CHECK (length(name) > 1))"
+                    (db, _) <- runStatement [] statement
+                    insert <- parseStatement "INSERT INTO checked (name) VALUES ('abc')"
+                    runStatement db insert
+            result `shouldSatisfy` either (const False) (const True)
+
+-- | 通过正式入口执行测试 SQL
+sql :: String -> Either String [[SQL.Value]]
+sql source = do
+    statement <- parseStatement source
+    rows <- rowsOf (runStatement database statement)
+    Right (map (map snd) rows)
+  where
+    -- | 提供函数调用测试表
+    database = [("t", SQL.Table "t" [("name", SQL.plainColumn SQL.CStr), ("enabled", SQL.plainColumn SQL.CBool)]
+        [[("name", SQL.VStr "ab"), ("enabled", SQL.VBool True)]
+        ,[("name", SQL.VStr "xyz"), ("enabled", SQL.VBool False)]] Nothing Nothing Nothing)]
+
+-- | 判断结果是否明确失败
+isFailure :: Either a b -> Bool
+isFailure (Left _) = True
+isFailure _ = False
+
+-- | 准备已解析类型身份
+withType :: TypeExpr -> (TypeId -> Expectation) -> Expectation
+withType ty action = case resolveType builtinTypes ty of
+    Left err -> expectationFailure err
+    Right descriptor -> action (descriptorId descriptor)
+
+-- | 准备内建函数注册表
+withFunctions :: (FunctionRegistry -> Expectation) -> Expectation
+withFunctions action = case builtinFunctions builtinTypes of
+    Left err -> expectationFailure err
+    Right functions -> action functions

chusql-core/model/chusql-core-model.cabal

@@ -13,10 +13,13 @@ library
     hs-source-dirs:   src
     exposed-modules:  ChuSQL.Core.Model
                       ChuSQL.Core.Protocol
+                      ChuSQL.Core.Runtime
     build-depends:    base >= 4.14 && < 5
                     , aeson
                     , hashable
                     , scientific
                     , text
+                    , bytestring
+                    , vector
     default-language: Haskell2010
     ghc-options:      -Wall

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

@@ -12,6 +12,7 @@ module ChuSQL.Core.Model
     , TableMeta (..)
     , Histogram (..)
     , Table (..)
+    , TableIdentity (..)
     , Database
     , histogramOf
     , histogramFor
@@ -48,6 +49,9 @@ 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
 
 -- 数据模型：列类型、列约束、值、行、表、数据库，外加查表小工具。
 
@@ -68,6 +72,7 @@ data ColumnType
     | CBlob
     | CNull
     | CDomain String ColumnType
+    | CRuntime TypeId
     deriving (Show, Eq)
 
 -- | 列定义：类型 + 约束；约束全部取默认值就是普通可空列。
@@ -121,6 +126,7 @@ typeLabel CTimestamp = "TTimestamp"
 typeLabel CBlob = "TBlob"
 typeLabel CNull = "NULL"
 typeLabel (CDomain name _) = name
+typeLabel (CRuntime tid) = renderTypeExpr (typeExpression tid)
 
 -- | 线上/磁盘上的类型名
 typeName :: ColumnType -> String
@@ -139,6 +145,7 @@ typeName CTimestamp = "timestamp"
 typeName CBlob = "blob"
 typeName CNull = "null"
 typeName (CDomain name base) = "domain(" ++ name ++ "," ++ typeName base ++ ")"
+typeName (CRuntime tid) = "runtime(" ++ BS.unpack (encodeType tid) ++ ")"
 
 -- | 生成类型定义的目录键
 domainTableName :: String -> String
@@ -151,6 +158,9 @@ isDomainTable name = "__system_domain_" `isPrefixOf` map toLower name
 -- | 解析类型名，可带长度/精度参数；不认识的给 Nothing
 parseColumnType :: String -> Maybe ColumnType
 parseColumnType raw
+    | Just inner <- stripPrefix "runtime(" raw
+    , Just body <- stripSuffixMaybe ")" inner =
+        either (const Nothing) (Just . CRuntime) (decodeType builtinTypes (BS.pack body))
     | Just inner <- stripPrefix "domain(" raw
     , Just body <- stripSuffixMaybe ")" inner
     , (name, ',' : definition) <- break (== ',') body =
@@ -180,7 +190,7 @@ parseColumnType raw
         ("date", []) -> Just CDate
         ("timestamp", []) -> Just CTimestamp
         ("blob", []) -> Just CBlob
-        _ -> Nothing
+        _ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
   where
     -- | 去掉空白的类型名
     cleaned = map toLower (filter (not . isSpace) raw)
@@ -231,6 +241,7 @@ data TypeClass
     | TemporalClass
     | BooleanClass
     | NullClass
+    | RuntimeClass
     deriving (Show, Eq)
 
 -- | 整型大类判断
@@ -250,12 +261,15 @@ typeClassOf CTimestamp = TemporalClass
 typeClassOf CBool = BooleanClass
 typeClassOf CNull = NullClass
 typeClassOf (CDomain _ base) = typeClassOf base
+typeClassOf CRuntime{} = RuntimeClass
 
 -- | 同大类可赋值；日期/时间列接受字符串字面量
 assignable :: ColumnType -> ColumnType -> Bool
 assignable target source
     | source == CNull = True
     | target == source = True
+    | CRuntime tid <- target = Just (typeExpression tid) == scalarTypeExpression source
+    | typeClassOf target == RuntimeClass || typeClassOf source == RuntimeClass = False
     | typeClassOf target == typeClassOf source = True
     | typeClassOf target == TemporalClass && typeClassOf source == TextClass = True
     | otherwise = False
@@ -270,7 +284,9 @@ integerType _ = False
 
 -- | 比较用的类型族：同大类可比，日期时间与文本互比
 comparableTypes :: ColumnType -> ColumnType -> Bool
-comparableTypes a b = a == CNull || b == CNull || sameClass || crossTemporal
+comparableTypes a b
+    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = False
+    | otherwise = a == CNull || b == CNull || sameClass || crossTemporal
   where
     -- | 两个类型同属一个大类
     sameClass = typeClassOf a == typeClassOf b
@@ -288,6 +304,10 @@ numericType t = typeClassOf t == NumericClass
 -- | 值能不能放进这一列（先不看可空）
 valueFits :: ColumnType -> Value -> Bool
 valueFits (CDomain _ base) value = valueFits base value
+valueFits (CRuntime expected) (VRuntime supplied value) = expected == supplied && validateValue builtinTypes expected value == Right ()
+valueFits (CRuntime expected) value = case scalarRuntimeValue value of
+    Just runtime -> validateValue builtinTypes expected runtime == Right ()
+    Nothing -> value == VNull
 valueFits _ VNull = True
 valueFits CInt (VInt _) = True
 valueFits CBigInt (VInt _) = True
@@ -326,6 +346,15 @@ coerceValue t v = case t of
     CBlob -> toText t v
     CNull -> Left "a NULL output cannot contain a non-NULL value"
     CDomain _ base -> coerceValue base v
+    CRuntime expected -> case v of
+        VRuntime supplied value | supplied == expected -> do
+            validateValue builtinTypes expected value
+            Right v
+        _ -> case scalarRuntimeValue v of
+            Just value -> do
+                validateValue builtinTypes expected value
+                Right (VRuntime expected value)
+            Nothing -> Left "runtime value type identity mismatch"
 
 -- | 整数收进整型列
 toInt :: ColumnType -> Value -> Either String Value
@@ -422,6 +451,7 @@ data Value
     | VFloat Double
     | VStr String
     | VBool Bool
+    | VRuntime TypeId RuntimeValue
     deriving (Show, Eq)
 
 -- | 值的比较关键字：整值浮点折成整数
@@ -450,6 +480,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))
     (x, y) -> compare (valueRank x) (valueRank y)
 
 -- | 族的先后，只用来给异族值定序
@@ -459,6 +490,7 @@ valueRank (VInt _) = 1
 valueRank (VFloat _) = 1
 valueRank (VStr _) = 2
 valueRank (VBool _) = 3
+valueRank VRuntime{} = 4
 
 -- | 相等语义：比较关键字相同即相等，与 hashValue 配套
 valuesEqual :: Value -> Value -> Bool
@@ -472,6 +504,35 @@ 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))
+
+-- | 解析现有标量列的逻辑类型
+scalarTypeExpression :: ColumnType -> Maybe TypeExpr
+scalarTypeExpression (CDomain _ base) = scalarTypeExpression base
+scalarTypeExpression CInt = Just intType
+scalarTypeExpression CBigInt = Just intType
+scalarTypeExpression CSmallInt = Just intType
+scalarTypeExpression CDouble = Just doubleType
+scalarTypeExpression CFloat = Just doubleType
+scalarTypeExpression CBool = Just boolType
+scalarTypeExpression CStr = Just stringType
+scalarTypeExpression _ = Nothing
+
+-- | 转换现有标量值
+scalarRuntimeValue :: Value -> Maybe RuntimeValue
+scalarRuntimeValue (VInt n) = Just (RInt n)
+scalarRuntimeValue (VFloat n) = Just (RDouble n)
+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
@@ -497,12 +558,17 @@ data TableMeta = TableMeta
     }
     deriving (Show)
 
--- | 一张表：名字、列定义与全部行；meta 为存储层统计，拿不到是 Nothing
+-- | 保存持久化数据库与表编号
+data TableIdentity = TableIdentity Word64 Word64 deriving (Show, Eq)
+
+-- | 一张表：列、行、统计与独立对象身份
 data Table = Table
     { tableName :: String
     , tableCols :: [(String, Column)]
     , tableRows :: [Row]
     , tableMeta :: Maybe TableMeta
+    , tableIdentity :: Maybe TableIdentity
+    , tableSchemaVersion :: Maybe Word64
     }
     deriving (Show)
 

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

@@ -15,15 +15,19 @@ module ChuSQL.Core.Protocol (
     queryResultJson,
 ) where
 
-import ChuSQL.Core.Model (Histogram (..), Row, Value (..))
+import ChuSQL.Core.Model (Histogram (..), Row, TableIdentity (..), Value (..))
-import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.!=), (.=))
+import ChuSQL.Core.Runtime (builtinTypes, runtimeFromJSON, runtimeToJSON)
+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
 import Data.Aeson.Types (Parser)
-import Data.Scientific (floatingOrInteger, fromFloatDigits)
+import Data.Char (isDigit)
-import qualified Data.Text as T
+import Data.Scientific (base10Exponent, floatingOrInteger, fromFloatDigits)
 import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Word (Word64)
+import Text.Read (readMaybe)
 
 -- 线上协议类型：存储层请求/响应与查询结果集。
 
@@ -78,7 +82,7 @@ data Request
     | ReqIdentityInitialize T.Text
     | ReqRoleCreate T.Text
     | ReqCatalogManage Request
-    | ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
+    | ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
     | ReqAccountCreate T.Text T.Text
     | ReqAccountReset T.Text T.Text
     | ReqAccountLogin T.Text (Maybe T.Text)
@@ -94,6 +98,7 @@ data Request
     | ReqLookupByColumn String String Value
     | ReqRangeByIndex String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
     | ReqDescribeTable String
+    | ReqValidateWrite String
     | ReqCreateTable String [SchemaColumn]
     | ReqDropTable String
     | ReqCreateIndex String String
@@ -133,6 +138,7 @@ instance ToJSON TxnOp where
 
 -- | 请求编码成 JSON
 instance ToJSON Request where
+    toJSON (ReqValidateWrite t) = object ["method" .= ("validate_write" :: T.Text), "table" .= t]
     toJSON (ReqDatabase method name) = object ["method" .= method, "database" .= name]
     toJSON ReqAllCatalog = object ["method" .= ("all_catalogs" :: T.Text)]
     toJSON (ReqInDatabase name req) = case toJSON req of
@@ -142,8 +148,16 @@ instance ToJSON Request where
     toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
     toJSON (ReqIdentityInitialize u) = object ["method" .= ("identity_initialize" :: T.Text), "administrator" .= u]
     toJSON (ReqRoleCreate u) = object ["method" .= ("role_create" :: T.Text), "user" .= u]
-    toJSON (ReqIdentityAlter u login super enabled manager) = object ["method" .= ("identity_alter" :: T.Text), "user" .= u,
+    toJSON (ReqIdentityAlter u login super enabled manager sudo) =
-        "can_login" .= login, "is_superuser" .= super, "enabled" .= enabled, "system_catalog_manager" .= manager]
+        object
+            [ "method" .= ("identity_alter" :: T.Text)
+            , "user" .= u
+            , "can_login" .= login
+            , "is_superuser" .= super
+            , "enabled" .= enabled
+            , "system_catalog_manager" .= manager
+            , "allow_sudo_auth" .= sudo
+            ]
     toJSON (ReqAccountCreate u h) = object ["method" .= ("account_create" :: T.Text), "user" .= u, "password_hash" .= h]
     toJSON (ReqAccountReset u h) = object ["method" .= ("account_reset" :: T.Text), "user" .= u, "password_hash" .= h]
     toJSON (ReqAccountLogin u at) = object ["method" .= ("account_login" :: T.Text), "user" .= u, "at" .= at]
@@ -254,6 +268,8 @@ data TableInfo = TableInfo
     , tiIndexes :: [String]
     , tiStats :: [(String, Int, Bool)]
     , tiHistograms :: [(String, Histogram)]
+    , tiIdentity :: Maybe TableIdentity
+    , tiSchemaVersion :: Maybe Word64
     }
     deriving (Show, Eq)
 
@@ -266,6 +282,9 @@ instance ToJSON TableInfo where
             , "row_count" .= tiRows info
             , "indexes" .= map (\name -> object ["column" .= name]) (tiIndexes info)
             , "stats" .= map (statJson (tiHistograms info)) (tiStats info)
+            , "database_id" .= fmap (\(TableIdentity database _) -> show database) (tiIdentity info)
+            , "object_id" .= fmap (\(TableIdentity _ table) -> show table) (tiIdentity info)
+            , "schema_version" .= fmap show (tiSchemaVersion info)
             ]
       where
         statJson hists (name, distinct, capped) =
@@ -275,6 +294,19 @@ instance ToJSON TableInfo where
             histFields Nothing = []
             histFields (Just h) = ["lo" .= histLow h, "hi" .= histHigh h, "hist" .= histBuckets h]
 
+-- | 解码精确且有界的对象编号
+parseObjectNumber :: A.Value -> Parser Word64
+parseObjectNumber (A.String value)
+    | not (T.null value)
+    , T.length value <= 20
+    , T.all isDigit value
+    , Just number <- readMaybe (T.unpack value) :: Maybe Integer
+    , number <= toInteger (maxBound :: Word64) =
+        pure (fromInteger number)
+parseObjectNumber value@(A.Number number)
+    | base10Exponent number >= -20, base10Exponent number <= 20 = A.parseJSON value
+parseObjectNumber _ = fail "invalid table object identity"
+
 -- | 线上直方图还原；区间或桶缺了就当作没有
 histogramFromWire :: Maybe Double -> Maybe Double -> [Int] -> Maybe Histogram
 histogramFromWire (Just low) (Just high) counts
@@ -289,11 +321,29 @@ instance FromJSON TableInfo where
         count <- o .: "row_count"
         indexes <- o .:? "indexes" .!= []
         stats <- o .:? "stats" .!= []
-        indexColumns <- mapM (\v -> withObject "IndexWire" (.: "column") v) (indexes :: [A.Value])
+        indexColumns <- mapM (withObject "IndexWire" (.: "column")) (indexes :: [A.Value])
         parsed <- mapM parseStat (stats :: [A.Value])
+        database <- o .:? "database_id" >>= traverse parseObjectNumber
+        tableId <- o .:? "object_id" >>= traverse parseObjectNumber
+        version <- o .:? "schema_version" >>= traverse parseObjectNumber
+        identity <- case (database, tableId) of
+            (Nothing, Nothing) -> pure Nothing
+            (Just _, Just 0) -> pure Nothing
+            (Just databaseId, Just objectId) | objectId > 0 -> pure (Just (TableIdentity databaseId objectId))
+            _ -> fail ("incomplete table object identity: " ++ show (database, tableId))
         let parsedStats = [(name, distinct, capped) | (name, distinct, capped, _) <- parsed]
             parsedHistograms = [(name, h) | (name, _, _, Just h) <- parsed]
-        pure (TableInfo table columns count indexColumns parsedStats parsedHistograms)
+        pure
+            ( TableInfo
+                table
+                columns
+                count
+                indexColumns
+                parsedStats
+                parsedHistograms
+                identity
+                (version >>= \v -> if v == 0 then Nothing else Just v)
+            )
       where
         parseStat = withObject "ColumnStat" $ \o -> do
             name <- o .: "name"
@@ -316,7 +366,9 @@ data Account = Account
     , accountIsSuperuser :: Bool
     , accountEnabled :: Bool
     , accountSystemCatalogManager :: Bool
-    } deriving (Eq)
+    , accountAllowSudoAuth :: Bool
+    }
+    deriving (Eq)
 
 -- | 账号的展示：只露账号名与版本号
 instance Show Account where
@@ -324,17 +376,36 @@ instance Show Account where
 
 -- | JSON 解回账号
 instance FromJSON Account where
-    parseJSON = withObject "Account" $ \o -> Account <$> o .: "id" <*> o .: "user"
+    parseJSON = withObject "Account" $ \o ->
-        <*> o .: "password_hash" <*> o .: "revision"
+        Account
-        <*> o .:? "registered_at" .!= "" <*> o .:? "last_login_at"
+            <$> o .: "id"
-        <*> o .:? "can_login" .!= True <*> o .:? "is_superuser" .!= False <*> o .:? "enabled" .!= True <*> o .:? "system_catalog_manager" .!= False
+            <*> o .: "user"
+            <*> o .: "password_hash"
+            <*> o .: "revision"
+            <*> o .:? "registered_at" .!= ""
+            <*> o .:? "last_login_at"
+            <*> o .:? "can_login" .!= True
+            <*> o .:? "is_superuser" .!= False
+            <*> o .:? "enabled" .!= True
+            <*> o .:? "system_catalog_manager" .!= False
+            <*> o .:? "allow_sudo_auth" .!= False
 
 -- | 账号编码成 JSON
 instance ToJSON Account where
-    toJSON a = object ["id" .= accountId a, "user" .= accountUser a,
+    toJSON a =
-        "password_hash" .= accountHash a, "revision" .= accountRevision a,
+        object
-        "registered_at" .= accountRegisteredAt a, "last_login_at" .= accountLastLoginAt a,
+            [ "id" .= accountId a
-        "can_login" .= accountCanLogin a, "is_superuser" .= accountIsSuperuser a, "enabled" .= accountEnabled a, "system_catalog_manager" .= accountSystemCatalogManager a]
+            , "user" .= accountUser a
+            , "password_hash" .= accountHash a
+            , "revision" .= accountRevision a
+            , "registered_at" .= accountRegisteredAt a
+            , "last_login_at" .= accountLastLoginAt a
+            , "can_login" .= accountCanLogin a
+            , "is_superuser" .= accountIsSuperuser a
+            , "enabled" .= accountEnabled a
+            , "system_catalog_manager" .= accountSystemCatalogManager a
+            , "allow_sudo_auth" .= accountAllowSudoAuth a
+            ]
 
 -- | 存储层响应
 data Response
@@ -373,6 +444,7 @@ valueToJSON (VInt n) = A.Number (fromIntegral n)
 valueToJSON (VFloat d) = A.Number (fromFloatDigits d)
 valueToJSON (VStr s) = A.String (T.pack s)
 valueToJSON (VBool b) = A.Bool b
+valueToJSON (VRuntime tid value) = object ["__chusql_runtime_v1" .= runtimeToJSON tid value]
 
 -- | JSON 解回值
 valueFromJSON :: A.Value -> Parser Value
@@ -383,6 +455,10 @@ valueFromJSON (A.Number n) =
         Left d -> pure (VFloat d)
 valueFromJSON (A.String s) = pure (VStr (T.unpack s))
 valueFromJSON (A.Bool b) = pure (VBool b)
+valueFromJSON (A.Object fields)
+    | KM.size fields == 1
+    , Just payload <- KM.lookup "__chusql_runtime_v1" fields =
+        either fail (pure . uncurry VRuntime) (runtimeFromJSON builtinTypes payload)
 valueFromJSON _ = fail "unsupported value type"
 
 -- | 一行编码成 JSON
@@ -394,7 +470,7 @@ rowToJSON r =
 rowFromJSON :: A.Value -> Parser Row
 rowFromJSON (A.Object o) = mapM toPair (KM.toList o)
   where
-    -- | 键值对解成一个字段
+    -- \| 键值对解成一个字段
     toPair (k, v) = do
         val <- valueFromJSON v
         pure (K.toString k, val)
@@ -415,7 +491,8 @@ instance FromJSON QueryResult where
     parseJSON = withObject "QueryResult" $ \o -> do
         cols <- o .: "columns"
         rows <- o .: "rows"
-        QueryResult cols <$> mapM (mapM valueFromJSON) rows
+        QueryResult cols
+            <$> mapM (mapM valueFromJSON) rows
             <*> o .:? "rowCount" .!= 0
             <*> o .:? "truncated" .!= False
             <*> o .:? "database"

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

@@ -0,0 +1,294 @@
+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
+
+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.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
+
+-- 运行时类型身份、构造器注册及版本化物理编码。
+
+-- | 标识稳定的类型构造器
+newtype TypeConstructorId = TypeConstructorId Int deriving (Show, Eq, Ord)
+
+-- | 表达逻辑类型应用
+data TypeExpr = TypeApply TypeConstructorId [TypeExpr] deriving (Show, Eq, Ord)
+
+-- | 标识完整的类型实例
+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 TypeDescriptor = TypeDescriptor
+    { descriptorId :: TypeId, descriptorName :: String, descriptorPhysical :: PhysicalType
+    } 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)
+
+-- | 恢复固定编号的内建构造器
+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)]
+
+-- | 构造整数类型表达式
+intType :: TypeExpr
+intType = TypeApply (TypeConstructorId 1) []
+
+-- | 构造浮点类型表达式
+doubleType :: TypeExpr
+doubleType = TypeApply (TypeConstructorId 2) []
+
+-- | 构造布尔类型表达式
+boolType :: TypeExpr
+boolType = TypeApply (TypeConstructorId 3) []
+
+-- | 构造字符串类型表达式
+stringType :: TypeExpr
+stringType = TypeApply (TypeConstructorId 4) []
+
+-- | 构造列表类型表达式
+listType :: TypeExpr -> TypeExpr
+listType t = TypeApply (TypeConstructorId 5) [t]
+
+-- | 构造可选类型表达式
+maybeType :: TypeExpr -> TypeExpr
+maybeType t = TypeApply (TypeConstructorId 6) [t]
+
+-- | 构造元组类型表达式
+tupleType :: [TypeExpr] -> TypeExpr
+tupleType = TypeApply (TypeConstructorId 7)
+
+-- | 渲染内建逻辑类型语法
+renderTypeExpr :: TypeExpr -> String
+renderTypeExpr ty@(TypeApply cid arguments) = case (cid, arguments) of
+    (TypeConstructorId 1, []) -> "Int"
+    (TypeConstructorId 2, []) -> "Double"
+    (TypeConstructorId 3, []) -> "Bool"
+    (TypeConstructorId 4, []) -> "String"
+    (TypeConstructorId 5, [child]) -> "[" ++ renderTypeExpr child ++ "]"
+    (TypeConstructorId 6, [child]) -> "Maybe " ++ renderTypeExpr child
+    (TypeConstructorId 7, fields) -> "(" ++ joinTypes fields ++ ")"
+    _ -> show ty
+  where
+    -- | 连接元组字段类型
+    joinTypes [] = ""
+    joinTypes [field] = renderTypeExpr field
+    joinTypes (field : fields) = renderTypeExpr field ++ ", " ++ joinTypes fields
+
+-- | 解析完整的内建逻辑类型文本
+parseTypeExpr :: String -> Either String TypeExpr
+parseTypeExpr source = case P.readP_to_S (P.skipSpaces *> expression <* P.skipSpaces <* P.eof) source of
+    [(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")
+        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)
+
+-- | 渲染运行时值的可读文本
+renderRuntimeValue :: RuntimeValue -> String
+renderRuntimeValue (RInt n) = show n
+renderRuntimeValue (RDouble n) = show n
+renderRuntimeValue (RBool b) = show b
+renderRuntimeValue (RString text) = show text
+renderRuntimeValue (RList values) = "[" ++ joinValues values ++ "]"
+renderRuntimeValue (RMaybe Nothing) = "Nothing"
+renderRuntimeValue (RMaybe (Just value)) = "Just (" ++ renderRuntimeValue value ++ ")"
+renderRuntimeValue (RTuple values) = "(" ++ joinValues values ++ ")"
+
+-- | 连接复合值的字段文本
+joinValues :: [RuntimeValue] -> String
+joinValues [] = ""
+joinValues [value] = renderRuntimeValue value
+joinValues (value : values) = renderRuntimeValue value ++ ", " ++ joinValues values
+
+-- | 提取身份中的逻辑类型
+typeExpression :: TypeId -> TypeExpr
+typeExpression (TypeId t) = t
+
+-- | 解析类型实例并校验 kind
+resolveType :: TypeRegistry -> TypeExpr -> Either String TypeDescriptor
+resolveType registry@(TypeRegistry constructors) expression@(TypeApply cid args) = do
+    (name, kind) <- case [(n, k) | (c, n, k) <- constructors, c == cid] of
+        [entry] -> Right entry
+        _ -> Left ("unknown type constructor: " ++ show cid)
+    children <- mapM (resolveType registry) args
+    physical <- case (cid, kind, map descriptorPhysical children) of
+        (TypeConstructorId 1, TypeKind, []) -> Right SignedInteger
+        (TypeConstructorId 2, TypeKind, []) -> Right FloatingPoint
+        (TypeConstructorId 3, TypeKind, []) -> Right Boolean
+        (TypeConstructorId 4, TypeKind, []) -> Right Utf8
+        (TypeConstructorId 5, TypeArrow TypeKind TypeKind, [child]) -> Right (Sequence child)
+        (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)
+
+-- | 按身份查询类型描述
+describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
+describeType registry = resolveType registry . typeExpression
+
+-- | 校验逻辑类型对应的值
+validateValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String ()
+validateValue registry tid value = do
+    descriptor <- describeType registry tid
+    validatePhysical (descriptorPhysical descriptor) value
+
+-- | 校验值的物理结构
+validatePhysical :: PhysicalType -> RuntimeValue -> Either String ()
+validatePhysical SignedInteger RInt{} = Right ()
+validatePhysical FloatingPoint (RDouble n)
+    | not (isNaN n || isInfinite n) = Right ()
+validatePhysical Boolean RBool{} = Right ()
+validatePhysical Utf8 RString{} = Right ()
+validatePhysical (Sequence child) (RList values) = mapM_ (validatePhysical child) values
+validatePhysical (Optional _) (RMaybe Nothing) = Right ()
+validatePhysical (Optional child) (RMaybe (Just value)) = validatePhysical child value
+validatePhysical (Product fields) (RTuple values)
+    | length fields == length values = zipWithM_ validatePhysical fields values
+validatePhysical physical _ = Left ("value does not fit physical type: " ++ show physical)
+
+-- | 编码带版本与类型身份的值
+encodeValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String BS.ByteString
+encodeValue registry tid value = do
+    validateValue registry tid value
+    Right (encode (runtimeToJSON tid value))
+
+-- | 表达协议中的类型化值封装
+runtimeToJSON :: TypeId -> RuntimeValue -> Value
+runtimeToJSON tid value = array [Number 1, typeJson (typeExpression tid), valueJson value]
+
+-- | 解析并校验协议类型化值
+runtimeFromJSON :: TypeRegistry -> Value -> Either String (TypeId, RuntimeValue)
+runtimeFromJSON registry json = do
+    (expression, payload) <- parseEither parseEnvelope json
+    descriptor <- resolveType registry expression
+    value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
+    validateValue registry (descriptorId descriptor) value
+    Right (descriptorId descriptor, value)
+
+-- | 解码并校验版本和类型身份
+decodeValue :: TypeRegistry -> TypeId -> BS.ByteString -> Either String RuntimeValue
+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
+        value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
+        validateValue registry expected value
+        Right value
+
+-- | 编码版本化类型身份
+encodeType :: TypeId -> BS.ByteString
+encodeType tid = encode (array [Number 1, typeJson (typeExpression tid)])
+
+-- | 解码并解析类型身份
+decodeType :: TypeRegistry -> BS.ByteString -> Either String TypeId
+decodeType registry bytes = do
+    json <- eitherDecode bytes
+    expression <- parseEither parseTypeEnvelope json
+    descriptorId <$> resolveType registry expression
+
+-- | 生成 JSON 数组
+array :: [Value] -> Value
+array = Array . V.fromList
+
+-- | 编码构造器应用
+typeJson :: TypeExpr -> Value
+typeJson (TypeApply (TypeConstructorId cid) args) = array [Number (fromIntegral cid), array (map typeJson args)]
+
+-- | 解析构造器应用
+parseTypeJson :: Value -> Parser TypeExpr
+parseTypeJson (Array values) = case V.toList values of
+    [Number n, Array args] -> case floatingOrInteger n :: Either Double Integer of
+        Right cid | cid > 0, cid <= fromIntegral (maxBound :: Int) -> TypeApply (TypeConstructorId (fromInteger cid)) <$> mapM parseTypeJson (V.toList args)
+        _ -> fail "invalid type constructor identity"
+    _ -> fail "invalid type expression"
+parseTypeJson _ = fail "invalid type expression"
+
+-- | 解析类型版本封装
+parseTypeEnvelope :: Value -> Parser TypeExpr
+parseTypeEnvelope (Array values) = case V.toList values of
+    [Number 1, expression] -> parseTypeJson expression
+    _ -> fail "unsupported type encoding version or invalid envelope"
+parseTypeEnvelope _ = fail "invalid type envelope"
+
+-- | 解析值版本封装
+parseEnvelope :: Value -> Parser (TypeExpr, Value)
+parseEnvelope (Array values) = case V.toList values of
+    [Number 1, expression, payload] -> do
+        ty <- parseTypeJson expression
+        pure (ty, payload)
+    _ -> fail "unsupported value encoding version or invalid envelope"
+parseEnvelope _ = fail "invalid value envelope"
+
+-- | 编码物理值
+valueJson :: RuntimeValue -> Value
+valueJson (RInt n) = Number (fromIntegral n)
+valueJson (RDouble n) = Number (realToFrac n)
+valueJson (RBool b) = Bool b
+valueJson (RString s) = String (T.pack s)
+valueJson (RList values) = array (map valueJson values)
+valueJson (RMaybe Nothing) = array []
+valueJson (RMaybe (Just value)) = array [valueJson value]
+valueJson (RTuple values) = array (map valueJson values)
+
+-- | 按物理描述解析值
+parseValue :: PhysicalType -> Value -> Parser RuntimeValue
+parseValue SignedInteger (Number n) = case floatingOrInteger n :: Either Double Integer of
+    Right i | i >= fromIntegral (minBound :: Int), i <= fromIntegral (maxBound :: Int) -> pure (RInt (fromInteger i))
+    _ -> fail "integer is fractional or out of range"
+parseValue FloatingPoint (Number n) = pure (RDouble (realToFrac n))
+parseValue Boolean (Bool b) = pure (RBool b)
+parseValue Utf8 (String s) = pure (RString (T.unpack s))
+parseValue (Sequence child) (Array values) = RList <$> mapM (parseValue child) (V.toList values)
+parseValue (Optional child) (Array values) = case V.toList values of
+    [] -> pure (RMaybe Nothing)
+    [value] -> RMaybe . Just <$> parseValue child value
+    _ -> fail "invalid optional value"
+parseValue (Product fields) (Array values)
+    | length fields == V.length values = RTuple <$> zipWithM parseValue fields (V.toList values)
+parseValue _ _ = fail "invalid physical value"

chusql-core/storage/src/btree.rs

@@ -167,23 +167,47 @@ fn put_node(p: &mut Page, node: &Node) -> io::Result<()> {
 }
 
 /// 从一页读出节点
-fn get_node(p: &Page) -> Node {
+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"));
+    }
     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"));
+    }
     let trailer = read_u64(p, OFF_NEXT);
     let mut keys = Vec::with_capacity(count);
     let mut values = Vec::with_capacity(count + 1);
+    let mut cell_end = p.data.len();
     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"));
+        }
         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"));
+        }
+        if off + CELL_FIXED + klen > cell_end {
+            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"));
+    }
     if kind == NODE_INTERNAL {
         values.push(trailer);
-        Node { kind, next: 0, keys, values }
+        if values.contains(&META_PAGE) {
+            return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid index child page"));
+        }
+        Ok(Node { kind, next: 0, keys, values })
     } else {
-        Node { kind, next: trailer, keys, values }
+        Ok(Node { kind, next: trailer, keys, values })
     }
 }
 
@@ -299,7 +323,7 @@ impl DiskBTree {
 
     /// 按页号读节点
     fn load(&mut self, id: PageId) -> io::Result<Node> {
-        self.file.with_page(id, get_node)
+        self.file.with_page(id, get_node)?
     }
 
     /// 按页号写节点
@@ -338,24 +362,9 @@ impl DiskBTree {
 
     /// 按 key 取全部位置（重复键按值升序）
     pub fn get_all(&mut self, key: &[u8]) -> io::Result<Vec<u64>> {
-        let Some(mut id) = self.root()? else {
+        let mut values: Vec<_> = self.scan(Some(key), Some(key))?.into_iter().map(|(_, value)| value).collect();
-            return Ok(Vec::new());
+        values.sort_unstable();
-        };
+        Ok(values)
-        loop {
-            let node = self.load(id)?;
-            if node.kind == NODE_LEAF {
-                let start = node.keys.partition_point(|k| k.as_slice() < key);
-                let mut out = Vec::new();
-                for i in start..node.keys.len() {
-                    if node.keys[i].as_slice() != key {
-                        break;
-                    }
-                    out.push(node.values[i]);
-                }
-                return Ok(out);
-            }
-            id = node.values[child_slot(&node.keys, key)];
-        }
     }
 
     /// 插入一个键值对（键可重复）
@@ -412,10 +421,9 @@ impl DiskBTree {
             self.store(id, &node)?;
             return Ok(None);
         }
-        let (sep, mut right) = split_node(&mut node);
+        let (sep, right) = split_node(&mut node);
         let right_id = self.alloc(&right)?;
         if node.kind == NODE_LEAF {
-            right.next = node.next;
             node.next = right_id;
         }
         self.store(id, &node)?;
@@ -443,8 +451,14 @@ impl DiskBTree {
             }
             return Ok(false);
         }
-        let child = node.values[child_slot(&node.keys, key)];
+        let first = node.keys.partition_point(|k| k.as_slice() < key);
-        self.delete_rec(child, key, value)
+        let last = child_slot(&node.keys, key);
+        for &child in &node.values[first..=last] {
+            if self.delete_rec(child, key, value)? {
+                return Ok(true);
+            }
+        }
+        Ok(false)
     }
 
     /// 叶子链上按顺序取全部 (键, 值)
@@ -475,7 +489,7 @@ impl DiskBTree {
             }
             id = match lo {
                 None => node.values[0],
-                Some(start) => node.values[child_slot(&node.keys, start)],
+                Some(start) => node.values[node.keys.partition_point(|k| k.as_slice() < start)],
             };
         }
         let mut out = Vec::new();

chusql-core/storage/src/catalog.rs

@@ -34,6 +34,11 @@ pub struct ColumnStat {
 
 #[derive(Debug, Clone, Default, Serialize, Deserialize)]
 pub struct TableSchema {
+    #[serde(default)]
+    pub object_id: u64,
+    #[serde(default)]
+    // 0 表示旧目录尚无可验证的结构版本。
+    pub schema_version: u64,
     #[serde(default)]
     pub system: bool,
     pub columns: Vec<SchemaColumn>,
@@ -49,8 +54,12 @@ pub struct TableSchema {
     pub stats: BTreeMap<String, ColumnStat>,
 }
 
-#[derive(Debug, Default, Serialize, Deserialize)]
+#[derive(Debug, Clone, Default, Serialize, Deserialize)]
 pub struct Catalog {
+    #[serde(default)]
+    pub database_id: u64,
+    #[serde(default)]
+    pub object_high_water: u64,
     #[serde(default)]
     pub identity_high_water: i64,
     tables: BTreeMap<String, TableSchema>,
@@ -68,7 +77,36 @@ impl Catalog {
         if bytes.is_empty() {
             return Ok(Catalog::default());
         }
-        serde_json::from_slice(&bytes).map_err(io::Error::other)
+        let mut catalog: Self = serde_json::from_slice(&bytes).map_err(io::Error::other)?;
+        catalog.upgrade_object_ids()?;
+        Ok(catalog)
+    }
+
+    /// 补齐旧目录对象编号并校验唯一性
+    fn upgrade_object_ids(&mut self) -> io::Result<()> {
+        self.object_high_water = self.object_high_water.max(self.database_id);
+        let mut ids = BTreeSet::new();
+        for schema in self.tables.values() {
+            if schema.object_id != 0 && !ids.insert(schema.object_id) {
+                return Err(io::Error::other("duplicate catalog object id"));
+            }
+            self.object_high_water = self.object_high_water.max(schema.object_id);
+        }
+        for schema in self.tables.values_mut() {
+            if schema.object_id == 0 {
+                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;
+            }
+        }
+        Ok(())
+    }
+
+    /// 分配不复用的对象编号
+    pub fn reserve_object_id(&mut self) -> io::Result<u64> {
+        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)
     }
 
     /// 返回所有表的 (表名, schema)。
@@ -99,22 +137,37 @@ impl Catalog {
     }
 
     /// 按一行数据补列
-    pub fn ensure_columns(&mut self, table: &str, row: &Row) {
+    pub fn ensure_columns(&mut self, table: &str, row: &Row) -> io::Result<()> {
         let entry = self.tables.entry(table.to_string()).or_default();
-        add_missing_columns(entry, row);
+        add_missing_columns(entry, row)?;
+        Ok(())
     }
 
     /// 建表；已存在报错
     pub fn create_table(&mut self, table: &str, columns: Vec<SchemaColumn>) -> io::Result<()> {
+        self.create_table_with_id(table, columns, None)
+    }
+
+    /// 按日志中的编号建立表
+    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,
                 format!("table already exists: {}", table),
             ));
         }
+        let object_id = match object_id {
+            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 }
+            None => self.reserve_object_id()?,
+        };
         self.tables.insert(
             table.to_string(),
             TableSchema {
+                object_id,
+                schema_version: 1,
                 system: false,
                 columns,
                 dropped_columns: BTreeSet::new(),
@@ -136,15 +189,15 @@ impl Catalog {
     }
 
     /// 记一次插入，返回列有没有变化
-    pub fn record_insert(&mut self, table: &str, row: &Row) -> bool {
+    pub fn record_insert(&mut self, table: &str, row: &Row) -> io::Result<bool> {
         let changed = {
             let entry = self.tables.entry(table.to_string()).or_default();
-            let changed = add_missing_columns(entry, row);
+            let changed = add_missing_columns(entry, row)?;
             entry.row_count += 1;
             changed
         };
         self.count_values(table, row);
-        changed
+        Ok(changed)
     }
 
     /// 记一次删除：行数减少 + 更新列统计
@@ -182,18 +235,30 @@ impl Catalog {
     }
 
     /// 重数一遍统计与行数
-    pub fn rebuild_stats(&mut self, table: &str, rows: &[Row]) -> bool {
+    pub fn rebuild_stats(&mut self, table: &str, rows: &[Row]) -> io::Result<bool> {
         self.seen.remove(table);
         {
             let entry = self.tables.entry(table.to_string()).or_default();
             entry.stats.clear();
             entry.row_count = 0;
+            for row in rows {
+                for (name, value) in row {
+                    if let Some(x) = value.as_f64() {
+                        let stat = entry.stats.entry(name.clone()).or_default();
+                        stat.lo = Some(stat.lo.map_or(x, |lo| lo.min(x)));
+                        stat.hi = Some(stat.hi.map_or(x, |hi| hi.max(x)));
+                        if stat.hist.is_empty() {
+                            stat.hist = vec![0; HIST_BUCKETS];
+                        }
+                    }
+                }
+            }
         }
         let mut changed = false;
         for row in rows {
-            changed = self.record_insert(table, row) || changed;
+            changed = self.record_insert(table, row)? || changed;
         }
-        changed
+        Ok(changed)
     }
 
     /// 这一列第一次见到这个值就加一
@@ -231,16 +296,18 @@ impl Catalog {
 
     /// 表改名到指定名字
     pub fn rename_table(&mut self, from: &str, to: &str) -> io::Result<bool> {
-        let Some(entry) = self.tables.remove(from) else {
+        let Some(entry) = self.tables.get(from) else {
             return Ok(false);
         };
         if self.tables.contains_key(to) {
-            self.tables.insert(from.to_string(), entry);
             return Err(io::Error::new(
                 io::ErrorKind::AlreadyExists,
                 format!("table already exists: {}", to),
             ));
         }
+        let version = next_schema_version(entry)?;
+        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);
         Ok(true)
@@ -248,10 +315,21 @@ impl Catalog {
 
     /// ALTER：整列定义换成新的，并清掉二级索引与统计
     pub fn set_columns(&mut self, table: &str, columns: Vec<SchemaColumn>) -> io::Result<()> {
+        self.set_columns_version(table, columns, None)
+    }
+
+    /// 用日志中的目标版本替换列定义
+    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")); }
+            entry.schema_version = version;
+        } else if entry.columns != columns {
+            entry.schema_version = next_schema_version(entry)?;
+        }
         entry.columns = columns;
         entry.dropped_columns.clear();
         entry.indexes.clear();
@@ -261,9 +339,12 @@ impl Catalog {
     }
 
     /// 老数据的列类型名规范化；返回有没有改动
-    pub fn normalize_types(&mut self) -> bool {
+    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) {
+                entry.schema_version = next_schema_version(entry)?;
+            }
             for column in entry.columns.iter_mut() {
                 let fixed = normalize_type(&column.ty);
                 if fixed != column.ty {
@@ -272,15 +353,26 @@ impl Catalog {
                 }
             }
         }
-        changed
+        Ok(changed)
     }
 
     /// 删一列；之前没有也返回成功（重放幂等）
     pub fn remove_column(&mut self, table: &str, column: &str) -> io::Result<bool> {
+        self.remove_column_version(table, column, None)
+    }
+
+    /// 用日志目标版本删除列定义
+    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")); }
+            entry.schema_version = version;
+        } else if entry.columns.iter().any(|c| c.name == column) {
+            entry.schema_version = next_schema_version(entry)?;
+        }
         let had_column = {
             let before = entry.columns.len();
             entry.columns.retain(|c| c.name != column);
@@ -357,22 +449,24 @@ impl Catalog {
 }
 
 /// 把行里"字典还不知道的列"补进来；返回有没有变化
-fn add_missing_columns(entry: &mut TableSchema, row: &Row) -> bool {
+fn add_missing_columns(entry: &mut TableSchema, row: &Row) -> io::Result<bool> {
-    let mut changed = false;
+    let additions: Vec<_> = row.iter().filter(|(name, _)|
-    for (k, v) in row {
+        !entry.dropped_columns.contains(*name) && !entry.columns.iter().any(|c| &c.name == *name))
-        if entry.dropped_columns.contains(k) || entry.columns.iter().any(|c| &c.name == k) {
+        .filter_map(|(name, value)| infer_type(value).map(|ty| SchemaColumn {
-            continue;
+            name: name.clone(), ty, ..Default::default()
+        })).collect();
+    if additions.is_empty() {
+        return Ok(false);
     }
-        if let Some(ty) = infer_type(v) {
+    entry.schema_version = next_schema_version(entry)?;
-            entry.columns.push(SchemaColumn {
+    entry.columns.extend(additions);
-                name: k.clone(),
+    Ok(true)
-                ty,
+}
-                ..Default::default()
+
-            });
+/// 递增结构版本，耗尽时拒绝变更
-            changed = true;
+fn next_schema_version(entry: &TableSchema) -> io::Result<u64> {
-        }
+    entry.schema_version.checked_add(1)
-    }
+        .ok_or_else(|| io::Error::other("catalog schema version exhausted"))
-    changed
 }
 
 /// 由 JSON 值猜列类型

chusql-core/storage/src/config.rs

@@ -229,17 +229,17 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
         DEFAULT_POOL_SIZE,
         &file_origin,
     );
+    let storage = file.storage.unwrap_or_default();
     let (data_dir, dir_origin) = pick(
-        file.storage.as_ref().and_then(|s| s.data_dir.clone()),
+        storage.data_dir,
         default_data_dir().to_string_lossy().into_owned(),
         &file_origin,
     );
     let (log_files, log_files_origin) = pick(
-        file.storage.as_ref().and_then(|s| s.log_files.clone()),
+        storage.log_files,
         DEFAULT_LOG_FILES.to_string(),
         &file_origin,
     );
-    // 管名已经没有了：存储不再是独立进程，管道/套接字那一层随 FFI 一起删掉
     let (log_level, log_origin) = pick(
         file.log.and_then(|l| l.level),
         DEFAULT_LOG_LEVEL.to_string(),
@@ -248,9 +248,9 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
 
     let data_dir = data_dir.trim().to_string();
     let log_files = log_files.trim().to_string();
-    let log_level = log_level.trim().to_string();
+    let log_level = log_level.trim();
 
-    let log_level = Level::parse(&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() {
@@ -318,38 +318,3 @@ fn validate_layout(page_size: usize, btree_order: usize) -> Result<(), String> {
     }
     Ok(())
 }
-
-#[cfg(test)]
-mod tests {
-    use super::*;
-
-    /// 别的层的分区不能被当成错误
-    #[test]
-    fn ignores_sections_owned_by_other_layers() {
-        let text = r#"
-[page]
-size = 8192
-
-[storage]
-data_dir = "../data"
-
-[server]
-listen_host = "127.0.0.1"
-port = 7777
-max_message = 1048576
-
-[web]
-port = 7778
-"#;
-        let loaded = resolve(Some(text), Some(PathBuf::from("settings.toml"))).unwrap();
-        assert_eq!(loaded.config.page_size, 8192);
-        assert_eq!(loaded.config.data_dir, PathBuf::from("../data"));
-    }
-
-    /// 自己分区里的拼写错误仍然要报错
-    #[test]
-    fn still_rejects_typos_inside_its_own_sections() {
-        let text = "[page]\npage_size = 8192\n";
-        assert!(resolve(Some(text), None).is_err());
-    }
-}

chusql-core/storage/src/ffi.rs

@@ -74,14 +74,19 @@ pub unsafe extern "C" fn chusql_storage_close(handle: *mut Storage) {
 /// 离线维护系统目录并返回 JSON
 ///
 /// # Safety
-/// 输入为有效字符串；输出指针可写，响应使用 free 释放。
+/// `config_path` 为 NULL 或有效 NUL 结尾字符串；请求字节在调用期间有效。
+/// 输出指针可写且不与输入重叠；响应使用 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,
 ) -> i32 {
-    if request.is_null() || out.is_null() || out_len.is_null() { set_error("invalid maintenance argument"); return ERR; }
+    if !out.is_null() { unsafe { *out = ptr::null_mut(); } }
-    unsafe { *out = ptr::null_mut(); *out_len = 0; }
+    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())?;
@@ -92,16 +97,16 @@ pub unsafe extern "C" fn chusql_storage_maintenance(
         Ok(Err(err)) => { set_error(err); return ERR; }
         Err(_) => { set_error("panic in system maintenance"); return ERR; }
     };
-    let mut buffer = response.into_bytes().into_boxed_slice();
+    let buffer = response.into_bytes().into_boxed_slice();
-    unsafe { *out = buffer.as_mut_ptr(); *out_len = buffer.len(); }
+    unsafe { *out_len = buffer.len(); *out = Box::into_raw(buffer) as *mut u8; }
-    std::mem::forget(buffer);
     OK
 }
 
 /// 处理一条请求，响应缓冲须归还
 ///
 /// # Safety
-/// `handle` 必须是有效句柄；`request` 指向 `request_len` 个字节；`out`/`out_len` 可写。
+/// `handle` 在调用期间有效且不能并发关闭；请求字节在调用期间有效。
+/// `out`/`out_len` 可写且不与输入重叠；响应使用 free 释放。
 #[unsafe(no_mangle)]
 pub unsafe extern "C" fn chusql_storage_request(
     handle: *const Storage,
@@ -116,7 +121,7 @@ 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() {
+    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;
     }
@@ -139,13 +144,10 @@ pub unsafe extern "C" fn chusql_storage_request(
         }
     };
 
-    let mut buffer = response.into_bytes().into_boxed_slice();
+    let buffer = response.into_bytes().into_boxed_slice();
-    let ptr = buffer.as_mut_ptr();
-    let len = buffer.len();
-    std::mem::forget(buffer);
     unsafe {
-        *out = ptr;
+        *out_len = buffer.len();
-        *out_len = len;
+        *out = Box::into_raw(buffer) as *mut u8;
     }
     OK
 }
@@ -153,7 +155,7 @@ pub unsafe extern "C" fn chusql_storage_request(
 /// 归还响应缓冲
 ///
 /// # Safety
-/// `data`/`len` 必须是 chusql_storage_request 原样返回且未被释放过的一对值。
+/// `data`/`len` 为 request 或 maintenance 原样返回且未释放的一对值。
 #[unsafe(no_mangle)]
 pub unsafe extern "C" fn chusql_storage_free(data: *mut u8, len: usize) {
     if data.is_null() {
@@ -168,7 +170,7 @@ pub unsafe extern "C" fn chusql_storage_free(data: *mut u8, len: usize) {
 /// 取本线程最近的失败信息
 ///
 /// # Safety
-/// `out_len` 可写，或为 NULL。
+/// `out_len` 可写，或为 NULL；返回字节仅在本线程下次设置错误前有效，不能释放。
 #[unsafe(no_mangle)]
 pub unsafe extern "C" fn chusql_storage_last_error(out_len: *mut usize) -> *const u8 {
     LAST_ERROR.with(|slot| {

chusql-core/storage/src/protocol.rs

@@ -25,6 +25,8 @@ pub struct Account {
     pub is_superuser: bool,
     #[serde(default)]
     pub system_catalog_manager: bool,
+    #[serde(default)]
+    pub allow_sudo_auth: bool,
     #[serde(default = "default_true")]
     pub enabled: bool,
     #[serde(default)]
@@ -96,7 +98,7 @@ pub enum 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> },
+    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 {
@@ -120,6 +122,7 @@ pub enum Request {
         #[serde(default)]
         columns: Option<Vec<String>>,
     },
+    ValidateWrite { table: String },
     /// 分片扫描：第 shard 片只读总页数按 shards 均分后的那一段
     ScanShard {
         table: String,
@@ -229,7 +232,7 @@ impl Request {
     /// 普通表操作的统一访问边界
     pub fn table(&self) -> Option<&str> {
         match self {
-            Self::Scan { table, .. } | Self::ScanShard { 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, .. }
@@ -281,12 +284,15 @@ 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> },
     Pong,
     Rows { rows: Vec<Row> },
     Tables { tables: Vec<String> },
     Schema {
         table: String,
+        #[serde(default, serialize_with = "serialize_version", deserialize_with = "deserialize_version")]
+        schema_version: u64,
         columns: Vec<SchemaColumn>,
         #[serde(default)]
         row_count: u64,
@@ -305,11 +311,27 @@ pub enum Response {
     },
     Error { message: String },
     Catalog { schemas: Vec<TableSchemaWire> },
+    Object { database_id: u64, object_id: Option<u64> },
+}
+
+#[derive(Debug, Deserialize)]
+pub struct BoundSchema {
+    pub table: String,
+    pub database_id: Option<String>,
+    pub object_id: Option<String>,
+    pub schema_version: Option<String>,
+    pub columns: Vec<SchemaColumn>,
 }
 
 #[derive(Debug, Clone, Serialize, Deserialize)]
 pub struct TableSchemaWire {
     pub table: String,
+    #[serde(default)]
+    pub database_id: u64,
+    #[serde(default)]
+    pub object_id: u64,
+    #[serde(default, serialize_with = "serialize_version", deserialize_with = "deserialize_version")]
+    pub schema_version: u64,
     pub columns: Vec<SchemaColumn>,
     #[serde(default)]
     pub row_count: u64,
@@ -318,3 +340,19 @@ pub struct TableSchemaWire {
     #[serde(default)]
     pub stats: Vec<ColumnStatWire>,
 }
+
+/// 将结构版本编码成精确十进制字符串
+fn serialize_version<S: serde::Serializer>(version: &u64, serializer: S) -> Result<S::Ok, S::Error> {
+    serializer.serialize_str(&version.to_string())
+}
+
+/// 读取精确版本并兼容旧数值载荷
+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")),
+        _ => Err(serde::de::Error::custom("invalid schema version")),
+    }
+}

chusql-core/storage/src/runtime.rs

@@ -30,10 +30,48 @@ struct Server {
 type TableDescription = (Vec<SchemaColumn>, u64, Vec<IndexWire>, Vec<ColumnStatWire>);
 
 impl Server {
+    /// 读取受保护的对象权限快照
+    fn object_acl_read(&self) -> std::io::Result<Vec<Row>> {
+        if !self.table_exists("__system_object_acl")? { return Ok(Vec::new()); }
+        let rows = self.with_existing_table("__system_object_acl", |table| table.scan())?;
+        let mut payload = String::new();
+        for (index, row) in rows.iter().enumerate() {
+            if row.get("id").and_then(|value| value.as_u64()) != Some(index as u64 + 1) {
+                return Err(std::io::Error::other("invalid object ACL chunk sequence"));
+            }
+            payload.push_str(row.get("payload").and_then(|value| value.as_str())
+                .ok_or_else(|| std::io::Error::other("invalid object ACL chunk"))?);
+        }
+        if rows.is_empty() { return Err(std::io::Error::other("empty object ACL snapshot")); }
+        Ok(vec![serde_json::from_value(serde_json::json!({"id":1,"payload":payload})).map_err(std::io::Error::other)?])
+    }
+
+    /// 比较并原子替换对象权限快照
+    fn object_acl_replace(&self, expected: Option<&str>, payload: &str) -> std::io::Result<()> {
+        let rows = self.object_acl_read()?;
+        let current = rows.first().and_then(|row| row.get("payload")).and_then(|value| value.as_str());
+        if current != expected { return Err(std::io::Error::other("object ACL changed concurrently")); }
+        let _: serde_json::Value = serde_json::from_str(payload).map_err(std::io::Error::other)?;
+        let mut ops = Vec::new();
+        if !self.table_exists("__system_object_acl")? {
+            ops.push(WalOp::CreateTable { table: "__system_object_acl".into(),
+                columns: vec![SchemaColumn { name: "id".into(), ty: "int".into(), ..Default::default() },
+                    SchemaColumn { name: "payload".into(), ty: "str".into(), ..Default::default() }], object_id: None });
+        }
+        let chars: Vec<char> = payload.chars().collect();
+        let rows = chars.chunks(256).enumerate().map(|(index, chunk)| {
+            serde_json::from_value(serde_json::json!({"id":index + 1,"payload":chunk.iter().collect::<String>()}))
+                .map_err(std::io::Error::other)
+        }).collect::<std::io::Result<Vec<Row>>>()?;
+        ops.push(WalOp::ReplaceAll { table: "__system_object_acl".into(), rows });
+        self.group_via_wal(&ops)
+    }
+
     /// 新建服务器状态
     fn new(cfg: Config) -> std::io::Result<Self> {
         std::fs::create_dir_all(&cfg.data_dir)?;
         let catalog = Catalog::load(cfg.data_dir.join("catalog.json"))?;
+        catalog.save(cfg.data_dir.join("catalog.json"))?;
         let wal = Wal::new(cfg.data_dir.join("wal.log"));
         Ok(Server {
             cfg,
@@ -198,9 +236,9 @@ impl Server {
     fn apply_op(&self, op: &WalOp) -> std::io::Result<()> {
         match op {
             WalOp::Commit => Ok(()),
-            WalOp::HideColumn { table, column } => {
+            WalOp::HideColumn { table, column, schema_version } => {
                 let mut c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
-                c.remove_column(table, column)?;
+                c.remove_column_version(table, column, *schema_version)?;
                 c.save(self.catalog_path())?;
                 drop(c);
                 if let Some(handle) = self.tables.lock().map_err(|_| std::io::Error::other("table lock poisoned"))?.get(table) {
@@ -219,7 +257,7 @@ impl Server {
                 })?;
                 let mut c = self.catalog.lock().unwrap();
                 c.mark_compacted(table)?;
-                c.rebuild_stats(table, rows);
+                c.rebuild_stats(table, rows)?;
                 c.save(self.catalog_path())
             }
             WalOp::Accounts { accounts, removed, migrate_roles } => {
@@ -249,20 +287,20 @@ impl Server {
                 }
                 let mut c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
                 declare_system_schema(&mut c, &rows)?;
-                c.rebuild_stats(IDENTITIES_TABLE, &identities);
+                c.rebuild_stats(IDENTITIES_TABLE, &identities)?;
                 c.set_columns(IDENTITIES_TABLE, identity_columns())?;
-                c.rebuild_stats(IDENTITIES_TABLE, &identities);
+                c.rebuild_stats(IDENTITIES_TABLE, &identities)?;
                 c.mark_system(IDENTITIES_TABLE)?;
                 c.add_index(IDENTITIES_TABLE, "user")?;
                 c.identity_high_water = c.identity_high_water.max(accounts.iter().map(|a| a.id).max().unwrap_or(0));
-                if has_roles && *migrate_roles { c.rebuild_stats(legacy_roles, &[]); }
+                if has_roles && *migrate_roles { c.rebuild_stats(legacy_roles, &[])?; }
-                for (table, records) in cleaned { c.rebuild_stats(table, &records); }
+                for (table, records) in cleaned { c.rebuild_stats(table, &records)?; }
                 c.save(self.catalog_path())
             }
             WalOp::Insert { table, row } => {
                 self.with_table(table, |t| t.insert_row(row))?;
                 let mut c = self.catalog.lock().unwrap();
-                if c.record_insert(table, row) {
+                if c.record_insert(table, row)? {
                     c.save(self.catalog_path())?;
                 }
                 Ok(())
@@ -272,7 +310,7 @@ impl Server {
                 let mut c = self.catalog.lock().unwrap();
                 let mut changed = false;
                 for r in rows {
-                    if c.record_insert(table, r) {
+                    if c.record_insert(table, r)? {
                         changed = true;
                     }
                 }
@@ -290,27 +328,27 @@ impl Server {
             WalOp::ReplaceAll { table, rows } => {
                 self.with_table(table, |t| t.replace_all(rows))?;
                 let mut c = self.catalog.lock().unwrap();
-                c.rebuild_stats(table, rows);
+                c.rebuild_stats(table, rows)?;
                 c.save(self.catalog_path())
             }
-            WalOp::DropColumn { table, column, rows } => {
+            WalOp::DropColumn { table, column, rows, schema_version } => {
                 self.with_table(table, |t| {
                     t.detach_index(column);
                     t.replace_all(rows)
                 })?;
                 let mut c = self.catalog.lock().unwrap();
-                c.remove_column(table, column)?;
+                c.remove_column_version(table, column, *schema_version)?;
-                c.rebuild_stats(table, rows);
+                c.rebuild_stats(table, rows)?;
                 c.save(self.catalog_path())?;
                 drop(c);
                 let _ = std::fs::remove_file(self.index_path(table, column));
                 Ok(())
             }
-            WalOp::CreateTable { table, columns } => {
+            WalOp::CreateTable { table, columns, object_id } => {
                 self.with_table(table, |_t| Ok(()))?;
                 let mut c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
-                c.create_table(table, columns.clone())?;
+                c.create_table_with_id(table, columns.clone(), *object_id)?;
-                if table == TYPES_TABLE { c.mark_system(table)?; }
+                if table == TYPES_TABLE || table == "__system_object_acl" { c.mark_system(table)?; }
                 c.save(self.catalog_path())
             }
             WalOp::DropTable { table } => {
@@ -336,7 +374,7 @@ impl Server {
             }
             WalOp::CreateIndex { table, column } => self.apply_create_index(table, column),
             WalOp::DropIndex { table, column } => self.apply_drop_index(table, column),
-            WalOp::ReplaceSchema { table, columns, rows } => {
+            WalOp::ReplaceSchema { table, columns, rows, schema_version } => {
                 let old_indexes: Vec<String> = {
                     let c = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
                     c.describe(table)
@@ -351,8 +389,8 @@ impl Server {
                     t.replace_all(rows)
                 })?;
                 let mut c = self.catalog.lock().unwrap();
-                c.set_columns(table, columns.clone())?;
+                c.set_columns_version(table, columns.clone(), *schema_version)?;
-                c.rebuild_stats(table, rows);
+                c.rebuild_stats(table, rows)?;
                 c.save(self.catalog_path())?;
                 drop(c);
                 for col in old_indexes {
@@ -445,7 +483,7 @@ impl Server {
         match op {
             WalOp::Insert { table, row } => validate(table, std::slice::from_ref(row))?,
             WalOp::InsertBatch { table, rows } | WalOp::ReplaceAll { table, rows } => validate(table, rows)?,
-            WalOp::HideColumn { table, column }
+            WalOp::HideColumn { table, column, .. }
                 if !c.describe(table).is_some_and(|s| s.columns.iter().any(|col| &col.name == column)) =>
             {
                 return Err(std::io::Error::other(format!("unknown column: {column}")));
@@ -506,12 +544,45 @@ impl Server {
     fn group_via_wal(&self, ops: &[WalOp]) -> std::io::Result<()> {
         std::fs::create_dir_all(&self.cfg.data_dir)?;
         let wal = &self.wal;
-        let commit_lsn = wal.append_group(ops)?;
+        let mut ops = std::borrow::Cow::Borrowed(ops);
+        if ops.iter().any(|op| matches!(op, WalOp::CreateTable { object_id: None, .. })) {
+            let mut catalog = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
+            for op in ops.to_mut() {
+                if let WalOp::CreateTable { object_id, .. } = op
+                    && object_id.is_none() {
+                    *object_id = Some(catalog.reserve_object_id()?);
+                }
+            }
+        }
+        if ops.iter().any(|op| matches!(op, WalOp::HideColumn { .. } | WalOp::DropColumn { .. } | WalOp::ReplaceSchema { .. })) {
+            let mut preview = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?.clone();
+            for op in ops.to_mut() {
+                match op {
+                    WalOp::HideColumn { table, column, schema_version }
+                    | WalOp::DropColumn { table, column, schema_version, .. } => {
+                        preview.remove_column(table, column)?;
+                        *schema_version = Some(preview.describe(table).ok_or_else(|| std::io::Error::other("missing schema version"))?.schema_version.max(1));
+                    }
+                    WalOp::ReplaceSchema { table, columns, schema_version, .. } => {
+                        preview.set_columns(table, columns.clone())?;
+                        *schema_version = Some(preview.describe(table).ok_or_else(|| std::io::Error::other("missing schema version"))?.schema_version.max(1));
+                    }
+                    WalOp::CreateTable { table, columns, object_id } => preview.create_table_with_id(table, columns.clone(), *object_id)?,
+                    WalOp::DropTable { table } => preview.drop_table(table)?,
+                    WalOp::Insert { table, row } => preview.ensure_columns(table, row)?,
+                    WalOp::InsertBatch { table, rows } | WalOp::ReplaceAll { table, rows } => {
+                        for row in rows { preview.ensure_columns(table, row)?; }
+                    }
+                    _ => {}
+                }
+            }
+        }
+        let commit_lsn = wal.append_group(&ops)?;
         self.recovery_required.store(true, Ordering::Release);
-        for op in ops {
+        for op in ops.iter() {
             self.apply_op(op)?;
         }
-        for op in ops {
+        for op in ops.iter() {
             self.flush_op_tables(op)?;
         }
         self.flush_all_tables()?;
@@ -635,11 +706,21 @@ impl Server {
                 });
                 Ok(!present)
             }
-            WalOp::HideColumn { table, column } => {
+            WalOp::HideColumn { table, column, schema_version } => {
                 let c = self.catalog.lock().unwrap();
-                Ok(c.describe(table).is_some_and(|s| !s.columns.iter().any(|col| &col.name == column)))
+                Ok(c.describe(table).is_some_and(|s| !s.columns.iter().any(|col| &col.name == column)
+                    && schema_version.is_none_or(|version| s.schema_version == version)))
+            }
+            WalOp::CreateTable { table, object_id, .. } => {
+                let catalog = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
+                match catalog.describe(table) {
+                    Some(schema) if object_id.is_some_and(|id| id != schema.object_id) => {
+                        Err(std::io::Error::other("WAL catalog object id mismatch"))
+                    }
+                    Some(_) => Ok(true),
+                    None => Ok(false),
+                }
             }
-            WalOp::CreateTable { table, .. } => self.table_exists(table),
             WalOp::DropTable { table } => Ok(!self.table_exists(table)?
                 && !self.table_path(table).exists()
                 && !self.index_path(table, "id").exists()),
@@ -682,7 +763,7 @@ impl Server {
             }
             let rows = self.with_table(&table, |t| t.scan())?;
             let mut c = self.catalog.lock().unwrap();
-            c.rebuild_stats(&table, &rows);
+            c.rebuild_stats(&table, &rows)?;
             touched = true;
         }
         if touched {
@@ -734,7 +815,7 @@ impl Server {
             .catalog
             .lock()
             .map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
-        if catalog.normalize_types() {
+        if catalog.normalize_types()? {
             catalog.save(self.catalog_path())?;
         }
         Ok(())
@@ -897,6 +978,7 @@ impl Server {
         let op = WalOp::HideColumn {
             table: table.to_string(),
             column: column.to_string(),
+            schema_version: None,
         };
         self.write_via_wal(&op)
     }
@@ -964,17 +1046,12 @@ impl Server {
         }
     }
 
-    /// 系统目录里账号表已登记
+    /// 读取系统初始化状态与检查点 LSN
-    fn system_initialized(&self) -> bool {
+    fn system_status(&self) -> std::io::Result<Response> {
-        self.catalog
+        let initialized = self.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?
-            .lock()
+            .describe(USERS_TABLE).is_some_and(|schema| schema.system);
-            .map(|c| c.describe(USERS_TABLE).is_some_and(|schema| schema.system))
+        let last_lsn = self.wal.read_checkpoint()?.unwrap_or(0);
-            .unwrap_or(false)
+        Ok(Response::System { initialized, last_lsn })
-    }
-
-    /// 最近一次落盘的检查点 LSN
-    fn last_checkpoint(&self) -> u64 {
-        self.wal.read_checkpoint().ok().flatten().unwrap_or(0)
     }
 
     /// 读账号表；表没登记或数据文件缺失都算错
@@ -1063,11 +1140,11 @@ impl Server {
             Request::CatalogManage { command } => {
                 let target = match command.as_ref() {
                     Request::AccountCreate { user, .. } | Request::AccountReset { user, .. } | Request::AccountDrop { user }
-                        | Request::IdentityAlter { user, is_superuser: None, system_catalog_manager: None, .. } => Some(account_name(user)?),
+                        | Request::IdentityAlter { user, is_superuser: None, system_catalog_manager: None, allow_sudo_auth: None, .. } => Some(account_name(user)?),
                     Request::AccountsList => None,
                     _ => return Err(Error::other("superuser required for this catalog operation")),
                 };
-                if accounts.iter().any(|a| target.as_ref() == Some(&a.user) && (a.is_superuser || a.system_catalog_manager)) {
+                if accounts.iter().any(|a| target.as_ref() == Some(&a.user) && (a.is_superuser || a.system_catalog_manager || a.allow_sudo_auth)) {
                     return Err(Error::other("superuser required to manage privileged identities"));
                 }
                 *command
@@ -1116,10 +1193,13 @@ impl Server {
                 }
                 let unified = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.describe(IDENTITIES_TABLE).is_some();
                 if !accounts.is_empty() { require_superuser(&accounts)?; }
-                if unified && previous == accounts { return Ok(accounts); }
+                let sudo_column = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.describe(IDENTITIES_TABLE)
+                    .is_some_and(|schema| schema.columns.iter().any(|column| column.name == "allow_sudo_auth"));
+                if unified && sudo_column && previous == accounts { return Ok(accounts); }
             }
             Request::AccountCreate { user, password_hash } => {
                 let name = account_name(&user)?;
+                if name == "public" { return Err(Error::other("public is reserved for default privileges")); }
                 if accounts.iter().any(|a| a.user == name) {
                     return Err(Error::new(ErrorKind::AlreadyExists, "account already exists"));
                 }
@@ -1129,6 +1209,7 @@ impl Server {
             }
             Request::RoleCreate { user } => {
                 let name = account_name(&user)?;
+                if name == "public" { return Err(Error::other("public is reserved for default privileges")); }
                 if accounts.iter().any(|a| a.user == name) { return Err(Error::new(ErrorKind::AlreadyExists, "identity already exists")); }
                 let id = accounts.iter().map(|a| a.id).max().unwrap_or(0).max(self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.identity_high_water)
                     .checked_add(1).ok_or_else(|| Error::other("account id exhausted"))?;
@@ -1136,13 +1217,14 @@ impl Server {
                 role.can_login = false;
                 accounts.push(role);
             }
-            Request::IdentityAlter { user, can_login, is_superuser, enabled, system_catalog_manager } => {
+            Request::IdentityAlter { user, can_login, is_superuser, enabled, system_catalog_manager, allow_sudo_auth } => {
                 let name = account_name(&user)?;
                 let account = accounts.iter_mut().find(|a| a.user == name).ok_or_else(|| Error::new(ErrorKind::NotFound, "unknown account"))?;
                 account.can_login = can_login.unwrap_or(account.can_login);
                 account.is_superuser = is_superuser.unwrap_or(account.is_superuser);
                 account.enabled = enabled.unwrap_or(account.enabled);
                 account.system_catalog_manager = system_catalog_manager.unwrap_or(account.system_catalog_manager);
+                account.allow_sudo_auth = allow_sudo_auth.unwrap_or(account.allow_sudo_auth);
                 account.revision = account.revision.checked_add(1).ok_or_else(|| Error::other("account revision exhausted"))?;
                 if had_superuser { require_superuser(&accounts)?; }
             }
@@ -1226,7 +1308,7 @@ impl Server {
         }
         if existing.is_some() && original == rows { return Ok(rows); }
         let mut ops = Vec::new();
-        if existing.is_none() { ops.push(WalOp::CreateTable { table: TYPES_TABLE.into(), columns }); }
+        if existing.is_none() { ops.push(WalOp::CreateTable { table: TYPES_TABLE.into(), columns, object_id: None }); }
         ops.push(WalOp::ReplaceAll { table: TYPES_TABLE.into(), rows: rows.clone() });
         self.recovery_required.store(true, Ordering::Release);
         self.group_via_wal(&ops)?;
@@ -1253,6 +1335,32 @@ impl Server {
         }
     }
 
+    /// 持库门时复查绑定身份、版本和列定义
+    fn validate_bound_schema(&self, table: &str, expected: &crate::protocol::BoundSchema) -> std::io::Result<()> {
+        use std::io::Error;
+        if self.recovery_required.load(Ordering::Acquire) { return Err(Error::other("storage recovery required")); }
+        if blocked_table(table) { return Err(Error::other("reserved system table")); }
+        let catalog = self.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?;
+        let actual = catalog.describe(table).ok_or_else(|| Error::other(format!("bound query schema changed: {}", expected.table)))?;
+        match (&expected.database_id, &expected.object_id) {
+            (Some(database), Some(object)) => {
+                if parse_bound_number(database)? != catalog.database_id || parse_bound_number(object)? != actual.object_id {
+                    return Err(Error::other(format!("bound query object changed: {}", expected.table)));
+                }
+            }
+            (None, None) => {}
+            _ => return Err(Error::other("incomplete bound object identity")),
+        }
+        if let Some(version) = &expected.schema_version
+            && parse_bound_number(version)? != actual.schema_version {
+            return Err(Error::other(format!("bound query schema changed: {}", expected.table)));
+        }
+        if expected.columns != actual.columns {
+            return Err(Error::other(format!("bound query schema changed: {}", expected.table)));
+        }
+        Ok(())
+    }
+
     /// 持门后分发一条请求
     fn dispatch(&self, req: Request) -> Response {
         if self.recovery_required.load(Ordering::Acquire) && !matches!(req, Request::Ping) {
@@ -1270,6 +1378,7 @@ impl Server {
             }
         }
         match req {
+            Request::ValidateWrite { .. } => Response::Ok,
             Request::BootstrapTypes { types } => match self.bootstrap_types(types) {
                 Ok(rows) => Response::Rows { rows },
                 Err(e) => Response::Error { message: e.to_string() },
@@ -1284,12 +1393,12 @@ impl Server {
                 }
             }
             Request::BootstrapSystem { user, password_hash } => {
-                match self.bootstrap_system(user.as_deref(), password_hash.as_deref()) {
+                match self.bootstrap_system(user.as_deref(), password_hash.as_deref()).and_then(|_| self.system_status()) {
-                    Ok(_) => Response::System { initialized: true, last_lsn: self.last_checkpoint() },
+                    Ok(response) => response,
                     Err(e) => Response::Error { message: e.to_string() },
                 }
             }
-            Request::SystemStatus => Response::System { initialized: self.system_initialized(), last_lsn: self.last_checkpoint() },
+            Request::SystemStatus => self.system_status().unwrap_or_else(|e| Response::Error { message: e.to_string() }),
             Request::Ping => {
                 log_debug!(request, "ping");
                 Response::Pong
@@ -1499,6 +1608,9 @@ impl Server {
                     .filter(|(name, _)| !blocked_table(name))
                     .map(|(name, ts)| TableSchemaWire {
                         table: name.to_string(),
+                        database_id: c.database_id,
+                        object_id: ts.object_id,
+                        schema_version: ts.schema_version,
                         columns: ts.columns.clone(),
                         row_count: ts.row_count,
                         indexes: index_wires(ts),
@@ -1512,6 +1624,7 @@ impl Server {
                 log_debug!(request, "describe_table table={}", table);
                 match self.describe_table(&table) {
                     Ok((cols, count, indexes, stats)) => Response::Schema {
+                        schema_version: self.catalog.lock().unwrap().describe(&table).map_or(0, |s| s.schema_version),
                         table,
                         columns: cols,
                         row_count: count,
@@ -1543,7 +1656,7 @@ impl Server {
                     };
                 }
                 let tname = table.clone();
-                let op = WalOp::CreateTable { table, columns };
+                let op = WalOp::CreateTable { table, columns, object_id: None };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
@@ -1654,7 +1767,7 @@ impl Server {
             Request::ReplaceSchema { table, columns, rows } => {
                 log_debug!(request, "replace_schema table={} cols={}", table, columns.len());
                 let tname = table.clone();
-                let op = WalOp::ReplaceSchema { table, columns, rows };
+                let op = WalOp::ReplaceSchema { table, columns, rows, schema_version: None };
                 match self.write_via_wal(&op) {
                     Ok(()) => Response::Ok,
                     Err(e) => {
@@ -1733,6 +1846,7 @@ fn identity_rows(accounts: &[Account]) -> std::io::Result<Vec<Row>> {
         ("can_login".into(), serde_json::json!(a.can_login)),
         ("is_superuser".into(), serde_json::json!(a.is_superuser)),
         ("system_catalog_manager".into(), serde_json::json!(a.system_catalog_manager)),
+        ("allow_sudo_auth".into(), serde_json::json!(a.allow_sudo_auth)),
         ("enabled".into(), serde_json::json!(a.enabled)),
         ("identity_version".into(), serde_json::json!(a.identity_version)),
         ("registered_at".into(), serde_json::Value::String(a.registered_at.clone())),
@@ -1764,6 +1878,7 @@ fn identity_columns() -> Vec<SchemaColumn> {
         SchemaColumn { name: "can_login".into(), ty: "bool".into(), nullable: false, ..Default::default() },
         SchemaColumn { name: "is_superuser".into(), ty: "bool".into(), nullable: false, ..Default::default() },
         SchemaColumn { name: "system_catalog_manager".into(), ty: "bool".into(), nullable: false, ..Default::default() },
+        SchemaColumn { name: "allow_sudo_auth".into(), ty: "bool".into(), nullable: false, ..Default::default() },
         SchemaColumn { name: "enabled".into(), ty: "bool".into(), nullable: false, ..Default::default() },
         SchemaColumn { name: "identity_version".into(), ty: "int".into(), nullable: false, ..Default::default() },
         SchemaColumn { name: "registered_at".into(), ty: "timestamp".into(),
@@ -1777,9 +1892,9 @@ fn identity_columns() -> Vec<SchemaColumn> {
 
 /// 把系统表写进字典
 fn declare_system_schema(catalog: &mut Catalog, rows: &[Row]) -> std::io::Result<()> {
-    catalog.rebuild_stats(USERS_TABLE, rows);
+    catalog.rebuild_stats(USERS_TABLE, rows)?;
     catalog.set_columns(USERS_TABLE, users_columns())?;
-    catalog.rebuild_stats(USERS_TABLE, rows);
+    catalog.rebuild_stats(USERS_TABLE, rows)?;
     catalog.mark_system(USERS_TABLE)?;
     Ok(())
 }
@@ -1805,6 +1920,10 @@ fn decode_account_row(row: &Row) -> std::io::Result<Account> {
         can_login: row.get("can_login").and_then(serde_json::Value::as_bool).unwrap_or(true),
         is_superuser: row.get("is_superuser").and_then(serde_json::Value::as_bool).unwrap_or(false),
         system_catalog_manager: row.get("system_catalog_manager").and_then(serde_json::Value::as_bool).unwrap_or(false),
+        allow_sudo_auth: match row.get("allow_sudo_auth") {
+            None => false,
+            Some(value) => value.as_bool().ok_or_else(|| std::io::Error::other("invalid sudo authentication attribute"))?,
+        },
         enabled: row.get("enabled").and_then(serde_json::Value::as_bool).unwrap_or(true),
         identity_version: row.get("identity_version").and_then(serde_json::Value::as_u64).unwrap_or(0) as u8,
     })
@@ -1880,6 +1999,7 @@ fn new_account(id: i64, user: &str, password_hash: String) -> std::io::Result<Ac
         can_login: true,
         is_superuser: false,
         system_catalog_manager: false,
+        allow_sudo_auth: false,
         enabled: true,
         identity_version: 1,
     })
@@ -2019,7 +2139,37 @@ impl Databases {
                 named.insert(name, Arc::new(server));
             }
         }
-        Ok(Self { root: cfg, system, named: Mutex::new(named) })
+        {
+            let mut catalog = system.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
+            let mut ids = HashSet::new();
+            if catalog.database_id != 0 { ids.insert(catalog.database_id); }
+            for server in named.values() {
+                let id = server.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?.database_id;
+                if id != 0 && !ids.insert(id) { return Err(std::io::Error::other("duplicate database object id")); }
+                catalog.object_high_water = catalog.object_high_water.max(id);
+            }
+            if catalog.database_id == 0 { catalog.database_id = catalog.reserve_object_id()?; }
+            catalog.save(system.catalog_path())?;
+        }
+        let databases = Self { root: cfg, system, named: Mutex::new(named) };
+        {
+            let named = databases.named.lock().map_err(|_| std::io::Error::other("database lock poisoned"))?;
+            for server in named.values() { databases.assign_database_id(server)?; }
+        }
+        Ok(databases)
+    }
+
+    /// 为数据库持久化不复用的编号
+    fn assign_database_id(&self, server: &Server) -> std::io::Result<()> {
+        let mut catalog = server.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
+        if catalog.database_id == 0 {
+            let mut system = self.system.catalog.lock().map_err(|_| std::io::Error::other("catalog lock poisoned"))?;
+            let id = system.reserve_object_id()?;
+            system.save(self.system.catalog_path())?;
+            catalog.database_id = id;
+            catalog.save(server.catalog_path())?;
+        }
+        Ok(())
     }
 
     /// 按名字打开或新建一个库
@@ -2041,6 +2191,17 @@ impl Databases {
     fn request(&self, mut value: serde_json::Value) -> std::io::Result<Response> {
         use std::io::Error;
         let method = value.get("method").and_then(|v| v.as_str()).unwrap_or("").to_string();
+        if method == "validate_write" && value.get("schema_guard").is_none() {
+            return Err(Error::other("write validation requires a schema guard"));
+        }
+        let guarded_write = if value.get("schema_guard").is_some() {
+            match method.as_str() {
+                "scan" | "scan_shard" | "lookup_by_index" | "range_by_index" | "validate_write" => false,
+                "insert" | "insert_batch" | "delete_keys" | "replace_all" | "replace_schema"
+                    | "drop_column" | "drop_table" | "create_index" | "drop_index" => true,
+                _ => return Err(Error::other("schema guard requires a supported table operation")),
+            }
+        } else { false };
         let name = match value.get("database") {
             None => String::new(),
             Some(serde_json::Value::String(s)) => s.to_ascii_lowercase(),
@@ -2049,6 +2210,42 @@ impl Databases {
         if !name.is_empty() && !valid_database(&name) { return Err(Error::other("invalid database name")); }
         let mut named = self.named.lock().map_err(|_| Error::other("database lock poisoned"))?;
         match method.as_str() {
+            "object_acl_read" => {
+                drop(named);
+                let _gate = self.system.gate.read().map_err(|_| Error::other("database gate poisoned"))?;
+                if self.system.recovery_required.load(Ordering::Acquire) { return Err(Error::other("recovery required")); }
+                return Ok(Response::Rows { rows: self.system.object_acl_read()? });
+            }
+            "object_acl_replace" => {
+                drop(named);
+                let _gate = self.system.gate.write().map_err(|_| Error::other("database gate poisoned"))?;
+                if self.system.recovery_required.load(Ordering::Acquire) { return Err(Error::other("recovery required")); }
+                let expected = match value.get("expected") {
+                    None | Some(serde_json::Value::Null) => None,
+                    Some(serde_json::Value::String(value)) => Some(value.as_str()),
+                    _ => return Err(Error::other("invalid expected ACL payload")),
+                };
+                let payload = value.get("payload").and_then(|value| value.as_str()).ok_or_else(|| Error::other("missing ACL payload"))?;
+                self.system.object_acl_replace(expected, payload)?;
+                return Ok(Response::Ok);
+            }
+            "resolve_object" => {
+                let server = if name == SYSTEM_DATABASE { &self.system }
+                    else { named.get(&name).ok_or_else(|| Error::other("unknown database"))? };
+                let _gate = server.gate.read().map_err(|_| Error::other("database gate poisoned"))?;
+                if server.recovery_required.load(Ordering::Acquire) { return Err(Error::other("recovery required")); }
+                let catalog = server.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?;
+                let object_id = match value.get("table") {
+                    None => None,
+                    Some(serde_json::Value::String(table)) if !blocked_table(table) => {
+                        let schema = catalog.describe(table).ok_or_else(|| Error::other("unknown table"))?;
+                        if schema.object_id == 0 { return Err(Error::other("missing catalog object id")); }
+                        Some(schema.object_id)
+                    }
+                    _ => return Err(Error::other("invalid object table")),
+                };
+                return Ok(Response::Object { database_id: catalog.database_id, object_id });
+            }
             "all_catalogs" => {
                 let servers: Vec<(String, Arc<Server>)> =
                     std::iter::once((SYSTEM_DATABASE.to_string(), Arc::clone(&self.system)))
@@ -2082,6 +2279,7 @@ impl Databases {
                 cfg.data_dir = cfg.data_dir.join("databases").join(&name);
                 std::fs::create_dir(&cfg.data_dir)?;
                 let server = Server::new(cfg)?;
+                self.assign_database_id(&server)?;
                 server.catalog.lock().map_err(|_| Error::other("catalog lock poisoned"))?.save(server.catalog_path())?;
                 named.insert(name, Arc::new(server));
                 return Ok(Response::Ok);
@@ -2125,6 +2323,8 @@ impl Databases {
             selected = database.to_ascii_lowercase();
             value["table"] = serde_json::Value::String(table.to_string());
         }
+        let guard: Option<Vec<crate::protocol::BoundSchema>> = value.get("schema_guard")
+            .map(|guard| serde_json::from_value(guard.clone()).map_err(Error::other)).transpose()?;
         let request: Request = serde_json::from_value(value).map_err(Error::other)?;
         let global = matches!(request, Request::AccountsList | Request::CatalogManage { .. } | Request::AccountCreate { .. }
             | Request::IdentityInitialize { .. } | Request::RoleCreate { .. } | Request::IdentityAlter { .. }
@@ -2135,16 +2335,56 @@ impl Databases {
         if !global && selected.is_empty() { return Err(Error::other("no database selected")); }
         let server = if global || selected == SYSTEM_DATABASE { Arc::clone(&self.system) }
             else { Arc::clone(named.get(&selected).ok_or_else(|| Error::other("unknown database"))?) };
+        if let Some(bindings) = guard {
+            let mut servers = std::collections::BTreeMap::from([(selected.clone(), Arc::clone(&server))]);
+            let mut dependencies = Vec::new();
+            for binding in bindings {
+                let (database, table) = binding.table.split_once('.').unwrap_or((&selected, &binding.table));
+                let database = database.to_ascii_lowercase();
+                if !valid_database(&database) { return Err(Error::other("invalid bound database name")); }
+                let dependency = if database == SYSTEM_DATABASE { Arc::clone(&self.system) }
+                    else { Arc::clone(named.get(&database).ok_or_else(|| Error::other("bound query database changed"))?) };
+                servers.insert(database.clone(), dependency);
+                dependencies.push((database, table.to_owned(), binding));
+            }
+            if !dependencies.iter().any(|(database, table, _)| database == &selected && Some(table.as_str()) == request.table()) {
+                return Err(Error::other("bound table operation has no schema guard"));
+            }
+            drop(named);
+            // 全部库按名称取门；写入目标独占，其他依赖共享。
+            let _gates = servers.iter().map(|(database, server)| {
+                if guarded_write && database == &selected {
+                    server.gate.write().map(|gate| (None, Some(gate)))
+                        .map_err(|_| Error::other("storage write gate poisoned"))
+                } else {
+                    server.gate.read().map(|gate| (Some(gate), None))
+                        .map_err(|_| Error::other("storage read gate poisoned"))
+                }
+            }).collect::<std::io::Result<Vec<_>>>()?;
+            for (database, table, binding) in &dependencies {
+                servers[database].validate_bound_schema(table, binding)?;
+            }
+            return Ok(Response::Guarded { response: Box::new(server.dispatch(request)) });
+        }
         drop(named);
         Ok(server.handle_request(request))
     }
 }
 
+/// 读取守卫中的精确十进制编号
+fn parse_bound_number(value: &str) -> std::io::Result<u64> {
+    if value.is_empty() || value.len() > 20 || !value.bytes().all(|c| c.is_ascii_digit()) {
+        return Err(std::io::Error::other("invalid bound catalog number"));
+    }
+    value.parse().map_err(std::io::Error::other)
+}
+
 /// 只读表页的请求可与其它读并发，其余独占
 fn concurrent_read(req: &Request) -> bool {
     matches!(
         req,
         Request::Scan { .. }
+            | Request::ValidateWrite { .. }
             | Request::ScanShard { .. }
             | Request::LookupByIndex { .. }
             | Request::RangeByIndex { .. }
@@ -2215,7 +2455,11 @@ fn maintenance_candidate(cfg: Config, mode: &str, user: &str, hash: &str, types:
     }
     let repair = mode == "repair";
     let catalog_path = cfg.data_dir.join("catalog.json");
-    let schemas = maintenance_schemas();
+    let mut schemas = maintenance_schemas();
+    if cfg.data_dir.join("__system_object_acl.db").is_file() {
+        schemas.push(("__system_object_acl", vec![SchemaColumn { name: "id".into(), ty: "int".into(), ..Default::default() },
+            SchemaColumn { name: "payload".into(), ty: "str".into(), ..Default::default() }]));
+    }
     let mut missing_data = Vec::new();
     let mut catalog = match Catalog::load(&catalog_path) {
         Ok(catalog) => catalog,

chusql-core/storage/src/wal.rs

@@ -29,7 +29,7 @@ const OP_DROP_INDEX: u8 = 14;
 
 #[derive(Debug, Clone, Serialize, Deserialize, PartialEq)]
 pub enum WalOp {
-    HideColumn { table: String, column: 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 {
@@ -51,16 +51,19 @@ pub enum WalOp {
     DropColumn {
         table: String,
         column: String,
+        schema_version: Option<u64>,
         rows: Vec<Row>,
     },
     ReplaceSchema {
         table: String,
         columns: Vec<SchemaColumn>,
+        schema_version: Option<u64>,
         rows: Vec<Row>,
     },
     CreateTable {
         table: String,
         columns: Vec<SchemaColumn>,
+        object_id: Option<u64>,
     },
     DropTable {
         table: String,
@@ -77,21 +80,34 @@ pub enum WalOp {
     Commit,
 }
 
+#[derive(Debug, Serialize, Deserialize)]
+struct HideColumnPayload {
+    column: String,
+    #[serde(default)]
+    schema_version: Option<u64>,
+}
+
 #[derive(Debug, Serialize, Deserialize)]
 struct DropColumnPayload {
     column: String,
+    #[serde(default)]
+    schema_version: Option<u64>,
     rows: Vec<Row>,
 }
 
 #[derive(Debug, Serialize, Deserialize)]
 struct ReplaceSchemaPayload {
     columns: Vec<SchemaColumn>,
+    #[serde(default)]
+    schema_version: Option<u64>,
     rows: Vec<Row>,
 }
 
 #[derive(Debug, Serialize, Deserialize)]
 struct CreateTablePayload {
     columns: Vec<SchemaColumn>,
+    #[serde(default)]
+    object_id: Option<u64>,
 }
 
 pub struct Wal {
@@ -376,8 +392,8 @@ 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::HideColumn { table, column } => (OP_HIDE_COLUMN, table.clone(),
+        WalOp::HideColumn { table, column, schema_version } => (OP_HIDE_COLUMN, table.clone(),
-            serde_json::to_vec(column).map_err(io::Error::other)?),
+            serde_json::to_vec(&serde_json::json!({"column":column,"schema_version":schema_version})).map_err(io::Error::other)?),
         WalOp::Compact { table, rows } => {
             let p = serde_json::to_vec(rows).map_err(io::Error::other)?;
             (OP_COMPACT, table.clone(), p)
@@ -400,26 +416,28 @@ fn encode(op: &WalOp, lsn: u64) -> io::Result<Vec<u8>> {
             let p = serde_json::to_vec(rows).map_err(io::Error::other)?;
             (OP_REPLACE_ALL, table.clone(), p)
         }
-        WalOp::DropColumn { table, column, rows } => {
+        WalOp::DropColumn { table, column, rows, schema_version } => {
             let p = serde_json::to_vec(&DropColumnPayload {
                 column: column.clone(),
+                schema_version: *schema_version,
                 rows: rows.clone(),
             })
             .map_err(io::Error::other)?;
             (OP_DROP_COLUMN, table.clone(), p)
         }
-        WalOp::ReplaceSchema { table, columns, rows } => {
+        WalOp::ReplaceSchema { table, columns, rows, schema_version } => {
             let p = serde_json::to_vec(&ReplaceSchemaPayload {
                 columns: columns.clone(),
+                schema_version: *schema_version,
                 rows: rows.clone(),
             })
             .map_err(io::Error::other)?;
             (OP_REPLACE_SCHEMA, table.clone(), p)
         }
-        WalOp::CreateTable { table, columns } => (
+        WalOp::CreateTable { table, columns, object_id } => (
             OP_CREATE_TABLE,
             table.clone(),
-            serde_json::to_vec(&CreateTablePayload { columns: columns.clone() })
+            serde_json::to_vec(&CreateTablePayload { columns: columns.clone(), object_id: *object_id })
                 .map_err(io::Error::other)?,
         ),
         WalOp::DropTable { table } => (OP_DROP_TABLE, table.clone(), Vec::new()),
@@ -471,9 +489,16 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
     let op = match op_type {
         OP_COMMIT => WalOp::Commit,
         OP_HIDE_COLUMN => {
-            let column = serde_json::from_slice(payload)
+            let value: serde_json::Value = serde_json::from_slice(payload)
                 .map_err(|e| format!("bad hide_column payload: {e}"))?;
-            WalOp::HideColumn { table, column }
+            let (column, schema_version) = if let Some(column) = value.as_str() {
+                (column.to_string(), None)
+            } else {
+                let p: HideColumnPayload = serde_json::from_value(value)
+                    .map_err(|e| format!("bad hide_column payload: {e}"))?;
+                (p.column, p.schema_version)
+            };
+            WalOp::HideColumn { table, column, schema_version }
         }
         OP_COMPACT => {
             let rows: Vec<Row> = serde_json::from_slice(payload)
@@ -518,6 +543,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
             WalOp::DropColumn {
                 table,
                 column: p.column,
+                schema_version: p.schema_version,
                 rows: p.rows,
             }
         }
@@ -527,6 +553,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
             WalOp::ReplaceSchema {
                 table,
                 columns: p.columns,
+                schema_version: p.schema_version,
                 rows: p.rows,
             }
         }
@@ -536,6 +563,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
             WalOp::CreateTable {
                 table,
                 columns: p.columns,
+                object_id: p.object_id,
             }
         }
         OP_DROP_TABLE => WalOp::DropTable { table },

chusql-core/storage/tests/btree_test.rs

@@ -1,9 +1,45 @@
 use chusql_core_storage::btree::{fits_in_page, DiskBTree, MAX_KEY_BYTES};
 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};
 
 // B+ 树测试：字节键、重复键、范围扫描、重开与配置校验。
 
+/// 损坏节点返回数据错误且重复读取不 panic
+#[test]
+fn malformed_node_fields_return_invalid_data() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("corrupt.idx");
+    {
+        let mut tree = open(dir.path(), "corrupt.idx");
+        tree.insert(b"x", 1).unwrap();
+        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;
+    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()),
+        ("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.write_all(&bytes).unwrap();
+        drop(file);
+        let mut tree = open(dir.path(), "corrupt.idx");
+        for _ in 0..2 {
+            let error = tree.get(b"x").unwrap_err();
+            assert_eq!(error.kind(), ErrorKind::InvalidData, "{name}: {error}");
+        }
+    }
+}
+
 /// 按默认参数打开指定索引文件
 fn open(dir: &std::path::Path, name: &str) -> DiskBTree {
     DiskBTree::open(dir.join(name), DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap()
@@ -14,6 +50,29 @@ fn key(n: i64) -> [u8; 8] {
     (n as u64 ^ (1u64 << 63)).to_be_bytes()
 }
 
+/// 重复键跨页后仍能完整查找和删除
+#[test]
+fn duplicate_keys_across_splits() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("split-duplicates.idx");
+    let mut tree = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    for value in (0..100).rev() {
+        tree.insert(b"same", value).unwrap();
+    }
+    drop(tree);
+    let mut tree = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    assert_eq!(tree.get(b"same").unwrap(), Some(0));
+    assert_eq!(tree.get_all(b"same").unwrap(), (0..100).collect::<Vec<_>>());
+    assert_eq!(tree.scan(Some(b"same"), Some(b"same")).unwrap().len(), 100);
+    for value in 0..100 {
+        assert!(tree.delete(b"same", value).unwrap());
+    }
+    assert!(!tree.delete(b"same", 0).unwrap());
+    drop(tree);
+    let mut tree = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
+    assert!(tree.get_all(b"same").unwrap().is_empty());
+}
+
 /// 空树查不到，遍历为空
 #[test]
 fn empty_tree_get() {

chusql-core/storage/tests/catalog_test.rs

@@ -4,6 +4,117 @@ use serde_json::json;
 
 // 数据字典测试：补列、去重、未知表。
 
+/// 结构变化递增版本，数据及重复应用不变
+#[test]
+fn schema_versions_track_structure_and_survive_reload() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("catalog.json");
+    let mut c = Catalog::default();
+    c.create_table("t", vec![]).unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 1);
+    let values = row(&[("id", json!(1)), ("name", json!("a"))]);
+    c.record_insert("t", &values).unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 2);
+    c.rebuild_stats("t", &[values]).unwrap();
+    let columns = c.describe("t").unwrap().columns.clone();
+    c.set_columns("t", columns).unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 2);
+    c.remove_column("t", "name").unwrap();
+    c.remove_column("t", "name").unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 3);
+    c.rename_table("t", "renamed").unwrap();
+    c.save(&path).unwrap();
+    let c = Catalog::load(&path).unwrap();
+    assert_eq!(c.describe("renamed").unwrap().schema_version, 4);
+}
+
+/// 旧目录版本未知，首个结构变更才递增
+#[test]
+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": {
+        "t": {"object_id": 42, "columns": []}
+    }}).to_string()).unwrap();
+    let mut c = Catalog::load(&path).unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 0);
+    c.save(&path).unwrap();
+    c = Catalog::load(&path).unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 0);
+    c.ensure_columns("t", &row(&[("id", json!(1))])).unwrap();
+    assert_eq!(c.describe("t").unwrap().schema_version, 1);
+    assert_eq!(c.describe("t").unwrap().object_id, 42);
+}
+
+/// 版本耗尽拒绝结构变更并保留原定义
+#[test]
+fn exhausted_schema_version_preserves_structure() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("catalog.json");
+    std::fs::write(&path, json!({"tables": {
+        "t": {"object_id": 42, "schema_version": u64::MAX,
+            "columns": [{"name": "id", "ty": "int"}]}
+    }}).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());
+    assert!(c.rename_table("t", "other").is_err());
+    assert!(c.ensure_columns("t", &row(&[("new", json!(1))])).is_err());
+    assert_eq!(c.describe("t").unwrap().columns.len(), 1);
+    assert_eq!(c.describe("t").unwrap().schema_version, u64::MAX);
+    assert!(c.describe("other").is_none());
+    c.record_insert("t", &row(&[("id", json!(1))])).unwrap();
+}
+
+/// 表删除重建和重载均保留编号规则
+#[test]
+fn object_ids_survive_reload_and_are_not_reused() {
+    let dir = tempfile::tempdir().unwrap();
+    let path = dir.path().join("catalog.json");
+    let mut catalog = Catalog::default();
+    catalog.create_table("t", vec![]).unwrap();
+    let old = catalog.describe("t").unwrap().object_id;
+    assert_ne!(old, 0);
+    catalog.save(&path).unwrap();
+    let mut catalog = Catalog::load(&path).unwrap();
+    assert_eq!(catalog.describe("t").unwrap().object_id, old);
+    catalog.drop_table("t").unwrap();
+    catalog.save(&path).unwrap();
+    let mut catalog = Catalog::load(&path).unwrap();
+    catalog.create_table("t", vec![]).unwrap();
+    assert!(catalog.describe("t").unwrap().object_id > old);
+}
+
+/// 旧目录迁移保留已有编号并拒绝重复
+#[test]
+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": {
+        "a": {"columns": [], "object_id": 42},
+        "b": {"columns": []}
+    }}).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": {
+        "a": {"columns": [], "object_id": 42},
+        "b": {"columns": [], "object_id": 42}
+    }}).to_string()).unwrap();
+    assert!(Catalog::load(&path).unwrap_err().to_string().contains("duplicate"));
+}
+
+/// 编号耗尽明确失败且不建立对象
+#[test]
+fn exhausted_object_ids_fail_without_creating_table() {
+    let mut catalog = Catalog::default();
+    catalog.object_high_water = u64::MAX;
+    assert!(catalog.create_table("t", vec![]).is_err());
+    assert!(catalog.describe("t").is_none());
+}
+
 
 
 /// 用键值对构造一行
@@ -31,7 +142,7 @@ 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"))]));
+    c.ensure_columns("users", &row(&[("id", json!(1)), ("name", json!("Alice"))])).unwrap();
     c.save(&path).unwrap();
 
     let c2 = Catalog::load(&path).unwrap();
@@ -53,8 +164,8 @@ 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))]));
+    c.ensure_columns("users", &row(&[("id", json!(1))])).unwrap();
-    c.ensure_columns("users", &row(&[("id", json!(2))]));
+    c.ensure_columns("users", &row(&[("id", json!(2))])).unwrap();
     assert_eq!(c.describe("users").unwrap().columns.len(), 1);
 }
 
@@ -65,9 +176,9 @@ 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))]));
+    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))])]);
+    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");
@@ -93,7 +204,7 @@ fn stats_track_a_histogram_for_numeric_columns() {
     let rows: Vec<Row> = (0..100)
         .map(|n| row(&[("id", json!(n)), ("name", json!(format!("u{}", n)))]))
         .collect();
-    c.rebuild_stats("t", &rows);
+    c.rebuild_stats("t", &rows).unwrap();
 
     let s = c.describe("t").unwrap();
     let id = s.stats.get("id").unwrap();
@@ -106,7 +217,7 @@ 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"))]));
+    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));
@@ -129,7 +240,7 @@ 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()]);
+    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]);
@@ -141,7 +252,7 @@ fn duplicate_deletion_keeps_distinct_until_last_occurrence() {
 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();
-    catalog.rebuild_stats("t", &rows);
+    catalog.rebuild_stats("t", &rows).unwrap();
     let schema = catalog.describe("t").unwrap();
     assert!(schema.stats["id"].capped);
     assert_eq!(schema.stats["id"].hist.iter().sum::<u64>(), 5000);
@@ -150,10 +261,32 @@ fn capped_distinct_keeps_histogram_and_other_columns_accurate() {
     let schema = catalog.describe("t").unwrap();
     assert_eq!(schema.stats["id"].hist.iter().sum::<u64>(), 4000);
     assert_eq!(schema.stats["v"].distinct, 2);
-    catalog.rebuild_stats("t", &rows[1000..]);
+    catalog.rebuild_stats("t", &rows[1000..]).unwrap();
     assert_eq!(catalog.describe("t").unwrap().stats["id"].distinct, 4000);
 }
 
+/// 重建直方图不受行顺序影响
+#[test]
+fn rebuilt_histogram_has_exact_buckets_in_any_order() {
+    let rows: Vec<Row> = (0..160).map(|n| row(&[("v", json!(n))])).collect();
+    let mut forward = Catalog::default();
+    forward.rebuild_stats("t", &rows).unwrap();
+    let mut reverse = Catalog::default();
+    let reversed: Vec<Row> = rows.iter().rev().cloned().collect();
+    reverse.rebuild_stats("t", &reversed).unwrap();
+    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_delete("t", &[row(&[("v", json!(10000))])]);
+    forward.rebuild_stats("t", &rows[80..]).unwrap();
+    let repaired = &forward.describe("t").unwrap().stats["v"];
+    assert_eq!(repaired.lo, Some(80.0));
+    assert_eq!(repaired.hi, Some(159.0));
+    assert_eq!(repaired.hist, vec![5; 16]);
+    assert_eq!(forward.describe("t").unwrap().row_count, 80);
+}
+
 /// 老类型名并到新写法，参数保留，未知类型原样
 #[test]
 fn normalize_type_maps_legacy_names() {
@@ -182,8 +315,8 @@ fn legacy_catalog_loads_and_normalizes() {
     let s = c.describe("legacy").unwrap();
     assert_eq!(s.columns.len(), 2);
     assert!(s.columns[0].nullable, "老列默认可空");
-    assert!(c.normalize_types());
+    assert!(c.normalize_types().unwrap());
     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(), "第二次没有可改的");
+    assert!(!c.normalize_types().unwrap(), "第二次没有可改的");
 }

chusql-core/storage/tests/config_test.rs

@@ -187,13 +187,14 @@ fn load_without_explicit_path_uses_builtin_defaults() {
     }
 }
 
-/// [server] 分区归别的层管；本层拼写错误要报错
+/// 忽略其他层分区并拒绝存储配置拼写错误
 #[test]
 fn server_section_belongs_to_another_layer() {
     let _guard = env_guard();
-    let db_server = "[server]\nlisten_host = \"0.0.0.0\"\nport = 7778\nmax_rows = 10\n";
+    let db_server = "[page]\nsize = 8192\n[storage]\ndata_dir = \"../data\"\n[server]\nlisten_host = \"0.0.0.0\"\nport = 7778\nmax_rows = 10\n[web]\nport = 7778\n";
     let loaded = config::resolve(Some(db_server), None).unwrap();
-    assert_eq!(loaded.config.data_dir, config::default_data_dir());
+    assert_eq!(loaded.config.page_size, 8192);
+    assert_eq!(loaded.config.data_dir, PathBuf::from("../data"));
 
     let typo = "[storage]\ndata_dirs = \"oops\"\n";
     assert!(config::resolve(Some(typo), None).is_err());

chusql-core/storage/tests/ffi_test.rs

@@ -0,0 +1,91 @@
+use std::ffi::CString;
+use std::ptr;
+use std::slice;
+
+use chusql_core_storage::ffi::*;
+use chusql_core_storage::runtime::Storage;
+
+// 验证 FFI 错误输出、长度边界与响应所有权。
+
+/// 读取当前线程的 FFI 错误
+fn last_error() -> String {
+    let mut len = 0;
+    // SAFETY: 长度可写，返回缓冲在复制前没有被修改。
+    unsafe {
+        let data = chusql_storage_last_error(&mut len);
+        assert!(!data.is_null());
+        String::from_utf8(slice::from_raw_parts(data, len).to_vec()).unwrap()
+    }
+}
+
+/// 维护失败清空输出并拒绝超长请求
+#[test]
+fn maintenance_rejects_invalid_arguments_and_resets_outputs() {
+    let input = b"{}";
+    let mut out = input.as_ptr() as *mut u8;
+    let mut len = 99;
+    // SAFETY: 输出均可写；无效输入应在任何读取之前被拒绝。
+    unsafe {
+        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!(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!(out.is_null());
+        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);
+    assert_eq!(last_error(), "invalid maintenance argument");
+}
+
+/// 请求验证长度和编码并归还响应
+#[test]
+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()))?;
+    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!(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!(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!(!out.is_null());
+        let response = slice::from_raw_parts(out, len).to_vec();
+        chusql_storage_free(out, len);
+        let response: serde_json::Value = serde_json::from_slice(&response)?;
+        assert_eq!(response["status"], "pong");
+    }
+    drop(storage);
+    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!(out.is_null());
+    assert_eq!(len, 0);
+    assert!(!last_error().is_empty());
+    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!(!out.is_null());
+        let response = slice::from_raw_parts(out, len).to_vec();
+        chusql_storage_free(out, len);
+        let response: serde_json::Value = serde_json::from_slice(&response)?;
+        assert_eq!(response["status"], "maintenance");
+        assert_eq!(response["mode"], "reset");
+    }
+    Ok(())
+}

chusql-core/storage/tests/runtime_test.rs

@@ -5,11 +5,409 @@ use chusql_core_storage::runtime::Storage;
 
 // 进程内存储集成测试：协议请求、索引、账号与配置。
 
+/// 检查点损坏不冒充零 LSN且可恢复读取
+#[test]
+fn system_status_reports_checkpoint_read_errors() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, data) = start_server();
+    let mut connection = connect()?;
+    let checkpoint = data.path().join("system/wal.checkpoint");
+    let initial: serde_json::Value = serde_json::from_str(&send_raw(&mut connection, r#"{"method":"system_status"}"#))?;
+    assert_eq!(initial["last_lsn"], 0);
+    request_ok(&mut connection, serde_json::json!({"method":"object_acl_replace","expected":null,"payload":"{}"}))?;
+    let original = std::fs::read(&checkpoint)?;
+    let before: serde_json::Value = serde_json::from_str(&send_raw(&mut connection, r#"{"method":"system_status"}"#))?;
+    assert_eq!(before["status"], "system");
+    assert!(before["last_lsn"].as_u64().unwrap() > 0);
+    std::fs::write(&checkpoint, b"bad")?;
+    let broken: serde_json::Value = serde_json::from_str(&send_raw(&mut connection, r#"{"method":"system_status"}"#))?;
+    assert_eq!(broken["status"], "error");
+    assert!(broken["message"].as_str().unwrap().contains("invalid WAL checkpoint length"));
+    assert!(broken.get("last_lsn").is_none());
+    assert!(send_raw(&mut connection, r#"{"method":"ping"}"#).contains("pong"));
+    std::fs::write(&checkpoint, &original)?;
+    let restored: serde_json::Value = serde_json::from_str(&send_raw(&mut connection, r#"{"method":"system_status"}"#))?;
+    assert_eq!(restored, before);
+    std::fs::remove_file(&checkpoint)?;
+    std::fs::create_dir(&checkpoint)?;
+    let unreadable: serde_json::Value = serde_json::from_str(&send_raw(&mut connection, r#"{"method":"system_status"}"#))?;
+    assert_eq!(unreadable["status"], "error");
+    assert!(unreadable.get("last_lsn").is_none());
+    std::fs::remove_dir(&checkpoint)?;
+    std::fs::write(&checkpoint, original)?;
+    Ok(())
+}
+
+/// 权限快照支持跨页文本并拒绝旧版本覆盖
+#[test]
+fn object_acl_snapshots_are_private_and_compare_versions() -> Result<(), Box<dyn std::error::Error>> {
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    let payload = serde_json::json!({"grants": "权限\"\\".repeat(4000)}).to_string();
+    request_ok(&mut c, serde_json::json!({"method":"object_acl_replace","expected":null,"payload":payload}))?;
+    let current: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
+    assert_eq!(current["rows"][0]["payload"], payload);
+    let conflict = send(&mut c, r#"{"method":"object_acl_replace","expected":null,"payload":"{}"}"#);
+    assert!(conflict.contains("changed concurrently"), "{conflict}");
+    assert!(send(&mut c, r#"{"method":"scan","database":"system","table":"__system_object_acl"}"#).contains("reserved system table"));
+    assert!(!send(&mut c, r#"{"method":"all_catalogs"}"#).contains("__system_object_acl"));
+    drop(c);
+    drop(server);
+    let _restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    let reloaded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
+    assert_eq!(reloaded, current);
+    Ok(())
+}
+
+/// 权限并发替换只能有一个版本提交
+#[test]
+fn concurrent_object_acl_replacement_preserves_one_winner() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    let workers: Vec<_> = (0..8).map(|index| {
+        let storage = Arc::clone(&c.0);
+        std::thread::spawn(move || storage.request_line(&serde_json::json!({
+            "method":"object_acl_replace","expected":null,"payload":serde_json::json!({"winner":index}).to_string()
+        }).to_string()))
+    }).collect();
+    let replies: Vec<serde_json::Value> = workers.into_iter().map(|worker| serde_json::from_str(&worker.join().unwrap()).unwrap()).collect();
+    assert_eq!(replies.iter().filter(|reply| reply["status"] == "ok").count(), 1);
+    assert_eq!(replies.iter().filter(|reply| reply["message"].as_str().is_some_and(|message| message.contains("changed concurrently"))).count(), 7);
+    let loaded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
+    assert!(serde_json::from_str::<serde_json::Value>(loaded["rows"][0]["payload"].as_str().unwrap())?["winner"].is_number());
+    Ok(())
+}
+
+/// 权限快照落盘失败后重放完整替换
+#[test]
+fn object_acl_commit_failure_replays_the_complete_snapshot() -> Result<(), Box<dyn std::error::Error>> {
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    let pending = data.path().join("system/catalog.json.pending");
+    std::fs::create_dir(&pending)?;
+    let failed = send(&mut c, r#"{"method":"object_acl_replace","expected":null,"payload":"{\"version\":1}"}"#);
+    assert!(failed.contains("error"), "{failed}");
+    assert!(send(&mut c, r#"{"method":"object_acl_read"}"#).contains("recovery required"));
+    drop(c);
+    drop(server);
+    std::fs::remove_dir(pending)?;
+    let _restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    let loaded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"object_acl_read"}"#))?;
+    assert_eq!(loaded["rows"][0]["payload"], "{\"version\":1}");
+    Ok(())
+}
+
+/// 对象编号区分跨库同名及删除重建
+#[test]
+fn object_identity_tracks_database_and_table_incarnations() -> Result<(), Box<dyn std::error::Error>> {
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    request_ok(&mut c, serde_json::json!({"method":"create_database","database":"other"}))?;
+    for database in ["main", "other"] {
+        request_ok(&mut c, serde_json::json!({"method":"create_table","database":database,"table":"items","columns":[{"name":"id","ty":"int"}]}))?;
+    }
+    let old: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#))?;
+    let other: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"other","table":"items"}"#))?;
+    assert_eq!(old["status"], "object");
+    assert_ne!(old["database_id"], other["database_id"]);
+    assert!(old["object_id"].as_u64().unwrap() > 0);
+    let catalog: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog","database":"main"}"#))?;
+    let info = catalog["schemas"].as_array().unwrap().iter().find(|entry| entry["table"] == "items").unwrap();
+    assert_eq!(info["database_id"], old["database_id"]);
+    assert_eq!(info["object_id"], old["object_id"]);
+    drop(c);
+    drop(server);
+    let restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    let stable: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#))?;
+    assert_eq!(stable, old);
+    request_ok(&mut c, serde_json::json!({"method":"drop_table","database":"main","table":"items"}))?;
+    assert!(send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#).contains("unknown table"));
+    request_ok(&mut c, serde_json::json!({"method":"create_table","database":"main","table":"items","columns":[{"name":"id","ty":"int"}]}))?;
+    let new: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"items"}"#))?;
+    assert_eq!(new["database_id"], old["database_id"]);
+    assert_ne!(new["object_id"], old["object_id"]);
+    request_ok(&mut c, serde_json::json!({"method":"drop_database","database":"other"}))?;
+    request_ok(&mut c, serde_json::json!({"method":"create_database","database":"other"}))?;
+    let new_database: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"other"}"#))?;
+    assert_ne!(new_database["database_id"], other["database_id"]);
+    assert!(new_database["object_id"].is_null());
+    drop(c);
+    drop(restarted);
+    Ok(())
+}
+
 thread_local! {
     /// 当前线程的存储实例：一个用例一个线程，用例内部按顺序起/停
     static CURRENT: RefCell<Option<Arc<Storage>>> = const { RefCell::new(None) };
 }
 
+/// 建表应用失败后按日志恢复原编号
+#[test]
+fn object_id_survives_committed_create_recovery() -> Result<(), Box<dyn std::error::Error>> {
+    use chusql_core_storage::wal::{Wal, WalOp};
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    let directory = data.path().join("databases/main");
+    let pending = directory.join("catalog.json.pending");
+    std::fs::create_dir(&pending)?;
+    assert!(send(&mut c, r#"{"method":"create_table","table":"recovered","columns":[{"name":"id","ty":"int"}]}"#).contains("error"));
+    assert!(send(&mut c, r#"{"method":"resolve_object","database":"main","table":"recovered"}"#).contains("recovery required"));
+    let wal = Wal::new(directory.join("wal.log"));
+    let scan = wal.read_all()?;
+    let id = scan.records.iter().find_map(|(_, op)| match op {
+        WalOp::CreateTable { table, object_id, .. } if table == "recovered" => *object_id,
+        _ => None,
+    }).unwrap();
+    drop(wal);
+    drop(c);
+    drop(server);
+    std::fs::remove_dir(pending)?;
+    let _restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    let resolved: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"resolve_object","database":"main","table":"recovered"}"#))?;
+    assert_eq!(resolved["object_id"], id);
+    Ok(())
+}
+
+/// 读取复查跨库依赖而非只复查扫描表
+#[test]
+fn bound_reads_recheck_dependencies_in_other_databases() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","table":"source","columns":[]}))?;
+    request_ok(&mut c, serde_json::json!({"method":"create_database","database":"dependency"}))?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","database":"dependency","table":"related","columns":[]}))?;
+    let catalog: serde_json::Value = serde_json::from_str(&send_raw(&mut c, r#"{"method":"all_catalogs"}"#))?;
+    let bindings: Vec<_> = catalog["schemas"].as_array().unwrap().iter().filter(|entry|
+        entry["table"] == "main.source" || entry["table"] == "dependency.related").map(|entry| {
+            let mut binding = entry.clone();
+            binding["database_id"] = binding["database_id"].as_u64().unwrap().to_string().into();
+            binding["object_id"] = binding["object_id"].as_u64().unwrap().to_string().into();
+            binding
+        }).collect();
+    assert_eq!(bindings.len(), 2);
+    let request = serde_json::json!({"method":"scan","table":"source","schema_guard":bindings});
+    let valid: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?;
+    assert_eq!(valid["status"], "guarded");
+    request_ok(&mut c, serde_json::json!({"method":"replace_schema","database":"dependency","table":"related","columns":[{"name":"new","ty":"int"}],"rows":[]}))?;
+    let invalid: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?;
+    assert_eq!(invalid["status"], "error");
+    assert!(invalid["message"].as_str().unwrap().contains("bound query schema changed: dependency.related"));
+    Ok(())
+}
+
+/// 每种读取都复查守卫，拒绝旧版本与库管理
+#[test]
+fn bound_reads_validate_dependencies_and_acknowledge_guards() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","table":"guarded","columns":[{"name":"id","ty":"int"}]}))?;
+    request_ok(&mut c, serde_json::json!({"method":"insert","table":"guarded","row":{"id":7}}))?;
+    let catalog: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog"}"#))?;
+    let mut binding = catalog["schemas"][0].clone();
+    binding["database_id"] = binding["database_id"].as_u64().unwrap().to_string().into();
+    binding["object_id"] = binding["object_id"].as_u64().unwrap().to_string().into();
+    for mut request in [
+        serde_json::json!({"method":"scan","table":"guarded"}),
+        serde_json::json!({"method":"scan_shard","table":"guarded","shard":0,"shards":1}),
+        serde_json::json!({"method":"lookup_by_index","table":"guarded","column":"id","key":7}),
+        serde_json::json!({"method":"range_by_index","table":"guarded","column":"id","lo":null,"hi":null}),
+    ] {
+        request["schema_guard"] = serde_json::json!([binding]);
+        let response: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?;
+        assert_eq!(response["status"], "guarded", "{response}");
+        assert!(response["response"]["status"] == "rows" || response["response"]["status"] == "no_index", "{response}");
+    }
+    request_ok(&mut c, serde_json::json!({"method":"replace_schema","table":"guarded","columns":[{"name":"id","ty":"int"},{"name":"extra","ty":"str"}],"rows":[{"id":7,"extra":"x"}]}))?;
+    let stale: serde_json::Value = serde_json::from_str(&send(&mut c, &serde_json::json!({"method":"scan","table":"guarded","schema_guard":[binding]}).to_string()))?;
+    assert_eq!(stale["status"], "error");
+    assert!(stale["message"].as_str().unwrap().contains("bound query schema changed"));
+    let write: serde_json::Value = serde_json::from_str(&send(&mut c, &serde_json::json!({"method":"insert","table":"guarded","row":{"id":9},"schema_guard":[binding]}).to_string()))?;
+    assert_eq!(write["status"], "error");
+    let management: serde_json::Value = serde_json::from_str(&send_raw(&mut c, &serde_json::json!({"method":"create_database","database":"blocked","schema_guard":[]}).to_string()))?;
+    assert_eq!(management["status"], "error");
+    let databases: serde_json::Value = serde_json::from_str(&send_raw(&mut c, r#"{"method":"list_databases"}"#))?;
+    assert!(!databases["tables"].as_array().unwrap().iter().any(|database| database == "blocked"));
+    let rows: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"guarded"}"#))?;
+    assert_eq!(rows["rows"].as_array().unwrap().len(), 1);
+    Ok(())
+}
+
+/// 写入持独占门并拒绝过期或不含目标的守卫
+#[test]
+fn bound_writes_validate_before_publishing() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","table":"writes","columns":[{"name":"id","ty":"int"}]}))?;
+    let catalog: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog"}"#))?;
+    let mut binding = catalog["schemas"][0].clone();
+    binding["database_id"] = binding["database_id"].as_u64().unwrap().to_string().into();
+    binding["object_id"] = binding["object_id"].as_u64().unwrap().to_string().into();
+    let ready: serde_json::Value = serde_json::from_str(&send(&mut c, &serde_json::json!({"method":"validate_write","table":"writes","schema_guard":[binding]}).to_string()))?;
+    assert_eq!(ready["status"], "guarded");
+    assert_eq!(ready["response"]["status"], "ok");
+    let unguarded: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"validate_write","table":"writes"}"#))?;
+    assert_eq!(unguarded["status"], "error");
+    for mut request in [
+        serde_json::json!({"method":"insert","table":"writes","row":{"id":1}}),
+        serde_json::json!({"method":"insert_batch","table":"writes","rows":[{"id":2}]}),
+        serde_json::json!({"method":"replace_all","table":"writes","rows":[{"id":3}]}),
+        serde_json::json!({"method":"delete_keys","table":"writes","keys":[3]}),
+    ] {
+        request["schema_guard"] = serde_json::json!([binding]);
+        let response: serde_json::Value = serde_json::from_str(&send(&mut c, &request.to_string()))?;
+        assert_eq!(response["status"], "guarded", "{response}");
+        assert_eq!(response["response"]["status"], "ok", "{response}");
+    }
+    let missing: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"insert","table":"writes","row":{"id":9},"schema_guard":[]}"#))?;
+    assert_eq!(missing["status"], "error");
+    request_ok(&mut c, serde_json::json!({"method":"drop_table","table":"writes"}))?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","table":"writes","columns":[{"name":"id","ty":"int"}]}))?;
+    let stale: serde_json::Value = serde_json::from_str(&send(&mut c, &serde_json::json!({"method":"insert","table":"writes","row":{"id":9},"schema_guard":[binding]}).to_string()))?;
+    assert_eq!(stale["status"], "error");
+    assert!(stale["message"].as_str().unwrap().contains("bound query object changed"));
+    let rows: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"writes"}"#))?;
+    assert_eq!(rows["rows"], serde_json::json!([]));
+    Ok(())
+}
+
+/// 互相依赖的跨库写入按统一顺序取门
+#[test]
+fn guarded_cross_database_writes_do_not_deadlock() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    for database in ["guard_a", "guard_b"] {
+        request_ok(&mut c, serde_json::json!({"method":"create_database","database":database}))?;
+        request_ok(&mut c, serde_json::json!({"method":"create_table","database":database,"table":"items","columns":[{"name":"id","ty":"int"}]}))?;
+    }
+    let catalog: serde_json::Value = serde_json::from_str(&send_raw(&mut c, r#"{"method":"all_catalogs"}"#))?;
+    let bindings: Vec<_> = catalog["schemas"].as_array().unwrap().iter().filter(|entry|
+        entry["table"] == "guard_a.items" || entry["table"] == "guard_b.items").map(|entry| {
+            let mut binding = entry.clone();
+            binding["database_id"] = binding["database_id"].as_u64().unwrap().to_string().into();
+            binding["object_id"] = binding["object_id"].as_u64().unwrap().to_string().into();
+            binding
+        }).collect();
+    assert_eq!(bindings.len(), 2);
+    let barrier = Arc::new(std::sync::Barrier::new(2));
+    let (sender, receiver) = std::sync::mpsc::channel();
+    let workers: Vec<_> = ["guard_a", "guard_b"].into_iter().map(|database| {
+        let storage = Arc::clone(&c.0);
+        let barrier = Arc::clone(&barrier);
+        let sender = sender.clone();
+        let bindings = bindings.clone();
+        std::thread::spawn(move || {
+            for id in 0..16 {
+                barrier.wait();
+                let response = storage.request_line(&serde_json::json!({
+                    "method":"insert","database":database,"table":"items","row":{"id":id},"schema_guard":bindings
+                }).to_string());
+                sender.send(response).unwrap();
+            }
+        })
+    }).collect();
+    drop(sender);
+    for _ in 0..32 {
+        let response: serde_json::Value = serde_json::from_str(&receiver.recv_timeout(std::time::Duration::from_secs(10))?)?;
+        assert_eq!(response["status"], "guarded", "{response}");
+        assert_eq!(response["response"]["status"], "ok", "{response}");
+    }
+    for worker in workers { worker.join().unwrap(); }
+    for database in ["guard_a", "guard_b"] {
+        let rows: serde_json::Value = serde_json::from_str(&send_raw(&mut c, &serde_json::json!({"method":"scan","database":database,"table":"items"}).to_string()))?;
+        assert_eq!(rows["rows"].as_array().unwrap().len(), 16);
+    }
+    Ok(())
+}
+
+/// 描述与目录均透传精确版本字符串
+#[test]
+fn catalog_schema_versions_are_exact_and_validated() -> Result<(), Box<dyn std::error::Error>> {
+    use chusql_core_storage::protocol::TableSchemaWire;
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","table":"versioned","columns":[{"name":"id","ty":"int"}]}))?;
+    let describe: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"describe_table","table":"versioned"}"#))?;
+    assert_eq!(describe["schema_version"], "1");
+    let catalog: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog"}"#))?;
+    assert_eq!(catalog["schemas"][0]["schema_version"], "1");
+    let wire: TableSchemaWire = serde_json::from_value(serde_json::json!({"table":"t","columns":[],"schema_version":u64::MAX.to_string()}))?;
+    assert_eq!(wire.schema_version, u64::MAX);
+    assert_eq!(serde_json::to_value(wire)?["schema_version"], u64::MAX.to_string());
+    for version in [serde_json::json!(-1), serde_json::json!(1.5), serde_json::json!("18446744073709551616"), serde_json::json!("+1")] {
+        assert!(serde_json::from_value::<TableSchemaWire>(serde_json::json!({"table":"t","columns":[],"schema_version":version})).is_err());
+    }
+    Ok(())
+}
+
+/// 检查点失败及反复恢复保留结构版本
+#[test]
+fn schema_versions_survive_checkpoint_failure_and_repeated_recovery() -> Result<(), Box<dyn std::error::Error>> {
+    use chusql_core_storage::catalog::Catalog;
+    use chusql_core_storage::wal::{Wal, WalOp};
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    request_ok(&mut c, serde_json::json!({"method":"create_table","table":"versioned","columns":[{"name":"id","ty":"int"}]}))?;
+    let directory = data.path().join("databases/main");
+    let pending = directory.join("wal.checkpoint.pending");
+    std::fs::create_dir(&pending)?;
+    let response = send(&mut c, r#"{"method":"replace_schema","table":"versioned","columns":[{"name":"id","ty":"int"},{"name":"tag","ty":"str"}],"rows":[]}"#);
+    assert!(response.contains("error"), "{response}");
+    let catalog = Catalog::load(directory.join("catalog.json"))?;
+    let version = catalog.describe("versioned").unwrap().schema_version;
+    assert_eq!(version, 2);
+    let wal = Wal::new(directory.join("wal.log"));
+    let records = wal.read_all()?.records;
+    assert!(records.iter().any(|(_, op)| matches!(op, WalOp::ReplaceSchema { schema_version: Some(2), .. })));
+    let columns = catalog.describe("versioned").unwrap().columns.clone();
+    drop(wal);
+    drop(c);
+    drop(server);
+    std::fs::remove_dir(pending)?;
+    for _ in 0..2 {
+        let wal = Wal::new(directory.join("wal.log"));
+        wal.append_group(&[
+            WalOp::ReplaceSchema { table: "versioned".into(), columns: vec![], rows: vec![], schema_version: Some(1) },
+            WalOp::ReplaceSchema { table: "versioned".into(), columns: columns.clone(), rows: vec![], schema_version: Some(version) },
+        ])?;
+        drop(wal);
+        let restarted = restart_at(data.path())?;
+        let catalog = Catalog::load(directory.join("catalog.json"))?;
+        assert_eq!(catalog.describe("versioned").unwrap().schema_version, version);
+        assert_eq!(catalog.describe("versioned").unwrap().columns, columns);
+        assert_eq!(std::fs::metadata(directory.join("wal.log"))?.len(), 0);
+        drop(restarted);
+    }
+    Ok(())
+}
+
+/// 并发建表分配互不重复的编号
+#[test]
+fn concurrent_table_creation_allocates_distinct_object_ids() -> Result<(), Box<dyn std::error::Error>> {
+    let (_server, _data) = start_server();
+    let mut c = connect()?;
+    let workers: Vec<_> = (0..16).map(|index| {
+        let storage = Arc::clone(&c.0);
+        std::thread::spawn(move || storage.request_line(&serde_json::json!({
+            "method":"create_table", "database":"main", "table":format!("concurrent_{index}"),
+            "columns":[{"name":"id","ty":"int"}]
+        }).to_string()))
+    }).collect();
+    for worker in workers {
+        let result: serde_json::Value = serde_json::from_str(&worker.join().unwrap())?;
+        assert_eq!(result["status"], "ok");
+    }
+    let response: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"list_catalog","database":"main"}"#))?;
+    let ids: std::collections::HashSet<_> = response["schemas"].as_array().unwrap().iter()
+        .filter(|schema| schema["table"].as_str().unwrap().starts_with("concurrent_"))
+        .map(|schema| schema["object_id"].as_u64().unwrap()).collect();
+    assert_eq!(ids.len(), 16);
+    assert!(!ids.contains(&0));
+    Ok(())
+}
+
 /// 定点写入检查舍入和整批原子拒绝
 #[test]
 fn decimal_writes_enforce_precision_before_wal() -> Result<(), Box<dyn std::error::Error>> {
@@ -246,6 +644,66 @@ fn legacy_account_wal_migrates_without_promoting_other_names() -> Result<(), Box
     Ok(())
 }
 
+/// 读取并校验身份命令响应
+fn account_response(c: &mut Conn, request: serde_json::Value) -> Result<serde_json::Value, Box<dyn std::error::Error>> {
+    let response: serde_json::Value = serde_json::from_str(&send(c, &request.to_string()))?;
+    assert_eq!(response["status"], "accounts", "{response}");
+    Ok(response)
+}
+
+/// 本机认证开关独立持久化并推进会话版本
+#[test]
+fn sudo_auth_is_independent_revocable_and_persistent() -> Result<(), Box<dyn std::error::Error>> {
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    let original = account_response(&mut c, serde_json::json!({"method":"account_create","user":"local_user","password_hash":"hash"}))?;
+    let created = original["accounts"].as_array().unwrap().iter().find(|a| a["user"] == "local_user").unwrap();
+    assert_eq!(created["allow_sudo_auth"], false);
+    let changed = account_response(&mut c, serde_json::json!({"method":"identity_alter","user":"local_user","allow_sudo_auth":true}))?;
+    let local = changed["accounts"].as_array().unwrap().iter().find(|a| a["user"] == "local_user").unwrap();
+    assert_eq!(local["allow_sudo_auth"], true);
+    assert_eq!(local["is_superuser"], false);
+    assert_eq!(local["system_catalog_manager"], false);
+    assert_eq!(local["revision"], 2);
+    for command in [
+        serde_json::json!({"method":"identity_alter","user":"local_user","allow_sudo_auth":false}),
+        serde_json::json!({"method":"account_reset","user":"local_user","password_hash":"other"}),
+        serde_json::json!({"method":"identity_alter","user":"root","allow_sudo_auth":true}),
+    ] {
+        let denied = send(&mut c, &serde_json::json!({"method":"catalog_manage","command":command}).to_string());
+        assert!(denied.contains("superuser required"), "{denied}");
+    }
+    drop(c);
+    drop(server);
+    let _restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    assert_eq!(account_response(&mut c, serde_json::json!({"method":"accounts_list"}))?, changed);
+    let revoked = account_response(&mut c, serde_json::json!({"method":"identity_alter","user":"local_user","allow_sudo_auth":false}))?;
+    let local = revoked["accounts"].as_array().unwrap().iter().find(|a| a["user"] == "local_user").unwrap();
+    assert_eq!(local["allow_sudo_auth"], false);
+    assert_eq!(local["revision"], 3);
+    Ok(())
+}
+
+/// 升级缺失本机认证列的旧目录
+#[test]
+fn sudo_auth_upgrades_old_identity_schema() -> Result<(), Box<dyn std::error::Error>> {
+    let (server, data) = start_server();
+    drop(server);
+    CURRENT.with(|slot| *slot.borrow_mut() = None);
+    let path = data.path().join("system/catalog.json");
+    let mut catalog: serde_json::Value = serde_json::from_slice(&std::fs::read(&path)?)?;
+    catalog["tables"]["__system_identities"]["columns"].as_array_mut().unwrap().retain(|column| column["name"] != "allow_sudo_auth");
+    std::fs::write(&path, serde_json::to_vec(&catalog)?)?;
+    let _restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    let upgraded = account_response(&mut c, serde_json::json!({"method":"identity_initialize","administrator":"root"}))?;
+    assert!(upgraded["accounts"].as_array().unwrap().iter().all(|a| a["allow_sudo_auth"] == false));
+    let catalog: serde_json::Value = serde_json::from_slice(&std::fs::read(&path)?)?;
+    assert!(catalog["tables"]["__system_identities"]["columns"].as_array().unwrap().iter().any(|column| column["name"] == "allow_sudo_auth"));
+    Ok(())
+}
+
 /// 身份属性重启保留且禁止删除最后管理员
 #[test]
 fn identity_attributes_survive_restart_and_protect_superuser() -> Result<(), Box<dyn std::error::Error>> {
@@ -780,7 +1238,7 @@ fn hidden_column_wal_replays_twice_without_touching_heap() -> Result<(), Box<dyn
     let mut compacted: Option<Vec<u8>> = None;
     for round in 0..2 {
         let wal = Wal::new(data.path().join("databases/main/wal.log"));
-        let op = WalOp::HideColumn { table: "items".into(), column: "secret".into() };
+        let op = WalOp::HideColumn { table: "items".into(), column: "secret".into(), schema_version: None };
         wal.truncate()?;
         wal.append(&op)?;
         assert_eq!(wal.read()?, Some(op));
@@ -1691,6 +2149,7 @@ fn create_table_replays_after_restart() -> Result<(), Box<dyn std::error::Error>
     drop(server);
 
     let group = vec![WalOp::CreateTable {
+        object_id: None,
         table: "m4_create".into(),
         columns: vec![
             SchemaColumn {
@@ -1835,6 +2294,7 @@ fn already_applied_create_table_is_skipped_on_restart() -> Result<(), Box<dyn st
 
     let wal = Wal::new(data.path().join("databases/main/wal.log"));
     wal.append_group(&[WalOp::CreateTable {
+        object_id: None,
         table: "m4_done".into(),
         columns: vec![SchemaColumn {
             name: "id".into(),
@@ -1995,6 +2455,36 @@ fn create_index_accepts_duplicate_values() {
     assert!(r.contains(r#""status":"error""#), "the id index stays unique: {}", r);
 }
 
+/// 重启修复统计并保持点查范围结果
+#[test]
+fn restart_rebuilds_stale_stats_without_changing_index_results() -> Result<(), Box<dyn std::error::Error>> {
+    let (server, data) = start_server();
+    let mut c = connect()?;
+    let rows: Vec<serde_json::Value> = (0..160).map(|id| serde_json::json!({"id":id,"v":id})).collect();
+    request_ok(&mut c, serde_json::json!({"method":"insert_batch","table":"rebuilt","rows":rows}))?;
+    request_ok(&mut c, serde_json::json!({"method":"create_index","table":"rebuilt","column":"v"}))?;
+    let point: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"lookup_by_index","table":"rebuilt","column":"v","key":80}"#))?;
+    let range: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"range_by_index","table":"rebuilt","column":"v","lo":80,"hi":89}"#))?;
+    let scan: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"scan","table":"rebuilt"}"#))?;
+    drop(c);
+    drop(server);
+    let path = data.path().join("databases/main/catalog.json");
+    let mut catalog: serde_json::Value = serde_json::from_slice(&std::fs::read(&path)?)?;
+    catalog["tables"]["rebuilt"]["row_count"] = serde_json::json!(9999);
+    catalog["tables"]["rebuilt"]["stats"] = serde_json::json!({});
+    std::fs::write(&path, serde_json::to_vec(&catalog)?)?;
+    let _restarted = restart_at(data.path())?;
+    let mut c = connect()?;
+    assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"lookup_by_index","table":"rebuilt","column":"v","key":80}"#))?, point);
+    assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"range_by_index","table":"rebuilt","column":"v","lo":80,"hi":89}"#))?, range);
+    assert_eq!(serde_json::from_str::<serde_json::Value>(&send(&mut c, r#"{"method":"scan","table":"rebuilt"}"#))?, scan);
+    let schema: serde_json::Value = serde_json::from_str(&send(&mut c, r#"{"method":"describe_table","table":"rebuilt"}"#))?;
+    assert_eq!(schema["row_count"], 160);
+    let stat = schema["stats"].as_array().unwrap().iter().find(|stat| stat["name"] == "v").unwrap();
+    assert_eq!(stat["hist"], serde_json::json!([10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10]));
+    Ok(())
+}
+
 /// 数据字典里的统计：不同值个数
 #[test]
 fn stats_report_distinct_values() {
@@ -2264,9 +2754,9 @@ fn account_table_uses_typed_columns_and_stamps_login() -> Result<(), Box<dyn std
     let entry = &catalog["tables"]["__system_identities"];
     let columns = entry["columns"].as_array().ok_or("missing columns")?;
     let names: Vec<&str> = columns.iter().map(|col| col["name"].as_str().unwrap_or("")).collect();
-    assert_eq!(names, vec!["id", "user", "can_login", "is_superuser", "system_catalog_manager", "enabled", "identity_version", "registered_at", "last_login_at", "revision"]);
+    assert_eq!(names, vec!["id", "user", "can_login", "is_superuser", "system_catalog_manager", "allow_sudo_auth", "enabled", "identity_version", "registered_at", "last_login_at", "revision"]);
     let types: Vec<&str> = columns.iter().map(|col| col["ty"].as_str().unwrap_or("")).collect();
-    assert_eq!(types, vec!["int", "varchar(64)", "bool", "bool", "bool", "bool", "int", "timestamp", "timestamp", "int"]);
+    assert_eq!(types, vec!["int", "varchar(64)", "bool", "bool", "bool", "bool", "bool", "int", "timestamp", "timestamp", "int"]);
     assert_eq!(columns[0]["primary_key"], true, "id 是主键");
     assert_eq!(columns[0]["nullable"], false);
     assert_eq!(columns[1]["unique"], true, "用户名唯一");

chusql-core/storage/tests/wal_test.rs

@@ -4,6 +4,56 @@ use serde_json::json;
 
 // WAL 测试：追加、读取、清空、截断尾巴、LSN 与提交标记。
 
+/// 结构版本往返且旧隐藏列载荷可读
+#[test]
+fn schema_versions_round_trip_and_legacy_hide_decodes() {
+    let dir = tempfile::tempdir().unwrap();
+    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) },
+    ];
+    wal.append_group(&ops).unwrap();
+    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);
+    body.extend_from_slice(&1_u16.to_le_bytes());
+    body.extend_from_slice(b"t");
+    body.extend_from_slice(br#""name""#);
+    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,
+    }));
+}
+
+/// 建表编号完整往返且兼容旧载荷
+#[test]
+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) };
+    wal.append(&op).unwrap();
+    assert_eq!(wal.read_all().unwrap().records[0].1, op);
+    drop(wal);
+    let mut body = 1_u64.to_le_bytes().to_vec();
+    body.push(11);
+    body.extend_from_slice(&1_u16.to_le_bytes());
+    body.extend_from_slice(b"t");
+    body.extend_from_slice(br#"{"columns":[]}"#);
+    let mut frame = (body.len() as u32).to_le_bytes().to_vec();
+    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 });
+}
+
 
 /// 用键值对构造一行
 fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
@@ -35,6 +85,7 @@ fn append_and_read_round_trips() {
         WalOp::DropColumn {
             table: "users".into(),
             column: "age".into(),
+            schema_version: None,
             rows: vec![
                 row(&[("id", json!(1)), ("name", json!("Alice"))]),
                 row(&[("id", json!(2)), ("name", json!("Bob"))]),

chusql-interface/cbits/sudo_credential.c

@@ -0,0 +1,179 @@
+#ifdef _WIN32
+#define _WIN32_WINNT 0x0600
+#include <windows.h>
+#include <sddl.h>
+#include <stdio.h>
+#else
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/stat.h>
+#include <errno.h>
+#include <stdio.h>
+#endif
+#include <string.h>
+
+/* 创建、读取和清理仅本机提升身份可访问的认证凭据。 */
+
+#ifdef _WIN32
+/* 检查当前提升令牌的管理员成员资格。 */
+int chusql_sudo_privileged(void) {
+    SID_IDENTIFIER_AUTHORITY authority = SECURITY_NT_AUTHORITY;
+    PSID administrators = NULL;
+    BOOL member = FALSE;
+    if (!AllocateAndInitializeSid(&authority, 2, SECURITY_BUILTIN_DOMAIN_RID,
+        DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &administrators)) return 0;
+    if (!CheckTokenMembership(NULL, administrators, &member)) member = FALSE;
+    FreeSid(administrators);
+    return member != FALSE;
+}
+
+/* 生成系统保护目录中的端口专属路径。 */
+static int credential_path(int port, wchar_t *directory, wchar_t *file) {
+    wchar_t base[MAX_PATH];
+    UINT length = GetSystemDirectoryW(base, MAX_PATH);
+    if (!length || length >= MAX_PATH - 80 || port < 1 || port > 65535) return ERROR_INVALID_PARAMETER;
+    swprintf(directory, MAX_PATH, L"%ls\\config\\ChuSQL-Sudo-%d", base, port);
+    swprintf(file, MAX_PATH, L"%ls\\credential", directory);
+    return 0;
+}
+
+/* 排除重解析目录与凭据文件。 */
+static int plain_path(const wchar_t *path, int directory) {
+    DWORD attributes = GetFileAttributesW(path);
+    return attributes != INVALID_FILE_ATTRIBUTES && !(attributes & FILE_ATTRIBUTE_REPARSE_POINT)
+        && (!!(attributes & FILE_ATTRIBUTE_DIRECTORY) == directory);
+}
+
+/* 用管理员与系统专属访问列表创建凭据。 */
+int chusql_sudo_create(int port, const char *secret) {
+    wchar_t directory[MAX_PATH], file[MAX_PATH];
+    PSECURITY_DESCRIPTOR descriptor = NULL;
+    SECURITY_ATTRIBUTES attributes = {sizeof(SECURITY_ATTRIBUTES), NULL, FALSE};
+    DWORD written = 0, error;
+    HANDLE handle;
+    if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
+    error = credential_path(port, directory, file);
+    if (error) return (int)error;
+    if (!ConvertStringSecurityDescriptorToSecurityDescriptorW(
+        L"D:P(A;OICI;FA;;;BA)(A;OICI;FA;;;SY)", SDDL_REVISION_1, &descriptor, NULL)) return (int)GetLastError();
+    attributes.lpSecurityDescriptor = descriptor;
+    if (!CreateDirectoryW(directory, &attributes)) {
+        error = GetLastError(); LocalFree(descriptor); return (int)error;
+    }
+    handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_READ, &attributes, CREATE_NEW,
+        FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
+    LocalFree(descriptor);
+    if (handle == INVALID_HANDLE_VALUE) {
+        error = GetLastError(); RemoveDirectoryW(directory); return (int)error;
+    }
+    error = 0;
+    if (!WriteFile(handle, secret, 64, &written, NULL) || written != 64 || !FlushFileBuffers(handle))
+        error = GetLastError() ? GetLastError() : ERROR_WRITE_FAULT;
+    if (!CloseHandle(handle) && !error) error = GetLastError();
+    if (error) { DeleteFileW(file); RemoveDirectoryW(directory); }
+    return (int)error;
+}
+
+/* 从系统保护目录读取本机凭据。 */
+int chusql_sudo_read(int port, char *secret) {
+    wchar_t directory[MAX_PATH], file[MAX_PATH];
+    DWORD received = 0, error;
+    LARGE_INTEGER size;
+    HANDLE handle;
+    if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
+    error = credential_path(port, directory, file);
+    if (error) return (int)error;
+    if (!plain_path(directory, 1) || !plain_path(file, 0)) return ERROR_ACCESS_DENIED;
+    handle = CreateFileW(file, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
+        FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
+    if (handle == INVALID_HANDLE_VALUE) return (int)GetLastError();
+    error = 0;
+    if (!GetFileSizeEx(handle, &size) || size.QuadPart != 64
+        || !ReadFile(handle, secret, 64, &received, NULL) || received != 64) error = ERROR_INVALID_DATA;
+    if (!CloseHandle(handle) && !error) error = GetLastError();
+    return (int)error;
+}
+
+/* 删除本次服务启动创建的凭据目录。 */
+int chusql_sudo_remove(int port) {
+    wchar_t directory[MAX_PATH], file[MAX_PATH];
+    int error = credential_path(port, directory, file);
+    if (error) return error;
+    if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
+    if (!DeleteFileW(file)) return (int)GetLastError();
+    return RemoveDirectoryW(directory) ? 0 : (int)GetLastError();
+}
+#else
+/* 检查当前进程的有效 root 身份。 */
+int chusql_sudo_privileged(void) { return geteuid() == 0; }
+
+/* 打开 root 专属目录并验证所有权与权限。 */
+static int credential_directory(int port) {
+    char path[96];
+    struct stat status;
+    int fd;
+    if (port < 1 || port > 65535) { errno = EINVAL; return -1; }
+    snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
+    fd = open(path, O_RDONLY | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
+    if (fd < 0) return -1;
+    if (fstat(fd, &status) || status.st_uid != 0 || (status.st_mode & 0777) != 0700) {
+        close(fd); errno = EACCES; return -1;
+    }
+    return fd;
+}
+
+/* 在 root 专属目录中独占创建凭据。 */
+int chusql_sudo_create(int port, const char *secret) {
+    char path[96];
+    int dir, fd, error = 0;
+    if (!chusql_sudo_privileged()) return EACCES;
+    if (port < 1 || port > 65535) return EINVAL;
+    snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
+    if (mkdir(path, 0700)) return errno;
+    dir = credential_directory(port);
+    if (dir < 0) { error = errno; rmdir(path); return error; }
+    fd = openat(dir, "credential", O_WRONLY | O_CREAT | O_EXCL | O_NOFOLLOW | O_CLOEXEC, 0600);
+    if (fd < 0) error = errno;
+    else {
+        if (write(fd, secret, 64) != 64 || fsync(fd)) error = errno ? errno : EIO;
+        if (close(fd) && !error) error = errno;
+    }
+    if (error) unlinkat(dir, "credential", 0);
+    if (close(dir) && !error) error = errno;
+    if (error) rmdir(path);
+    return error;
+}
+
+/* 验证 root 文件所有权后读取凭据。 */
+int chusql_sudo_read(int port, char *secret) {
+    struct stat status;
+    int dir, fd, error = 0;
+    if (!chusql_sudo_privileged()) return EACCES;
+    dir = credential_directory(port);
+    if (dir < 0) return errno;
+    fd = openat(dir, "credential", O_RDONLY | O_NOFOLLOW | O_CLOEXEC);
+    if (fd < 0) error = errno;
+    else {
+        if (fstat(fd, &status) || !S_ISREG(status.st_mode) || status.st_uid != 0
+            || (status.st_mode & 0777) != 0600 || status.st_size != 64 || status.st_nlink != 1) error = EACCES;
+        else if (read(fd, secret, 64) != 64) error = errno ? errno : EIO;
+        if (close(fd) && !error) error = errno;
+    }
+    if (close(dir) && !error) error = errno;
+    return error;
+}
+
+/* 删除本次服务启动创建的凭据目录。 */
+int chusql_sudo_remove(int port) {
+    char path[96];
+    int dir, error = 0;
+    if (!chusql_sudo_privileged()) return EACCES;
+    dir = credential_directory(port);
+    if (dir < 0) return errno;
+    if (unlinkat(dir, "credential", 0)) error = errno;
+    if (close(dir) && !error) error = errno;
+    snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
+    if (!error && rmdir(path)) error = errno;
+    return error;
+}
+#endif

chusql-interface/chusql-interface.cabal

@@ -16,11 +16,13 @@ library
                       ChuSQL.Interface.Actions
                       ChuSQL.Interface.Auth
                       ChuSQL.Interface.Config
+                      ChuSQL.Interface.Normalization
                       ChuSQL.Interface.Link
                       ChuSQL.Interface.Policy
                       ChuSQL.Interface.Protocol
                       ChuSQL.Interface.RateLimit
                       ChuSQL.Interface.Session
+                      ChuSQL.Interface.Sudo
                       ChuSQL.Interface.Settings
                       ChuSQL.Interface.TOML
     build-depends:    base >= 4.14 && < 5
@@ -36,5 +38,8 @@ library
                     , scientific
                     , text
                     , time
+    c-sources:        cbits/sudo_credential.c
+    if os(windows)
+        extra-libraries: advapi32
     default-language: Haskell2010
     ghc-options:      -Wall

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

@@ -43,4 +43,4 @@ accountColumnSpec name ty nullable autoIncrement primary unique =
 
 -- | 账号表的结构（排序校验用）
 systemTableInfo :: TableInfo
-systemTableInfo = TableInfo accountTableName accountColumns 0 [] [] []
+systemTableInfo = TableInfo accountTableName accountColumns 0 [] [] [] Nothing Nothing

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

@@ -32,8 +32,12 @@ 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 qualified Data.Aeson as A
 import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
 import Data.List (intercalate)
@@ -88,24 +92,50 @@ columnTypeOf = fmap plainColumn . parseColumnType . T.unpack . T.strip
 
 -- | 本地类型转线上名字
 columnTypeName :: Column -> Text
-columnTypeName = T.pack . typeName . columnType
+columnTypeName column = T.pack $ case columnType column of
+    CRuntime tid -> renderTypeExpr (typeExpression tid)
+    ty -> typeName ty
 
 -- | 字符串字面量转义：单引号翻倍（引擎的词法器就是这么折回去的）
 escapeStringLiteral :: String -> String
 escapeStringLiteral = concatMap (\c -> if c == '\'' then "''" else [c])
 
 -- | 值转 SQL 字面量
-sqlLiteral :: Value -> String
+sqlLiteral :: Value -> Either String String
-sqlLiteral VNull = "NULL"
+sqlLiteral VNull = Right "NULL"
-sqlLiteral (VInt n) = show n
+sqlLiteral (VInt n) = Right (show n)
-sqlLiteral (VFloat d) = show d
+sqlLiteral (VFloat d)
-sqlLiteral (VStr s) = "'" ++ escapeStringLiteral s ++ "'"
+    | isNaN d || isInfinite d = Left "SQL floating literal must be finite"
-sqlLiteral (VBool True) = "TRUE"
+    | otherwise = Right (show d)
-sqlLiteral (VBool False) = "FALSE"
+sqlLiteral (VStr s) = Right ("'" ++ escapeStringLiteral s ++ "'")
+sqlLiteral (VBool True) = Right "TRUE"
+sqlLiteral (VBool False) = Right "FALSE"
+sqlLiteral (VRuntime tid value) = do
+    validateValue builtinTypes tid value
+    runtimeLiteral (typeExpression tid) value
+
+-- | 渲染类型化构造器的 SQL 字面量
+runtimeLiteral :: TypeExpr -> RuntimeValue -> Either String String
+runtimeLiteral _ (RInt n) = Right (show n)
+runtimeLiteral _ (RDouble n) = Right (show n)
+runtimeLiteral _ (RBool b) = Right (if b then "TRUE" else "FALSE")
+runtimeLiteral _ (RString text) = Right ("'" ++ escapeStringLiteral text ++ "'")
+runtimeLiteral (TypeApply (TypeConstructorId 5) [child]) (RList values) = do
+    items <- mapM (runtimeLiteral child) values
+    Right ("LIST<" ++ renderTypeExpr child ++ ">(" ++ intercalate ", " items ++ ")")
+runtimeLiteral (TypeApply (TypeConstructorId 6) [child]) (RMaybe value) = do
+    item <- maybe (Right "") (runtimeLiteral child) value
+    Right ("MAYBE<" ++ renderTypeExpr child ++ ">(" ++ item ++ ")")
+runtimeLiteral (TypeApply (TypeConstructorId 7) fields) (RTuple values)
+    | length fields == length values = do
+        items <- zipWithM runtimeLiteral fields values
+        Right ("TUPLE<" ++ intercalate ", " (map renderTypeExpr fields) ++ ">(" ++ intercalate ", " items ++ ")")
+runtimeLiteral _ _ = Left "runtime value does not match its type expression"
 
 -- | JSON 值按列类型转成引擎的值；类型对不上就报错
 coerceValue :: Column -> A.Value -> Either String Value
 coerceValue col v = case v of
+    A.Object _ -> parseEither valueFromJSON v >>= M.coerceValue t
     A.Null -> Right VNull
     A.Bool b -> M.coerceValue t (VBool b)
     A.Number n -> case floatingOrInteger n :: Either Double Integer of
@@ -186,13 +216,14 @@ insertRowSql table row = do
     tbl <- checkIdent "table" table
     cols <- requireNonEmpty "values" row
     names <- mapM (checkIdent "column" . T.pack . fst) cols
+    literals <- mapM (sqlLiteral . snd) cols
     pure
         ( "INSERT INTO "
             ++ T.unpack tbl
             ++ " ("
             ++ intercalate ", " (map T.unpack names)
             ++ ") VALUES ("
-            ++ intercalate ", " (map (sqlLiteral . snd) cols)
+            ++ intercalate ", " literals
             ++ ")"
         )
 
@@ -208,14 +239,15 @@ insertRowsSql table rows = do
             let widths = map length rs
             if any (/= length first) widths
                 then Left "all rows must have the same columns"
-                else
+                else do
+                    literals <- mapM (mapM (sqlLiteral . snd)) rs
                     pure
                         ( "INSERT INTO "
                             ++ T.unpack tbl
                             ++ " ("
                             ++ intercalate ", " (map T.unpack names)
                             ++ ") VALUES "
-                            ++ intercalate ", " ["(" ++ intercalate ", " (map (sqlLiteral . snd) r) ++ ")" | r <- rs]
+                            ++ intercalate ", " ["(" ++ intercalate ", " values ++ ")" | values <- literals]
                         )
 
 -- | 构造按 id 改行的 UPDATE 语句
@@ -223,8 +255,14 @@ updateRowSql :: Text -> Int -> [(String, Value)] -> Either String String
 updateRowSql table key assigns = do
     tbl <- checkIdent "table" table
     cols <- requireNonEmpty "values" assigns
-    sets <- mapM (\(n, v) -> (\c -> T.unpack c ++ " = " ++ sqlLiteral v) <$> checkIdent "column" (T.pack n)) cols
+    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
+        Right (T.unpack column ++ " = " ++ literal)
 
 -- | 按 id 删一行，存储层原地删
 deleteRowSql :: Text -> Int -> Either String String
@@ -251,7 +289,8 @@ whereClause filters = case filters of
     -- | 一个等值条件
     term (column, value) = do
         col <- checkIdent "column" column
-        pure (T.unpack col ++ " = " ++ sqlLiteral value)
+        literal <- sqlLiteral value
+        pure (T.unpack col ++ " = " ++ literal)
 
 -- | 拼 ORDER BY 子句，无排序给空串
 orderClause :: Maybe (Text, Bool) -> Either String String
@@ -309,6 +348,8 @@ roleName name
 -- | 授权对象：`*`，或长度不超过 128 的裸表名/`库.表`
 grantObject :: Text -> Either String Text
 grantObject object
+    | "database:" `T.isPrefixOf` T.toLower object = ("DATABASE " <>) <$> checkIdent "database" (T.drop 9 object)
+    | ".*" `T.isSuffixOf` object = (<> ".*") <$> checkIdent "database" (T.dropEnd 2 object)
     | T.strip object == "*" = Right "*"
     | T.null object || T.length object > 128 = Left "object name is empty or too long"
     | not (T.all allowed object) = Left ("object name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack object)

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

@@ -49,7 +49,6 @@ data WebConfig = WebConfig
     , wcMaxPageSize :: Int
     , wcMaxRows :: Int
     , wcMaxSqlLength :: Int
-    , wcSeedDemo :: Bool
     }
     deriving (Show, Eq)
 
@@ -73,7 +72,6 @@ defaultWebConfig =
         , wcMaxPageSize = 500
         , wcMaxRows = 1000
         , wcMaxSqlLength = 20000
-        , wcSeedDemo = False
         }
 
 -- | 把设置键统一成连字符写法，重名时连字符优先
@@ -148,7 +146,6 @@ webConfigFromSection saved =
         , wcMaxPageSize = sectionInt "max-page-size" saved (wcMaxPageSize defaultWebConfig)
         , wcMaxRows = sectionInt "max-rows" saved (wcMaxRows defaultWebConfig)
         , wcMaxSqlLength = sectionInt "max-sql-length" saved (wcMaxSqlLength defaultWebConfig)
-        , wcSeedDemo = sectionBool "seed" saved (wcSeedDemo defaultWebConfig)
         }
 
 -- | 分区里一个键的非空字符串值
@@ -186,12 +183,13 @@ data ServerConfig = ServerConfig
     , scPort :: Int
     , scMaxMessage :: Int
     , scMaxRows :: Int
+    , scSudoUser :: Text
     }
     deriving (Eq, Show)
 
 -- | 默认本机 7777，行 1 MiB，最多 1000 行
 defaultServerConfig :: ServerConfig
-defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000
+defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000 ""
 
 -- | 读 [server] 段键，缺的用默认
 loadServerConfigAt :: FilePath -> IO ServerConfig
@@ -202,13 +200,12 @@ loadServerConfigAt path = do
             Just value | not (T.null (T.strip value)) -> T.unpack (T.strip value)
             _ -> fallback
         -- | 取一个键的整数值
-        intOf key fallback = case Map.lookup key values >>= readMaybe . T.unpack . T.strip of
+        intOf key fallback = fromMaybe fallback (Map.lookup key values >>= readMaybe . T.unpack . T.strip)
-            Just number -> number
-            Nothing -> fallback
     pure
         defaultServerConfig
             { scHost = textOf "listen_host" (scHost defaultServerConfig)
             , scPort = intOf "port" (scPort defaultServerConfig)
             , scMaxMessage = intOf "max_message" (scMaxMessage defaultServerConfig)
             , scMaxRows = intOf "max_rows" (scMaxRows defaultServerConfig)
+            , scSudoUser = T.toLower (T.pack (textOf "sudo_auth_user" ""))
             }

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

@@ -5,6 +5,8 @@ module ChuSQL.Interface.Link (
     connectClient,
     closeClient,
     clientLogin,
+    clientSudoLogin,
+    clientNormalization,
     clientQuery,
     clientPing,
     clientCatalog,
@@ -15,6 +17,9 @@ 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.Protocol (
     ClientRequest (..),
@@ -40,6 +45,7 @@ import Network.Socket (
     defaultHints,
     defaultProtocol,
     getAddrInfo,
+    getPeerName,
     socket,
     socketToHandle,
  )
@@ -52,17 +58,18 @@ import System.IO.Error (isEOFError)
 data Client = Client
     { clHandle :: Handle
     , clLock :: MVar ()
+    , clLocal :: Bool
     }
 
 -- | 连上 server 并对协议版本，失败给人话错误
 connectClient :: Text -> Int -> IO (Either Text Client)
 connectClient host port = do
-    opened <- try (openConnection host port) :: IO (Either IOException Handle)
+    opened <- try (openConnection host port) :: IO (Either IOException (Handle, Bool))
     case opened of
         Left err -> pure (Left ("cannot reach the server at " <> T.pack (address host port) <> ": " <> T.pack (describe err)))
-        Right handle -> do
+        Right (handle, local) -> do
             lock <- newMVar ()
-            let client = Client handle lock
+            let client = Client handle lock local
             greeted <- request client (ReqHello protocolVersion)
             case greeted of
                 Right (RespHello version)
@@ -117,6 +124,26 @@ clientLogin client user password = do
         Right (RespLogin _ admin) -> pure (Right admin)
         Right other -> pure (failed "login" other)
 
+-- 验证一次性挑战并用本机身份登录。
+clientSudoLogin :: Client -> SudoCredential -> Text -> IO (Either Text Bool)
+clientSudoLogin client _ _ | not (clLocal client) = pure (Left "sudo authentication requires a local server")
+clientSudoLogin client credential user = withMVar (clLock client) $ \_ -> do
+    outcome <- try authenticate :: IO (Either IOException (Either Text Bool))
+    pure $ either (Left . T.pack . describe) id outcome
+  where
+    -- 在同一连接连续交换挑战与证明。
+    authenticate = do
+        challenge <- exchange (clHandle client) ReqSudoChallenge
+        case challenge of
+            Right (RespSudoChallenge nonce) | T.length nonce == 64 -> do
+                answer <- exchange (clHandle client) (ReqSudoLogin user (sudoProof credential nonce user))
+                pure $ case answer of
+                    Left message -> Left message
+                    Right (RespLogin _ admin) -> Right admin
+                    Right other -> failed "sudo login" other
+            Right other -> pure (failed "sudo challenge" other)
+            Left message -> pure (Left message)
+
 -- | 跑一条语句，拿回结果集
 clientQuery :: Client -> Text -> IO (Either Text QueryResult)
 clientQuery client sql = do
@@ -196,7 +223,7 @@ failed what response = case response of
     _ -> Left ("unexpected response to " <> what)
 
 -- | 建连接（套接字转成文本模式的行缓冲句柄）
-openConnection :: Text -> Int -> IO Handle
+openConnection :: Text -> Int -> IO (Handle, Bool)
 openConnection host port = do
     let hints = defaultHints{addrSocketType = Stream}
     infos <- getAddrInfo (Just hints) (Just (T.unpack host)) (Just (show port))
@@ -205,10 +232,11 @@ openConnection host port = do
         (info : _) -> do
             sock <- socket (addrFamily info) Stream defaultProtocol
             connect sock (addrAddress info)
+            peer <- getPeerName sock
             handle <- socketToHandle sock ReadWriteMode
             hSetBuffering handle LineBuffering
             hSetNewlineMode handle noNewlineTranslation
-            pure handle
+            pure (handle, isLocalPeer peer)
 
 -- | 把主机端口拼成地址字样
 address :: Text -> Int -> String
@@ -219,3 +247,12 @@ describe :: IOException -> String
 describe err
     | isEOFError err = "the server closed the connection"
     | otherwise = show err
+
+-- 请求服务端执行只读范式分析。
+clientNormalization :: Client -> NormalizationRequest -> IO (Either Text A.Value)
+clientNormalization client payload = do
+    answer <- request client (ReqNormalization payload)
+    pure $ case answer of
+        Left message -> Left message
+        Right (RespNormalization value) -> Right value
+        Right other -> failed "normalization" other

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

@@ -0,0 +1,188 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.Normalization where
+
+import ChuSQL.Core.Protocol (SchemaColumn)
+import Control.Monad (unless, when)
+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
+import qualified Data.Aeson.Types as AT
+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 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)
+data ObjectIdentity = ObjectIdentity Integer Integer deriving (Eq, Show)
+data NormalizationRequest = NormalizationRequest
+    { nrVersion :: Int, nrDatabase :: Text, nrTable :: Text
+    , nrDeclaration :: NormalizationDeclaration
+    , nrExpectedObject :: Maybe ObjectIdentity, nrExpectedSchema :: Maybe Text
+    } deriving (Eq, Show)
+
+-- 拒绝对象中未定义的字段。
+onlyFields :: [Text] -> A.Object -> AT.Parser ()
+onlyFields names fields = unless (all ((`elem` names) . K.toText) (KM.keys fields)) (fail "normalization: unknown field")
+
+instance FromJSON NormalizationDependency where
+    -- 读取依赖两端的确切字段名。
+    parseJSON = withObject "dependency" $ \o -> do
+        onlyFields ["lhs", "rhs"] o
+        lhs <- o .: "lhs"
+        rhs <- o .: "rhs"
+        when (null rhs) (fail "normalization: empty dependency rhs")
+        pure (NormalizationDependency lhs rhs)
+instance ToJSON NormalizationDependency where
+    -- 编码声明依赖。
+    toJSON (NormalizationDependency lhs rhs) = object ["lhs" .= lhs, "rhs" .= rhs]
+instance FromJSON NormalizationDeclaration where
+    -- 读取显式声明并限制数量。
+    parseJSON = withObject "declaration" $ \o -> do
+        onlyFields ["declared_keys", "dependencies", "dependencies_complete", "atomic_attributes"] o
+        keys <- o .:? "declared_keys" .!= []
+        deps <- o .:? "dependencies" .!= []
+        when (length keys > 256 || length deps > 256) (fail "normalization: declaration exceeds 256 entries")
+        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]
+instance FromJSON ObjectIdentity where
+    -- 校验稳定对象的正整数编号。
+    parseJSON = withObject "object identity" $ \o -> do
+        onlyFields ["database_id", "object_id"] o
+        db <- o .: "database_id" >>= identityNumber
+        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)
+    | not (T.null text) && T.length text <= 20 && T.all isDigit text = case reads (T.unpack text) of
+        [(value, "")] | value <= toInteger (maxBound :: Word64) -> pure value
+        _ -> fail "normalization: invalid identity number"
+identityNumber (A.Number number)
+    | base10Exponent number >= -20 && base10Exponent number <= 20 =
+        maybe (fail "normalization: invalid identity number") (pure . toInteger) (toBoundedInteger number :: Maybe Word64)
+identityNumber _ = fail "normalization: invalid identity number"
+
+instance ToJSON ObjectIdentity where
+    -- 编码对象的库及表编号。
+    toJSON (ObjectIdentity db table) = object ["database_id" .= T.pack (show db), "object_id" .= T.pack (show table)]
+instance FromJSON NormalizationRequest where
+    -- 校验版本、范围和预期身份。
+    parseJSON = withObject "normalization request" $ \o -> do
+        onlyFields ["api_version", "database", "table", "declaration", "expected_object", "expected_schema_fingerprint"] o
+        version <- o .: "api_version"
+        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)
+            (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]
+
+-- 校验与 SQL 一致的裸标识符。
+plainName :: Text -> Bool
+plainName name = not (T.null name) && T.length name <= 64 && (isAlpha (T.head name) || T.head name == '_') && T.all (\c -> isAlphaNum c || c == '_') name
+
+-- 检查大小、编码及重复 JSON 字段。
+decodeNormalizationJSON :: BL.ByteString -> Either Text A.Value
+decodeNormalizationJSON raw
+    | BL.length raw > 65536 = Left "normalization: request exceeds 64 KiB"
+    | otherwise = do
+        value <- either (Left . T.pack) Right (A.eitherDecode raw)
+        text <- either (const (Left "normalization: invalid UTF-8")) Right (TE.decodeUtf8' (BL.toStrict raw))
+        case readP_to_S (skipSpaces *> jsonNode 0 <* skipSpaces <* eof) (T.unpack text) of
+            [(True, "")] -> Right value
+            _ -> Left "normalization: duplicate JSON fields or nesting exceeds 64"
+
+-- 遍历 JSON 结构并保留原始字段名。
+jsonNode :: Int -> ReadP Bool
+jsonNode depth
+    | depth > 64 = pfail
+    | otherwise = objectNode <++ arrayNode <++ (True <$ jsonString) <++ (True <$ munch1 (\c -> not (isSpace c) && c `notElem` (",]}" :: String)))
+  where
+    -- 验证对象及所有嵌套值。
+    objectNode = do
+        _ <- char '{'
+        skipSpaces
+        pairs <- sepBy pair (skipSpaces *> char ',' <* skipSpaces)
+        skipSpaces
+        _ <- char '}'
+        pure (length (map fst pairs) == length (nub (map fst pairs)) && all snd pairs)
+    -- 保留键名并验证对应值。
+    pair = do
+        key <- jsonString
+        skipSpaces
+        _ <- char ':'
+        skipSpaces
+        valid <- jsonNode (depth + 1)
+        pure (key, valid)
+    -- 验证数组的所有元素。
+    arrayNode = do
+        _ <- char '['
+        skipSpaces
+        values <- sepBy (jsonNode (depth + 1)) (skipSpaces *> char ',' <* skipSpaces)
+        skipSpaces
+        _ <- char ']'
+        pure (and values)
+
+-- 解码字符串以识别转义后的相同键。
+jsonString :: ReadP Text
+jsonString = do
+    _ <- char '"'
+    pieces <- many piece
+    _ <- char '"'
+    case A.eitherDecodeStrict (TE.encodeUtf8 (T.pack ('"' : concat pieces ++ "\""))) of
+        Right value -> pure value
+        Left _ -> pfail
+  where
+    -- 保留 JSON 字符串转义。
+    piece = ((\c -> ['\\', c]) <$> (char '\\' *> get)) <++ munch1 (\c -> c /= '"' && c /= '\\')
+
+
+-- 拒绝缺字段或未知标签的线上报告。
+parseNormalizationReport :: A.Value -> AT.Parser A.Value
+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")
+    _ <- (o .: "object" :: AT.Parser ObjectIdentity)
+    fingerprint <- o .: "schema_fingerprint"
+    unless (T.length fingerprint == 64 && T.all isHexDigit fingerprint) (fail "normalization: invalid schema fingerprint")
+    view <- o .: "view"
+    unless (view `elem` (["live_schema", "transaction_snapshot"] :: [Text])) (fail "normalization: unknown view")
+    _ <- (o .: "schema" :: AT.Parser [SchemaColumn])
+    _ <- (o .: "declaration" :: AT.Parser NormalizationDeclaration)
+    _ <- (o .: "candidate_keys" :: AT.Parser [[String]])
+    forms <- o .: "findings" >>= mapM parseFinding
+    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
+  where
+    -- 核对每项结论与证据的稳定形状。
+    parseFinding = withObject "normalization finding" $ \o -> do
+        form <- o .: "normal_form"
+        verdict <- o .: "verdict"
+        unless (verdict `elem` (["satisfied", "violated", "insufficient"] :: [Text])) (fail "normalization: unknown verdict")
+        _ <- (o .: "witnesses" :: AT.Parser [NormalizationDependency])
+        _ <- (o .: "condition" :: AT.Parser Text)
+        pure form

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

@@ -13,6 +13,8 @@ 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 qualified Data.Aeson as A
@@ -91,6 +93,9 @@ serverName = "chusql-server"
 data ClientRequest
     = ReqHello Int
     | ReqLogin Text Text
+    | ReqSudoChallenge
+    | ReqSudoLogin Text Text
+    | ReqNormalization NormalizationRequest
     | ReqQuery Text
     | ReqPing
     | ReqQuit
@@ -109,6 +114,7 @@ data WireRequest = WireRequest
     , wrProtocol :: Maybe Int
     , wrUser :: Maybe Text
     , wrPassword :: Maybe Text
+    , wrProof :: Maybe Text
     , wrSql :: Maybe Text
     , wrRequest :: Maybe Value
     }
@@ -121,6 +127,7 @@ instance A.FromJSON WireRequest where
             <*> o A..:? "protocol"
             <*> o A..:? "user"
             <*> o A..:? "password"
+            <*> o A..:? "proof"
             <*> o A..:? "sql"
             <*> o A..:? "request"
 
@@ -133,6 +140,13 @@ decodeRequest raw = case A.eitherDecodeStrict raw of
         "login" -> case (wrUser wire, wrPassword wire) of
             (Just user, Just password) -> Right (ReqLogin user password)
             _ -> Left "login needs both user and password"
+        "sudo_challenge" -> Right ReqSudoChallenge
+        "sudo_login" -> case (wrUser wire, wrProof wire) of
+            (Just user, Just proof) -> Right (ReqSudoLogin user proof)
+            _ -> Left "sudo_login needs both user and proof"
+        "normalization_analyze" -> do
+            value <- decodeNormalizationJSON (BL.fromStrict raw)
+            either (Left . T.pack) Right $ parseEither (withObject "normalization envelope" $ \o -> onlyFields ["method", "request"] o >> ReqNormalization <$> o .: "request") value
         "query" -> maybe (Left "query needs sql") (Right . ReqQuery) (wrSql wire)
         "storage" -> maybe (Left "storage needs request") (Right . ReqStorage) (wrRequest wire)
         "catalog" -> Right ReqCatalog
@@ -154,6 +168,9 @@ requestJson :: ClientRequest -> Value
 requestJson request = case request of
     ReqHello version -> object ["method" .= ("hello" :: Text), "protocol" .= version]
     ReqLogin user password -> object ["method" .= ("login" :: Text), "user" .= user, "password" .= password]
+    ReqSudoChallenge -> object ["method" .= ("sudo_challenge" :: Text)]
+    ReqSudoLogin user proof -> object ["method" .= ("sudo_login" :: Text), "user" .= user, "proof" .= proof]
+    ReqNormalization payload -> object ["method" .= ("normalization_analyze" :: Text), "request" .= payload]
     ReqQuery sql -> object ["method" .= ("query" :: Text), "sql" .= sql]
     ReqPing -> object ["method" .= ("ping" :: Text)]
     ReqQuit -> object ["method" .= ("quit" :: Text)]
@@ -169,10 +186,12 @@ requestJson request = case request of
 data ServerResponse
     = RespHello Int
     | RespLogin Text Bool
+    | RespSudoChallenge Text
     | RespResult QueryResult
     | RespPong
     | RespBye
     | RespError Text Text
+    | RespNormalization Value
     | RespStorage Value
     | RespCatalog [TableInfo]
     | RespDatabases [Text]
@@ -190,9 +209,11 @@ responseJson :: ServerResponse -> Value
 responseJson response = case response of
     RespHello version -> object ["status" .= ("hello" :: Text), "protocol" .= version, "server" .= serverName]
     RespLogin user admin -> object ["status" .= ("ok" :: Text), "user" .= user, "admin" .= admin]
+    RespSudoChallenge challenge -> object ["status" .= ("sudo_challenge" :: Text), "challenge" .= challenge]
     RespPong -> object ["status" .= ("pong" :: Text)]
     RespBye -> object ["status" .= ("bye" :: Text)]
     RespError code message -> object ["status" .= ("error" :: Text), "code" .= code, "message" .= message]
+    RespNormalization value -> object ["status" .= ("normalization" :: Text), "analysis" .= value]
     RespStorage value -> object ["status" .= ("storage" :: Text), "response" .= value]
     RespCatalog infos -> object ["status" .= ("catalog" :: Text), "schemas" .= infos]
     RespDatabases names -> object ["status" .= ("databases" :: Text), "databases" .= names]
@@ -216,6 +237,7 @@ decodeResponse raw = case A.eitherDecode raw of
     decodeStatus status fields = case status of
         "hello" -> Right (RespHello (intOf "protocol" fields))
         "ok" -> Right (RespLogin (textOf "user" fields) (boolOf "admin" fields))
+        "sudo_challenge" -> fromField "challenge" RespSudoChallenge fields
         "pong" -> Right RespPong
         "bye" -> Right RespBye
         "error" -> Right (RespError (textOf "code" fields) (textOf "message" fields))
@@ -225,6 +247,9 @@ decodeResponse raw = case A.eitherDecode raw of
         "result" -> case A.fromJSON (A.Object fields) of
             A.Success result -> Right (RespResult result)
             A.Error message -> Left (T.pack message)
+        "normalization" -> case KM.lookup "analysis" fields of
+            Nothing -> Left "normalization response is missing analysis"
+            Just value -> either (Left . T.pack) (Right . RespNormalization) (parseEither parseNormalizationReport value)
         "catalog" -> fromField "schemas" RespCatalog fields
         "databases" -> fromField "databases" RespDatabases fields
         "roles" -> fromField "roles" RespRoles fields

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

@@ -7,24 +7,32 @@ module ChuSQL.Interface.Session (
     sessionDatabase,
     isPlainIdentifier,
     authenticateSession,
+    authenticateSudoSession,
     switchDatabase,
     runStatement,
+    analyzeNormalization,
     catalog,
     databases,
     roleViews,
     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,
     clientQuery,
     clientRoles,
  )
+import ChuSQL.Interface.Sudo (SudoCredential)
 import ChuSQL.Interface.Protocol (RoleView)
 import Data.Char (isAlpha, isAlphaNum)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
@@ -68,6 +76,14 @@ authenticateSession session user password = do
         Left message -> pure (Left message)
         Right admin -> writeIORef (ssAdmin session) admin >> pure (Right ())
 
+-- 用受保护本机凭据登录并记录身份。
+authenticateSudoSession :: Session -> SudoCredential -> Text -> IO (Either Text ())
+authenticateSudoSession session credential user = do
+    answer <- clientSudoLogin (ssClient session) credential user
+    case answer of
+        Left message -> pure (Left message)
+        Right admin -> writeIORef (ssAdmin session) admin >> pure (Right ())
+
 -- | 换库：名字先按解析器规矩校验，由 server 执行 USE
 switchDatabase :: Session -> Text -> IO (Either Text ())
 switchDatabase session rawName
@@ -88,9 +104,8 @@ runStatement session sql = do
     case answer of
         Left message -> pure (Left message)
         Right result -> do
-            case qrDatabase result of
+            for_
-                Just name -> writeIORef (ssCurrent session) name
+              (qrDatabase result) (writeIORef (ssCurrent session))
-                Nothing -> pure ()
             pure (Right result)
 
 -- | 数据字典（\\dt 与 \\d 用）
@@ -108,3 +123,10 @@ roleViews session = clientRoles (ssClient session)
 -- | 账号清单（\\du 与管理页用）
 accounts :: Session -> IO (Either Text [Account])
 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")
+        else clientNormalization (ssClient session) payload

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

@@ -61,7 +61,6 @@ settingCatalogue =
     , owned "storage-btree-order" "Storage B+tree order" "storage" "int" "4" "btree" "order"
     , owned "storage-buffer-pool" "Storage buffer pool pages" "storage" "int" "1024" "buffer" "pool_size"
     , owned "storage-log" "Storage log level" "storage" "text" "info" "log" "level"
-    , item "seed" "Seed demo data on start" "storage" "bool" "1" True True
     , owned "tcp-listen-host" "TCP listen address" "network" "text" "127.0.0.1" "server" "listen_host"
     , owned "tcp-port" "TCP port" "network" "int" "7777" "server" "port"
     , owned "tcp-max-message" "TCP max request line (bytes)" "network" "int" "1048576" "server" "max_message"
@@ -231,7 +230,6 @@ effectiveSettings cfg =
         , ("max-page-size", tshow (wcMaxPageSize cfg))
         , ("max-rows", tshow (wcMaxRows cfg))
         , ("max-sql-length", tshow (wcMaxSqlLength cfg))
-        , ("seed", boolText (wcSeedDemo cfg))
         , ("data-dir", maybe "" T.pack (wcDataDir cfg))
         , ("log-files", T.pack (wcLogFiles cfg))
         ]

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

@@ -0,0 +1,108 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Interface.Sudo (
+    SudoCredential, createSudoCredential, removeSudoCredential,
+    readSudoCredential, sudoProof, verifySudoProof, sudoChallenge, sudoPrivileged,
+    newSudoCredential, isLocalPeer, validSudoChallenge,
+) where
+
+import Crypto.Hash (SHA256)
+import Crypto.MAC.HMAC (HMAC, hmac)
+import Crypto.Random (getRandomBytes)
+import qualified Data.ByteArray as BA
+import Data.ByteArray.Encoding (Base (Base16), convertToBase)
+import qualified Data.ByteString as BS
+import Data.Char (isHexDigit)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+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)
+
+-- 用系统保护凭据与一次性挑战验证本机提升身份。
+
+newtype SudoCredential = SudoCredential BS.ByteString
+
+-- 隐藏本机凭据的诊断内容。
+instance Show SudoCredential where
+    show _ = "SudoCredential <redacted>"
+
+-- 检查当前进程的操作系统提升身份。
+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
+
+-- 判断当前进程是否以提升身份运行。
+sudoPrivileged :: IO Bool
+sudoPrivileged = (/= 0) <$> nativePrivileged
+
+-- 生成随机挑战和服务实例凭据。
+sudoChallenge :: IO Text
+sudoChallenge = TE.decodeUtf8 . convertToBase Base16 <$> (getRandomBytes 32 :: IO BS.ByteString)
+
+-- 创建本次服务实例的受保护凭据。
+createSudoCredential :: Int -> IO SudoCredential
+createSudoCredential port = do
+    credential@(SudoCredential secret) <- newSudoCredential
+    status <- BS.useAsCString secret (nativeCreate (fromIntegral port))
+    if status == 0 then pure credential
+        else ioError (userError (T.unpack (nativeError "create" status)))
+
+-- 生成独立服务实例的随机凭据。
+newSudoCredential :: IO SudoCredential
+newSudoCredential = SudoCredential . TE.encodeUtf8 <$> sudoChallenge
+
+-- 判断内核报告的连接地址是否为回环。
+isLocalPeer :: SockAddr -> Bool
+isLocalPeer (SockAddrInet _ host) = let (first, _, _, _) = hostAddressToTuple host in first == 127
+isLocalPeer (SockAddrInet6 _ _ host _) = case hostAddress6ToTuple host of
+    (0, 0, 0, 0, 0, 0, 0, 1) -> True
+    (0, 0, 0, 0, 0, 65535, high, _) -> high >= 32512 && high <= 32767
+    _ -> False
+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
+        && verifySudoProof credential nonce user proof
+    Nothing -> False
+
+-- 删除本次服务实例的受保护凭据。
+removeSudoCredential :: Int -> IO ()
+removeSudoCredential port = do
+    status <- nativeRemove (fromIntegral port)
+    if status == 0 then pure () else ioError (userError (T.unpack (nativeError "remove" status)))
+
+-- 验证操作系统身份并读取本机凭据。
+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
+        secret <- BS.packCStringLen (buffer, 64)
+        pure $ if BS.all (isHexDigit . toEnum . fromIntegral) secret
+            then Right (SudoCredential secret) else Left "invalid sudo credential"
+
+-- 计算绑定挑战与目标账号的认证证明。
+sudoProof :: SudoCredential -> Text -> Text -> Text
+sudoProof (SudoCredential secret) challenge user = TE.decodeUtf8 (convertToBase Base16 digest)
+  where
+    digest = hmac secret (TE.encodeUtf8 ("chusql-sudo-v1:" <> challenge <> ":" <> T.toLower (T.strip user))) :: HMAC SHA256
+
+-- 按固定长度常量时间比对认证证明。
+verifySudoProof :: SudoCredential -> Text -> Text -> Text -> Bool
+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"

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

@@ -36,12 +36,13 @@ writeSection path section values = do
     prepared <- prepareDirectory
     case prepared of
         Left err -> pure (Left err)
-        Right () -> do
+        Right () -> do exists <- doesFileExist path
-            exists <- doesFileExist path
+                       raw <- if exists then
-            raw <- if exists then TE.decodeUtf8 <$> BS.readFile path else pure ""
+                                  TE.decodeUtf8 <$> BS.readFile path
+                              else
+                                  pure ""
                        let updated = T.unlines (rewrite section values (T.lines raw))
-            written <- tryWrite (TE.encodeUtf8 updated)
+                       tryWrite (TE.encodeUtf8 updated)
-            pure written
   where
     -- | 目录不存在就先建
     prepareDirectory = do
@@ -111,7 +112,7 @@ rewrite :: Text -> Map Text Text -> [Text] -> [Text]
 rewrite section values = addMissing . replaceInSection . dropEmpties
   where
     -- | 删掉空值的键
-    dropEmpties = filter (\line -> maybe True (not . T.null . snd) (assignment line))
+    dropEmpties = filter (maybe True (not . T.null . snd) . assignment)
     -- | 在目标分区里就地换行
     replaceInSection = go ""
     -- | 走到目标分区后逐行替换
@@ -158,7 +159,7 @@ keysOf wanted = go ""
 appendSection :: Text -> [(Text, Text)] -> [Text] -> [Text]
 appendSection section entries lines' =
     lines'
-        ++ (if null lines' || not (T.null (last lines')) then [""] else [])
+        ++ (["" | null lines' || not (T.null (last lines'))])
         ++ ("[" <> section <> "]") : [assignmentLine key value | (key, value) <- entries]
 
 -- | 全局配置文件的固定路径，跟随系统惯例

chusql-interface/test/sudo_native.py

@@ -0,0 +1,60 @@
+import ctypes
+import os
+from pathlib import Path
+import subprocess
+import sys
+
+# 验证 Unix 本机凭据的所有权、权限及符号链接拒绝。
+
+# 执行本机凭据安全回归。
+def main():
+    library = ctypes.CDLL(sys.argv[1])
+    port = int(sys.argv[2])
+    library.chusql_sudo_create.argtypes = [ctypes.c_int, ctypes.c_char_p]
+    library.chusql_sudo_read.argtypes = [ctypes.c_int, ctypes.c_void_p]
+    secret = b'a' * 64
+    buffer = ctypes.create_string_buffer(64)
+    if len(sys.argv) > 3:
+        assert library.chusql_sudo_privileged() == 0
+        assert library.chusql_sudo_create(port, secret) != 0
+        assert library.chusql_sudo_read(port, buffer) != 0
+        print('non-root creation and reading refused')
+        return
+    assert library.chusql_sudo_privileged() == 1
+    assert library.chusql_sudo_create(port, secret) == 0
+    directory = Path(f'/var/run/chusql-sudo-{port}')
+    file = directory / 'credential'
+    try:
+        assert directory.stat().st_uid == 0
+        assert directory.stat().st_mode & 0o777 == 0o700
+        assert file.stat().st_mode & 0o777 == 0o600
+        assert library.chusql_sudo_read(port, buffer) == 0
+        assert buffer.raw == secret
+        assert library.chusql_sudo_create(port, secret) != 0
+        subprocess.run([sys.executable, __file__, sys.argv[1], str(port), '--deny'],
+                       user=65534, group=65534, check=True)
+        file.chmod(0o644)
+        assert library.chusql_sudo_read(port, buffer) != 0
+        file.chmod(0o600)
+        file.rename(directory / 'original')
+        file.symlink_to(directory / 'original')
+        assert library.chusql_sudo_read(port, buffer) != 0
+        file.unlink()
+        (directory / 'original').rename(file)
+        file.write_bytes(secret + b'extra')
+        assert library.chusql_sudo_read(port, buffer) != 0
+        file.write_bytes(secret)
+        os.chown(file, 65534, 65534)
+        assert library.chusql_sudo_read(port, buffer) != 0
+        os.chown(file, 0, 0)
+        directory.chmod(0o755)
+        assert library.chusql_sudo_read(port, buffer) != 0
+        directory.chmod(0o700)
+    finally:
+        assert library.chusql_sudo_remove(port) == 0
+    assert not directory.exists()
+    print('root round trip, duplicate, permissions, ownership, symlink and cleanup passed')
+
+
+if __name__ == '__main__':
+    main()

chusql-server/app/Main.hs

@@ -2,6 +2,7 @@
 
 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 (
@@ -22,7 +23,7 @@ import ChuSQL.Server.TCP (
     newServerEnv,
     runServer,
  )
-import Control.Exception (IOException, bracket, try)
+import Control.Exception (IOException, try, bracket_)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.KeyMap as KM
 import Data.Text (Text)
@@ -177,7 +178,8 @@ run opts = do
                     (fromIntegral (wcLoginWindow cfg))
             env <- newServerEnv backend rootName configPath config limiter
             let announce port = putStrLn ("listening:    tcp://" ++ scHost config ++ ":" ++ show port)
-            bracket (pure link) (const closeConnection) (const (serve env announce))
+            bracket_
+              (pure link) closeConnection (serve env announce)
 
 -- | 起 TCP 服务并处理绑定失败
 serve :: ServerEnv -> (Int -> IO ()) -> IO ()
@@ -211,17 +213,17 @@ checkInitialized backend = do
 reportCredential :: Backend -> Text -> Bool -> IO ()
 reportCredential backend rootName legacy = do
     putStrLn ("administrator: " ++ T.unpack rootName)
-    if legacy
+    when legacy
-        then do
+      $ do putStrLn
-            putStrLn "  !! the [web] section still carries a plaintext password key; it is ignored now"
+             "  !! 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"
+           putStrLn
-        else pure ()
+             "  !! remove it: the administrator password lives in the __system_users system table"
     passwordless <- administratorPasswordless backend rootName
-    if passwordless
+    when passwordless
-        then do
+      $ do putStrLn
-            putStrLn "  !! the administrator has no password yet: sign in with an empty password, then set one"
+             "  !! 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)"
+           putStrLn
-        else pure ()
+             "  !!   ALTER USER root IDENTIFIED BY '...'   (or use the account page in the Web UI)"
 
 -- | 探测存储是否可用，答不上 ping 就退出
 checkStorage :: Backend -> IO ()
@@ -239,7 +241,7 @@ printBanner cfg config configPath = do
     version <- storageVersion
     putStrLn "================== ChuSQL Server ==================="
     putStrLn ("config file:  " ++ configPath)
-    putStrLn ("protocol:     chusql 1 (one JSON object per line)")
+    putStrLn "protocol:     chusql 1 (one JSON object per line)"
     putStrLn
         ( "limits:       message "
             ++ show (scMaxMessage config)

chusql-server/chusql-server.cabal

@@ -14,8 +14,11 @@ library
     exposed-modules:  ChuSQL.Server.Accounts
                       ChuSQL.Server.Backend
                       ChuSQL.Server.Catalog
+                      ChuSQL.Server.Normalization
                       ChuSQL.Server.Policy
                       ChuSQL.Server.Privileges
+                      ChuSQL.Server.ObjectACL
+                      ChuSQL.Server.Security
                       ChuSQL.Server.Session
                       ChuSQL.Server.TCP
     build-depends:    base >= 4.14 && < 5

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

@@ -4,7 +4,7 @@ module ChuSQL.Server.Accounts (
     Accounts, AccountError (..), Principal (..), PasswordPolicy (..), defaultPasswordPolicy,
     newAccounts, accountsPolicy, setAccountsPolicy, passwordAllowed,
     ensureRootAccount, administratorPasswordless, rootUserName, principalName, principalIsRoot, principalIsCatalogManager,
-    authenticate, currentPrincipal,
+    authenticate, authenticateSudo, currentPrincipal,
     listAccounts, findAccount, AccountCommand (..), accountCommand, runAccountCommand,
 ) where
 
@@ -119,7 +119,7 @@ validateUserName name
 
 -- | 校验新身份的名称
 validateNewName :: Accounts -> Text -> Either AccountError ()
-validateNewName _ name = validateUserName name
+validateNewName _ = validateUserName
 
 storageFailure :: AccountError
 storageFailure = AccountError "storage_error" "account storage unavailable"
@@ -153,7 +153,7 @@ ensureRootAccount backend name = do
             | otherwise -> do
                 created <- beAccounts backend (ReqAccountCreate (normalize name) "")
                 case created of
-                    Right _ -> storageResult <$> beAccounts backend (ReqIdentityAlter (normalize name) Nothing (Just True) Nothing Nothing)
+                    Right _ -> storageResult <$> beAccounts backend (ReqIdentityAlter (normalize name) Nothing (Just True) Nothing Nothing Nothing)
                     Left "account already exists" -> pure (Right ())
                     Left _ -> pure (Left storageFailure)
 
@@ -219,6 +219,21 @@ authenticate service user password = withMVar (acLock service) $ \_ -> do
             Left _ -> pure (Left storageFailure)
             Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a))
 
+-- 为已验证的本机身份创建独立登录会话。
+authenticateSudo :: Accounts -> Text -> IO (Either AccountError Text)
+authenticateSudo service user = withMVar (acLock service) $ \_ -> do
+    stored <- readAccounts (acBackend service)
+    case stored of
+        Left err -> pure (Left err)
+        Right accounts -> case filter ((== normalize user) . accountUser) accounts of
+            [a] | accountEnabled a && accountCanLogin a && accountAllowSudoAuth a -> do
+                stamp <- currentStamp
+                written <- beAccounts (acBackend service) (ReqAccountLogin (accountUser a) (Just stamp))
+                case written of
+                    Left _ -> pure (Left storageFailure)
+                    Right _ -> Right <$> createVersionedSession (acSessions service) (accountUser a) (Just (accountRevision a))
+            _ -> pure (Left unauthorized)
+
 -- | 系统表里的账号清单（含管理员）
 listAccounts :: Accounts -> IO (Either AccountError [Account])
 listAccounts service = withMVar (acLock service) $ \_ -> fmap (fmap (filter (\a -> accountCanLogin a || not (T.null (accountHash a))))) (readAccounts (acBackend service))
@@ -285,7 +300,7 @@ accountCommand _ = Nothing
 
 -- | 按目录管理权限执行账号命令
 runAccountCommand :: Accounts -> Principal -> AccountCommand -> IO (Either AccountError ())
-runAccountCommand service principal command = withMVar (acLock service) $ \_ -> run
+runAccountCommand service principal command = withMVar (acLock service) $ const run
   where
     -- | 校验并执行身份管理权限
     run
@@ -295,7 +310,7 @@ runAccountCommand service principal command = withMVar (acLock service) $ \_ ->
             case identities of
                 Left err -> pure (Left err)
                 Right accounts
-                    | any (\a -> accountUser a == normalize (target command) && (accountIsSuperuser a || accountSystemCatalogManager a)) 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"))
                     | otherwise -> execute
         | otherwise = execute
@@ -305,12 +320,13 @@ runAccountCommand service principal command = withMVar (acLock service) $ \_ ->
     target (DropAccount name) = name
     target (AlterAccountAttributes name _) = name
     -- | 判断是否修改特权属性
-    privilegedChange (AlterAccountAttributes _ attributes) = any (\(key, _) -> key `elem` ["superuser", "system_catalog_manager"]) attributes
+    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 = \request -> beAccounts (acBackend service) (ReqCatalogManage request)}})
+    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
         ResetAccountPassword name password -> resetPassword managed name password
         DropAccount name -> dropUser managed name
@@ -318,4 +334,4 @@ runAccountCommand service principal command = withMVar (acLock service) $ \_ ->
             | 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 "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

@@ -21,6 +21,7 @@ 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)
@@ -40,8 +41,8 @@ import ChuSQL.Core.Engine.Storage.IPC (
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
 import ChuSQL.Core.Protocol (TxnOp (..))
-import Control.Concurrent.MVar (MVar, modifyMVar, readMVar)
+import Control.Concurrent.MVar (MVar, modifyMVar)
-import Data.List (nub)
+import Data.List (nub, isPrefixOf)
 import Data.Text (Text)
 import Data.Time (getCurrentTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
@@ -75,16 +76,20 @@ data Backend = Backend
 -- | 按给定列名取列，固定列顺序
 columnsFromStatement :: Database -> Statement -> [String]
 columnsFromStatement db stmt = case prepare db stmt of
-    Right (Select cols _ _ _ _ _) -> cols
+    Left _ -> []
-    Right (SelectExpr items _ _ _ _ _) -> map fst items
+    Right resolved -> columnsOf resolved
-    Right ShowDomains -> ["domain", "base_type"]
+  where
-    _ -> []
+    -- | 从已准备的语句提取输出列名
+    columnsOf (SelectDistinct q) = columnsOf q
+    columnsOf Select{selectItems = items} = map fst items
+    columnsOf ShowDomains = ["domain", "base_type"]
+    columnsOf _ = []
 
 -- | 走本地存储链路的后端
 ipcBackend :: IO Backend
 ipcBackend = do
     let backend current = Backend
-            { beStatement = \sql -> runIpc current sql
+            { beStatement = runIpc current
             , beCatalog = do
                 response <- sendRequest (ReqInDatabase current ReqListCatalog)
                 pure $ case response of
@@ -107,8 +112,8 @@ ipcBackend = do
                     RespTables names -> Right names
                     RespError err -> Left err
                     _ -> Left "unexpected database response"
-            , beStorage = \payload -> runRaw payload
+            , beStorage = runRaw
-            , beSnapshot = Right <$> runIPCStorageIn (snapshot :: IPCStorage Database) (sessionEnv current)
+            , beSnapshot = runIPCStorageIn snapshot (sessionEnv current)
             , beApplyTransaction = \ops -> do
                 response <- sendRequest (ReqInDatabase current (ReqApplyTransaction ops))
                 pure $ case response of
@@ -148,10 +153,10 @@ ipcBackend = do
                 Right rows -> do
                     cols <- case rows of
                         [] -> do
-                            db <- runIPCStorageIn (schema :: IPCStorage Database) env
+                            db <- runIPCStorageIn schema env
-                            pure (columnsFromStatement db stmt)
+                            pure (fmap (`columnsFromStatement` stmt) db)
-                        (r : _) -> pure (map fst r)
+                        (r : _) -> pure (Right (map fst r))
-                    pure (Right (StatementResult cols rows))
+                    pure (fmap (`StatementResult` rows) cols)
 
 -- | 测试用内存后端，状态是一个 Database
 memoryBackend :: String -> MVar Database -> Backend
@@ -172,10 +177,10 @@ memoryBackendWith trusted name ref =
                 Left e -> pure (db, Left e)
                 Right (db', rows)
                     | any (\(key, _) -> hidden key && not (domainKey key)) db' -> pure (db, Left "reserved system table")
-                    | otherwise -> pure (mergeScoped db db', Right (StatementResult (colsOf (scoped db) stmt rows) rows))
+                    | otherwise -> pure (syncMemoryObjects name (mergeScoped db db'), Right (StatementResult (colsOf (scoped db) stmt rows) rows))
-        , beCatalog = do
+        , beCatalog = modifyMVar ref $ \original -> do
-            db <- readMVar ref
+            let db = syncMemoryObjects name original
-            pure (Right (map tableInfoOf (filter (not . internalTable . fst) (scoped db))))
+            pure (db, Right (map tableInfoOf (filter (not . internalTable . fst) (scoped db))))
         , bePing = pure True
         , beAccounts = \req -> do
             stamp <- currentStamp
@@ -186,8 +191,10 @@ memoryBackendWith trusted name ref =
                     Right previous -> pure (case req of ReqAccountsList -> db; ReqCatalogManage ReqAccountsList -> db; _ -> storeMemoryIdentities db previous accounts, Right accounts)
         , beWithDatabase = withDatabase
         , beDatabases = pure (Right (nub [name, systemDatabaseName]))
-        , beStorage = \_ -> pure (Left "storage is not available in this backend")
+        , beStorage = memorySecurityRequest name ref
-        , beSnapshot = Right . scoped <$> readMVar ref
+        , beSnapshot = modifyMVar ref $ \original -> do
+            let db = syncMemoryObjects name original
+            pure (db, Right (scoped db))
         , beApplyTransaction = \ops -> modifyMVar ref $ \db -> case applyTransactionMemory ops (scoped db) of
             Left err -> pure (db, Left err)
             Right db' -> pure (mergeScoped db db', Right ())
@@ -224,6 +231,58 @@ memoryBackendWith trusted name ref =
         | null target = noDatabaseBackend (memoryBackendWith False name ref)
         | otherwise = unavailableDatabase ("unknown database: " ++ target) (memoryBackendWith False name ref)
 
+-- 更新内存夹具的稳定表编号。
+syncMemoryObjects :: String -> Database -> Database
+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"
+    previous = [(key, identifier) | row <- maybe [] tableRows (lookup registry db), Just (VStr key) <- [lookup "name" row], Just (VInt identifier) <- [lookup "id" row]]
+    keys = [if '.' `elem` key then key else database ++ "." ++ key | (key, _) <- db, not (internalTable (lastTablePart key))]
+    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))})
+        Nothing -> (key, table)
+    records = [[("name", VStr key), ("id", VInt identifier)] | (key, identifier) <- ("__high_water", high + length added) : retained ++ added]
+
+-- 执行内存夹具的权限快照协议。
+memorySecurityRequest :: String -> MVar Database -> A.Value -> IO (Either String A.Value)
+memorySecurityRequest database ref payload = modifyMVar ref $ \original -> do
+    let db = syncMemoryObjects database original
+    pure $ case operation db of
+        Left err -> (original, Left err)
+        Right (next, value) -> (next, Right value)
+  where
+    -- 读取协议文本字段。
+    field key = case payload of
+        A.Object fields -> case KM.lookup key fields of
+            Just (A.String value) -> Just value
+            _ -> Nothing
+        _ -> Nothing
+    -- 解析并执行一条权限请求。
+    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
+                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
+                        [number] -> Right (A.toJSON number)
+                        _ -> Left "unknown table"
+                Right (db, A.object ["status" A..= ("object" :: Text), "database_id" A..= (if selected == "system" then (2 :: Int) else 1), "object_id" A..= identifier])
+        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
+                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"
+    acl = "__system_object_acl"
+
 -- | 把后端的语句与字典都改成同一条错误
 unavailableDatabase :: String -> Backend -> Backend
 unavailableDatabase message backend = backend
@@ -274,15 +333,15 @@ applyTransactionMemory ops db = foldl step (Right db) ops
 -- | 语句里出现的表
 statementTables :: Statement -> [Text]
 statementTables stmt = nub (case stmt of
+    SelectDistinct q -> statementTables q
     Select{} ->
         tableRefsOf (selectFrom stmt)
-            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt) ++ map Col (selectCols stmt ++ selectGroupBy stmt ++ map fst (selectOrderBy stmt)))
+            ++ concatMap exprTables (maybeToList (selectWhere stmt) ++ maybeToList (selectHaving stmt)
-    SelectExpr{} ->
+                ++ map snd (selectItems stmt) ++ map Col (selectGroupBy stmt)
-        tableRefsOf (selectFrom stmt)
+                ++ mapMaybe (orderKeyExpression . fst) (selectOrderBy stmt))
-            ++ concatMap exprTables (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems stmt) ++ map Col (selectGroupBy stmt ++ map fst (selectOrderBy stmt)))
     Insert table _ rows -> T.pack table : concatMap exprTables (concat rows)
-    Update table assigns cond -> T.pack table : concatMap exprTables (map snd assigns ++ maybe [] (: []) cond)
+    Update table assigns cond -> T.pack table : concatMap exprTables (map snd assigns ++ maybeToList cond)
-    Delete table cond -> T.pack table : concatMap exprTables (maybe [] (: []) cond)
+    Delete table cond -> T.pack table : concatMap exprTables (maybeToList cond)
     CreateTable table _ -> [T.pack table]
     DropTable table -> [T.pack table]
     CreateIndex table _ -> [T.pack table]
@@ -316,12 +375,12 @@ statementNeedsDatabase stmt = case stmt of
 -- | 将当前库限定的结构目标转为裸表名
 scopeDdl :: String -> Statement -> Either String Statement
 scopeDdl current statement = case statement of
-    CreateTable table columns -> (\key -> CreateTable key columns) <$> target table
+    CreateTable table columns -> (`CreateTable` columns) <$> target table
     DropTable table -> DropTable <$> target table
-    CreateIndex table column -> (\key -> CreateIndex key column) <$> target table
+    CreateIndex table column -> (`CreateIndex` column) <$> target table
-    DropIndex table column -> (\key -> DropIndex key column) <$> target table
+    DropIndex table column -> (`DropIndex` column) <$> target table
-    DropColumn table column -> (\key -> DropColumn key column) <$> target table
+    DropColumn table column -> (`DropColumn` column) <$> target table
-    AddColumn table column -> (\key -> AddColumn key column) <$> target table
+    AddColumn table column -> (`AddColumn` column) <$> target table
     RenameColumn table old new -> (\key -> RenameColumn key old new) <$> target table
     AlterColumnType table column ty -> (\key -> AlterColumnType key column ty) <$> target table
     AlterColumnDefault table column value -> (\key -> AlterColumnDefault key column value) <$> target table
@@ -394,6 +453,8 @@ tableInfoOf (name, tbl) =
         , tiRows = length (tableRows tbl)
         , tiIndexes = []
         , tiStats = [(c, distinctOf c, False) | (c, _) <- tableCols tbl]
+        , tiIdentity = tableIdentity tbl
+        , tiSchemaVersion = tableSchemaVersion tbl
         , tiHistograms = [(c, h) | (c, _) <- tableCols tbl, Just h <- [histogramOf (columnValues c)]]
         }
   where
@@ -468,6 +529,10 @@ currentStamp = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> get
 -- | 在内存账号表上执行一条账号请求
 memoryAccounts :: Database -> T.Text -> Request -> Either String [Account]
 memoryAccounts db stamp req = do
+    case req of
+        ReqAccountCreate name _ | T.toLower name == "public" -> Left "public is reserved for default privileges"
+        ReqRoleCreate name | T.toLower name == "public" -> Left "public is reserved for default privileges"
+        _ -> Right ()
     stored <- case lookup "__system_identities" db of
         Just table -> mapM decodeCredential (tableRows table)
         Nothing -> case lookup usersTable db of
@@ -482,28 +547,29 @@ memoryAccounts db stamp req = do
                     ReqAccountCreate name _ -> Just name
                     ReqAccountReset name _ -> Just name
                     ReqAccountDrop name -> Just name
-                    ReqIdentityAlter name _ Nothing _ Nothing -> Just name
+                    ReqIdentityAlter name _ Nothing _ Nothing Nothing -> Just name
                     _ -> Nothing
-                allowed = case command of ReqAccountsList -> True; ReqAccountCreate{} -> True; ReqAccountReset{} -> True; ReqAccountDrop{} -> True; ReqIdentityAlter _ _ Nothing _ Nothing -> True; _ -> False
+                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)) accounts
+            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
         ReqAccountsList -> Right accounts
         ReqIdentityInitialize admin
             | any (`elem` map accountUser accounts) legacyNames || length (nub legacyNames) /= length legacyNames -> Left "identity name collision"
             | otherwise -> Right ([if legacyIdentity a && accountUser a == T.toLower admin then a{accountIsSuperuser = True} else a | a <- accounts] ++
-                [Account (highWater + offset) role "" 1 stamp Nothing False False True False | (offset, role) <- zip [1..] legacyNames])
+                [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])
+            | otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) "" 1 stamp Nothing False False True False False])
-        ReqIdentityAlter u login super enabled manager -> case filter ((== T.toLower u) . accountUser) accounts of
+        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 = maybe (accountCanLogin a) id login,
+            [_] -> preserveSuper [if accountUser a == T.toLower u then a{accountCanLogin = fromMaybe (accountCanLogin a) login,
-                accountIsSuperuser = maybe (accountIsSuperuser a) id super, accountEnabled = maybe (accountEnabled a) id enabled,
+                accountIsSuperuser = fromMaybe (accountIsSuperuser a) super, accountEnabled = fromMaybe (accountEnabled a) enabled,
-                accountSystemCatalogManager = maybe (accountSystemCatalogManager a) id manager,
+                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"
-            | otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) h 1 stamp Nothing True False True False])
+            | otherwise -> Right (accounts ++ [Account (highWater + 1) (T.toLower u) h 1 stamp Nothing True False True False False])
         ReqAccountReset u h -> case filter ((== T.toLower u) . accountUser) accounts of
             [_] -> Right [if accountUser x == T.toLower u then x{accountHash = h, accountRevision = accountRevision x + 1} else x | x <- accounts]
             _ -> Left "unknown account"
@@ -543,9 +609,9 @@ memoryAccounts db stamp req = do
 -- | 分开保存内存身份与口令并清理授权
 storeMemoryIdentities :: Database -> [Account] -> [Account] -> Database
 storeMemoryIdentities db previous accounts =
-    (usersTable, Table usersTable [("id", TInt), ("password_hash", TStr)] credentials Nothing) :
+    (usersTable, Table usersTable [("id", TInt), ("password_hash", TStr)] credentials Nothing Nothing Nothing) :
-    ("__system_identities", Table "__system_identities" [("account", TStr)] identities 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) :
+    ("__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
     -- | 保存口令与身份编号

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

@@ -23,9 +23,10 @@ module ChuSQL.Server.Catalog
     , removeMember
     ) where
 
+import Control.Monad (void)
 import ChuSQL.Core.Model (Row, Value (..))
 import ChuSQL.Core.Protocol (Account (..), Request (..))
-import ChuSQL.Interface.Actions (sqlLiteral)
+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)
@@ -112,11 +113,11 @@ readIdentities catalog = beAccounts (catBackend catalog) ReqAccountsList
 
 -- | 新建一个角色
 insertRole :: Catalog -> Text -> IO (Either String ())
-insertRole catalog role = fmap (fmap (const ())) (beAccounts (catBackend catalog) (ReqRoleCreate (normalizeRole role)))
+insertRole catalog role = fmap void (beAccounts (catBackend catalog) (ReqRoleCreate (normalizeRole role)))
 
 -- | 删掉一个角色，连同它的授权与成员边
 dropRole :: Catalog -> Text -> IO (Either String ())
-dropRole catalog role = fmap (fmap (const ())) (beAccounts (catBackend catalog) (ReqAccountDrop (normalizeRole role)))
+dropRole catalog role = fmap void (beAccounts (catBackend catalog) (ReqAccountDrop (normalizeRole role)))
 
 -- | 全部授权，都不带 grant option
 readGrants :: Catalog -> IO (Either String [Grant])
@@ -213,4 +214,4 @@ roleLiteral = literal . normalizeRole
 
 -- | 文本值的 SQL 字面量
 literal :: Text -> String
-literal = sqlLiteral . VStr . T.unpack
+literal text = "'" ++ escapeStringLiteral (T.unpack text) ++ "'"

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

@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+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)
+import ChuSQL.Interface.Normalization
+import Control.Concurrent.MVar
+import Control.Concurrent.QSem
+import Control.Exception (bracket_, evaluate, mask)
+import Crypto.Hash (Digest, SHA256, hash)
+import qualified Data.Aeson as A
+import Data.Aeson ((.=), object)
+import qualified Data.ByteString.Lazy as BL
+import Data.List (nub, sort)
+import Data.Text (Text)
+import qualified Data.Text as T
+import System.IO.Unsafe (unsafePerformIO)
+import System.Timeout (timeout)
+
+-- 范式服务：有界执行、稳定 schema 指纹与引擎报告的线上表示。
+
+{-# NOINLINE analysisSlots #-}
+-- 保存最多八个请求和两个执行槽。
+analysisSlots :: (MVar Int, QSem)
+analysisSlots = unsafePerformIO ((,) <$> newMVar 0 <*> newQSem 2)
+
+-- 限制排队、执行时间及输出大小。
+normalizationBudget :: IO (Either (Text, Text) A.Value) -> IO (Either (Text, Text) A.Value)
+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
+            result <- restore $ timeout 5000000 $ bracket_ (waitQSem slots) (signalQSem slots) $ do
+                outcome <- action
+                case outcome of
+                    Left err -> pure (Left err)
+                    Right value -> do
+                        size <- evaluate (BL.length (BL.take 64001 (A.encode value)))
+                        pure (if size > 64000 then Left ("too_large", "normalization report exceeds transport budget") else Right value)
+            pure (fromMaybe (Left ("timeout", "normalization exceeded its five second budget")) result)
+
+-- 编码只影响语义的列信息。
+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)]
+
+-- 将稳定编号与列结构绑定到 SHA256。
+schemaFingerprint :: ObjectIdentity -> [SchemaColumn] -> Text
+schemaFingerprint (ObjectIdentity database table) columns = T.pack (show (hash (BL.toStrict (A.encode (A.toJSON [A.toJSON [show database, show table], A.toJSON (map fingerprintColumn columns)]))) :: Digest SHA256))
+
+-- 绑定 schema 并编码只读分析报告。
+normalizationReport :: ObjectIdentity -> [SchemaColumn] -> Text -> NormalizationRequest -> Either (Text, Text) A.Value
+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 ()
+    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)])
+  where
+    -- 还原列类型及声明约束而不读取数据。
+    column c = case parseColumnType (scType c) of
+        Nothing -> Left ("storage_error", "normalization: invalid schema type")
+        Just ty -> Right (scName c, Column ty (scNullable c) (scDefault c) (scAutoIncrement c) (scUnique c) (scPrimaryKey c) (scCheck c))
+
+-- 规范化经验证的声明属性集合。
+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])]}
+
+-- 编码稳定范式标签及证据。
+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]
+
+-- 编码一次分解的理论结论。
+decompositionJSON :: N.Decomposition -> A.Value
+decompositionJSON d = object ["relations" .= N.relations d, "lossless_join" .= verdictTag (N.losslessJoin d), "dependency_preserving" .= verdictTag (N.dependencyPreserving d)]
+
+-- 输出稳定的范式名称。
+formTag :: N.NormalForm -> Text
+formTag N.NF1 = "1nf"
+formTag N.NF2 = "2nf"
+formTag N.NF3 = "3nf"
+formTag N.BCNF = "bcnf"
+
+-- 输出稳定的结论标签。
+verdictTag :: N.Verdict -> Text
+verdictTag N.Satisfied = "satisfied"
+verdictTag N.Violated = "violated"
+verdictTag N.Insufficient = "insufficient"

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

@@ -0,0 +1,447 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+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 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.List (nub)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import GHC.Generics (Generic)
+
+-- 稳定对象权限目录：保存所有者、授予来源并计算有效授权链。
+
+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 }
+    deriving (Eq, Show, Generic)
+instance ToJSON Edge
+instance FromJSON Edge
+
+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 }
+    deriving (Eq, Show, Generic)
+instance ToJSON Pending
+instance FromJSON 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..!= [])
+
+data Context = Context { contextIdentities :: [Account], contextMembers :: [(Text, Text)], contextTargets :: [Target] }
+
+-- 解析存储响应并保留明确错误。
+request :: Backend -> A.Value -> IO (Either String A.Value)
+request backend payload = fmap (>>= response) (beStorage backend payload)
+  where
+    -- 检查响应状态。
+    response value@(A.Object fields) = case KM.lookup "status" fields of
+        Just (A.String "error") -> case KM.lookup "message" fields of Just (A.String message) -> Left (T.unpack message); _ -> Left "invalid storage error"
+        Just (A.String _) -> Right value
+        _ -> Left "invalid storage response"
+    response _ = Left "invalid storage response"
+
+-- 从响应取必需字段。
+field :: Text -> A.Value -> Either String A.Value
+field name (A.Object fields) = maybe (Left ("missing field: " ++ T.unpack name)) Right (KM.lookup (K.fromText name) fields)
+field _ _ = Left "invalid storage object"
+
+-- 将存储编号规范为文本。
+identifier :: A.Value -> Either String Text
+identifier (A.Number number) | number > 0 = Right (T.pack (BL.unpack (A.encode (A.Number number))))
+identifier _ = Left "invalid object identifier"
+
+-- 按 catalog 解析数据库或表对象。
+resolve :: Backend -> Text -> Text -> IO (Either String Target)
+resolve backend database raw = do
+    let object = T.toLower (T.strip raw)
+        (selected, table, kind, label)
+            | "database:" `T.isPrefixOf` object = (T.drop 9 object, Nothing, "database", object)
+            | object == "*" || ".*" `T.isSuffixOf` object =
+                let scope = if object == "*" then database else T.dropEnd 2 object
+                in (scope, Nothing, "tables", scope <> ".*")
+            | otherwise = case T.splitOn "." object of
+                [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
+        result <- request backend (A.object (["method" A..= ("resolve_object" :: Text), "database" A..= selected] ++ maybe [] (\name -> ["table" A..= name]) table))
+        pure $ do
+            value <- result
+            dbId <- field "database_id" value >>= identifier
+            tableId <- case table of Nothing -> Right Nothing; Just _ -> Just <$> (field "object_id" value >>= identifier)
+            if selected == "system" then Left "system objects cannot be granted" else Right (Target dbId tableId kind label)
+
+-- 展开当前 catalog 中的稳定业务对象。
+targets :: Backend -> IO (Either String [Target])
+targets backend = do
+    names <- beDatabases backend
+    case names of
+        Left err -> pure (Left err)
+        Right databases -> fmap concat . sequence <$> mapM one (filter (/= "system") databases)
+  where
+    -- 展开一个数据库和它的表。
+    one name = do
+        database <- resolve backend "" ("database:" <> T.pack name)
+        catalog <- beCatalog (beWithDatabase backend name)
+        case catalog of
+            Left err -> pure (Left err)
+            Right infos -> do
+                tables <- mapM (resolve backend (T.pack name) . T.pack . tableNameOf) infos
+                pure ((:) <$> database <*> sequence tables)
+    -- 取数据字典的表名。
+    tableNameOf = tiTable
+
+-- 读取身份、成员边和对象字典。
+context :: Backend -> Catalog -> IO (Either String Context)
+context backend catalog = do
+    identities <- readIdentities catalog
+    members <- readMembers catalog
+    objects <- targets backend
+    pure (Context <$> identities <*> members <*> objects)
+
+-- 查找身份的稳定编号。
+roleId :: Context -> Text -> Either String Text
+roleId env name = case [T.pack (show (accountId account)) | account <- contextIdentities env, accountUser account == T.toLower name] of
+    [value] -> Right value
+    [] | T.toLower (T.strip name) == "public" -> Right "public"
+    _ -> Left ("unknown role: " ++ T.unpack name)
+
+-- 从编号查回公开身份名。
+roleName :: Context -> Text -> Text
+roleName _ "public" = "public"
+roleName env value = case [accountUser account | account <- contextIdentities env, T.pack (show (accountId account)) == value] of name : _ -> name; [] -> ""
+
+-- 判断身份当前是否贡献权限。
+active :: Context -> Text -> Bool
+active _ "0" = True
+active _ "public" = True
+active env value = any (\account -> T.pack (show (accountId account)) == value && accountEnabled account) (contextIdentities env)
+
+-- 判断稳定身份是否仍存在。
+knownRole :: Context -> Text -> Bool
+knownRole env value = value `elem` ["0", "public"] || any (\account -> T.pack (show (accountId account)) == value) (contextIdentities env)
+
+-- 展开一个身份继承的有效角色编号。
+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]
+    -- 展开成员关系的向上闭包。
+    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)
+
+-- 判断稳定对象当前是否存在。
+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)
+
+-- 判断身份是否拥有指定对象。
+owns :: Context -> ACL -> Text -> Target -> Bool
+owns env acl identity target = any (\owner -> ownerRole owner `elem` roles env identity && ownerTarget owner == target && active env (ownerRole owner)) (aclOwners acl)
+
+-- 计算仍有合法授予来源的授权闭包。
+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)]}
+  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]
+                 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)
+
+-- 读取并校验权限快照。
+readACL :: Backend -> IO (Either String (Maybe Text, Maybe ACL))
+readACL backend = do
+    result <- request backend (A.object ["method" A..= ("object_acl_read" :: Text)])
+    pure $ do
+        value <- result
+        rows <- field "rows" value
+        case rows of
+            A.Array values -> case foldr (:) [] values of
+              [] -> Right (Nothing, Nothing)
+              [row] -> do
+                payload <- field "payload" row
+                case payload of
+                    A.String text -> case A.eitherDecodeStrict (TE.encodeUtf8 text) of
+                        Left err -> Left ("invalid object ACL: " ++ err)
+                        Right acl | aclVersion acl == 1 -> Right (Just text, Just acl)
+                        Right _ -> Left "unsupported object ACL version"
+                    _ -> Left "invalid object ACL payload"
+              _ -> Left "invalid object ACL rows"
+            _ -> Left "invalid object ACL rows"
+
+-- 原子写入权限快照并检查并发版本。
+writeACL :: Backend -> Maybe Text -> ACL -> IO (Either String ())
+writeACL backend expected acl = void <$> request backend (A.object ["method" A..= ("object_acl_replace" :: Text), "expected" A..= expected, "payload" A..= TE.decodeUtf8 (BL.toStrict (A.encode acl))])
+
+-- 将旧名称授权一次性绑定到现存对象。
+migrate :: Backend -> Catalog -> Context -> IO (Either String ACL)
+migrate backend catalog env = do
+    grants <- readGrants catalog
+    options <- readGrantOptions catalog
+    case (,) <$> grants <*> options of
+        Left err -> pure (Left err)
+        Right (rows, optionRows) -> fmap (fmap (\edges -> ACL 1 (concat edges) [] [] []) . sequence) (mapM (one optionRows) rows)
+  where
+    -- 转换一条旧授权记录。
+    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"])
+                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
+                Left "unknown table" -> Right []
+                Left "unknown database" -> Right []
+                Left err -> Left err
+                Right found -> Right [Edge identity "0" target (grantPrivilege grant) option True | target <- found]
+
+-- 取得迁移完成且来源有效的权限快照。
+load :: Backend -> Catalog -> IO (Either String (Context, Maybe Text, ACL))
+load backend catalog = do
+    env <- context backend catalog
+    stored <- readACL backend
+    case (,) <$> env <*> stored of
+        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]
+                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
+        Right (current, (previous, Nothing)) -> do
+            migrated <- migrate backend catalog current
+            case migrated of
+                Left err -> pure (Left err)
+                Right acl -> do
+                    written <- writeACL backend previous acl
+                    case written of
+                        Left "object ACL changed concurrently" -> load backend catalog
+                        Left err -> pure (Left err)
+                        Right () -> load backend catalog
+
+-- 检查作用域权限或所有权。
+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)
+
+-- 按对象类型展开和校验权限名称。
+privileges :: Target -> [Text] -> Either String [Text]
+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)
+
+-- 检查一组稳定对象上的业务权限。
+objectAuthorize :: Backend -> Catalog -> Principal -> Text -> [(Text, Text)] -> IO (Either String ())
+objectAuthorize backend catalog principal database needed = do
+    loaded <- load backend catalog
+    objects <- mapM (resolve backend database . fst) needed
+    pure $ do
+        (env, _, acl) <- loaded
+        found <- sequence objects
+        identity <- roleId env (principalName principal)
+        if active env identity then Right () else Left "permission denied: disabled identity"
+        case [(name, privilege) | ((name, privilege), target) <- zip needed found, not (allowed env acl identity target privilege False)] of
+            [] -> Right ()
+            (name, privilege) : _ -> Left ("permission denied: " ++ T.unpack (T.toUpper privilege <> " ON " <> name))
+
+-- 检查数据库连接权限。
+objectConnect :: Backend -> Catalog -> Principal -> Text -> IO (Either String ())
+objectConnect backend catalog principal database = objectAuthorize backend catalog principal "" [("database:" <> database, "connect")]
+
+-- 授予权限并记录授予者的稳定身份。
+objectGrant :: Backend -> Catalog -> Principal -> Text -> [Text] -> Text -> Text -> Bool -> IO (Either String ())
+objectGrant backend catalog principal database names object role option = do
+    loaded <- load backend catalog
+    resolved <- resolve backend database object
+    case (,) <$> loaded <*> resolved of
+        Left err -> pure (Left err)
+        Right ((env, previous, acl), target) -> case 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
+                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]
+                        writeACL backend previous acl{aclEdges = remaining ++ promoted, aclClosed = if recipient == "public" && "connect" `elem` items then filter (/= targetDatabase target) (aclClosed acl) else aclClosed acl}
+  where
+    -- 比较同一授予来源的授权键。
+    same one other = edgeRole one == edgeRole other && edgeGrantor one == edgeGrantor other && edgeTarget one == edgeTarget other && edgePrivilege one == edgePrivilege other
+
+-- 撤销授权并收敛失去来源的下游授权。
+objectRevoke :: Backend -> Catalog -> Principal -> Text -> [Text] -> Text -> Text -> IO (Either String ())
+objectRevoke = revokeObject False
+
+-- 仅撤销转授权能力并清理失效来源。
+objectRevokeGrantOption :: Backend -> Catalog -> Principal -> Text -> [Text] -> Text -> Text -> IO (Either String ())
+objectRevokeGrantOption = revokeObject True
+
+-- 按授予来源撤销权限或转授权能力。
+revokeObject :: Bool -> Backend -> Catalog -> Principal -> Text -> [Text] -> Text -> Text -> IO (Either String ())
+revokeObject optionOnly backend catalog principal database names object role = do
+    loaded <- load backend catalog
+    resolved <- resolve backend database object
+    case (,) <$> loaded <*> resolved of
+        Left err -> pure (Left err)
+        Right ((env, previous, acl), target) -> case (,,) <$> roleId env role <*> privileges target names <*> (if principalIsRoot principal then Right "0" else roleId env (principalName principal)) of
+            Left err -> pure (Left err)
+            Right (recipient, items, grantor) -> do
+                let manager = principalIsRoot principal || owns env acl grantor target
+                    -- 选择本次可撤销的授予来源。
+                    matches edge = edgeRole edge == recipient && edgeTarget edge == target && edgePrivilege edge `elem` items && (manager || edgeGrantor edge == grantor)
+                    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")
+                    else writeACL backend previous (effective env next)
+
+-- 返回公开名称形式的有效授权。
+objectViews :: Backend -> Catalog -> Text -> IO (Either String [Grant])
+objectViews backend catalog role = do
+    loaded <- load backend catalog
+    pure $ do
+        (env, _, acl) <- loaded
+        identity <- roleId env role
+        let mine = [edge | edge <- aclEdges acl, edgeRole edge == identity]
+        Right (nub [Grant role (edgePrivilege edge) (targetName (edgeTarget edge)) (any (\other -> edgeTarget other == edgeTarget edge && edgePrivilege other == edgePrivilege edge && edgeOption other) mine) | edge <- mine])
+
+-- 列出当前身份实际拥有的对象权限。
+objectSelfViews :: Backend -> Catalog -> Principal -> IO (Either String [Grant])
+objectSelfViews backend catalog principal = do
+    loaded <- load backend catalog
+    pure $ do
+        (env, _, acl) <- loaded
+        identity <- roleId env (principalName principal)
+        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)
+            | target <- contextTargets env
+            , privilege <- if targetKind target == "database" then ["connect", "create"] else ["select", "insert", "update", "delete"]
+            , permitted target privilege False]
+
+-- 登记新对象的创建者为所有者。
+objectClaim :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
+objectClaim backend catalog principal database object = do
+    loaded <- load backend catalog
+    resolved <- resolve backend database object
+    case (,) <$> loaded <*> resolved of
+        Left err -> pure (Left err)
+        Right ((env, previous, acl), target) -> case roleId env (principalName principal) of
+            Left err -> pure (Left err)
+            Right identity -> writeACL backend previous acl{aclOwners = Owner identity target : filter ((/= target) . ownerTarget) (aclOwners acl)}
+
+-- 在建表前持久化创建者声明。
+objectPrepareCreate :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
+objectPrepareCreate backend catalog principal database raw = do
+    loaded <- load backend catalog
+    parent <- resolve backend "" ("database:" <> database)
+    case (,) <$> loaded <*> parent of
+        Left err -> pure (Left err)
+        Right ((env, previous, acl), target) -> case roleId env (principalName principal) of
+            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 ())
+                    else writeACL backend previous acl{aclPending = [Pending identity (targetDatabase target) name]}
+
+-- 清理失效身份、成员来源和已删除对象。
+objectReconcile :: Backend -> Catalog -> IO (Either String ())
+objectReconcile backend catalog = do
+    loaded <- load backend catalog
+    case loaded of Left err -> pure (Left err); Right (_, previous, acl) -> writeACL backend previous acl
+
+-- 列出对象权限变更需失效的身份。
+objectAffected :: Backend -> Catalog -> [Text] -> IO (Either String [Text])
+objectAffected backend catalog names = do
+    loaded <- load backend catalog
+    pure $ 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)]
+                        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)
+
+-- 检查稳定对象的所有者权限。
+objectOwner :: Backend -> Catalog -> Principal -> Text -> Text -> IO (Either String ())
+objectOwner backend catalog principal database object = do
+    loaded <- load backend catalog
+    resolved <- resolve backend database object
+    pure $ do
+        (env, _, acl) <- loaded
+        target <- resolved
+        identity <- roleId env (principalName principal)
+        if owns env acl identity target then Right () else Left "object owner required"
+
+-- 展开删除对象时需失效的授权身份。
+objectUsers :: Backend -> Catalog -> Text -> Text -> IO (Either String [Text])
+objectUsers backend catalog database object = do
+    loaded <- load backend catalog
+    resolved <- resolve backend database object
+    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]
+                    ++ [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,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+
 
 module ChuSQL.Server.Policy (
     configurePasswordPolicy,

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

@@ -1,445 +1,244 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.Server.Privileges (
+module ChuSQL.Server.Privileges
-    Grant (..),
+    ( Grant (..), Membership (..), PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView (..)
-    Membership (..),
+    , affectedAccounts, authorize, authorizeTables, authorizeConnect, filterTables, listRoleViews, listSelfGrants
-    PrivilegeCommand (..),
+    , newPrivileges, normalizeObject, privilegeCommand, runPrivilegeCommand, claimObject, prepareObject, reconcileObjects, affectedObject
-    PrivilegeError (..),
+    ) where
-    Privileges,
-    RoleView (..),
-    affectedAccounts,
-    authorize,
-    authorizeTables,
-    filterTables,
-    listRoleViews,
-    newPrivileges,
-    normalizeObject,
-    privilegeCommand,
-    runPrivilegeCommand,
-) where
 
+import Data.Maybe (maybeToList)
 import ChuSQL.Core.Engine.Syntax.AST
 import ChuSQL.Core.Protocol (Account (..))
-import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalIsCatalogManager, principalName)
 import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
-import ChuSQL.Server.Backend (
+import ChuSQL.Server.Accounts (Principal, principalIsRoot, principalIsCatalogManager)
-    Backend (..),
+import ChuSQL.Server.Backend (Backend (..), exprTables, statementTables, systemDatabaseName)
-    exprTables,
+import ChuSQL.Server.Catalog
-    systemDatabaseName,
+import qualified ChuSQL.Server.ObjectACL as OA
-    tableRefsOf,
- )
-import ChuSQL.Server.Catalog (
-    Catalog,
-    addGrant,
-    addGrantOption,
-    addMember,
-    dropRole,
-    eachAction,
-    insertRole,
-    newCatalog,
-    normalizeObject,
-    normalizeRole,
-    normalizeUser,
-    readGrantOptions,
-    readGrants,
-    readMembers,
-    readRoleNames,
-    readIdentities,
-    removeGrant,
-    removeGrantOption,
-    removeMember,
-    withCatalogLock,
-    ensureCatalog,
- )
 import Data.List (nub, sort)
 import Data.Text (Text)
 import qualified Data.Text as T
 
--- 角色与权限服务：角色、授权与成员关系落在 system 库的表里，并据此判权限。
+-- 权限服务：稳定对象授权、角色继承与受影响会话展开。
 
--- | 出错口径与账号服务一致
+data PrivilegeError = PrivilegeError Text Text deriving (Show, Eq)
-data PrivilegeError = PrivilegeError Text Text
+data Membership = Membership { memberRole :: Text, memberUser :: Text } deriving (Show, Eq, Ord)
-    deriving (Show, Eq)
+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
-    | GrantRoleCommand Text [Text]
-    | RevokeRoleCommand Text [Text]
-    deriving (Show, Eq)
-
-data Privileges = Privileges
-    { pvCatalog :: Catalog
-    }
-
--- | 建权限服务，固定在 system 库上
 newPrivileges :: Backend -> IO Privileges
-newPrivileges base = Privileges <$> newCatalog (beWithDatabase base systemDatabaseName)
+newPrivileges backend = do
+    directory <- newCatalog (beWithDatabase backend systemDatabaseName)
+    pure (Privileges directory backend)
 
--- | 语句转管理命令，不认的给 Nothing
+-- 将管理语句转换为权限命令。
 privilegeCommand :: Statement -> Maybe PrivilegeCommand
-privilegeCommand stmt = case stmt of
+privilegeCommand statement = case statement of
     CreateRole name -> Just (CreateRoleCommand (T.pack name))
     DropRole name -> Just (DropRoleCommand (T.pack name))
-    GrantPrivileges privs obj role withOption ->
+    GrantPrivileges items object role option -> Just (GrantPrivilegesCommand (map (T.toLower . T.pack) items) (T.pack object) (T.pack role) option)
-        Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role) withOption)
+    RevokeGrantOption items object role -> Just (RevokeGrantOptionCommand (map (T.toLower . T.pack) items) (T.pack object) (T.pack role))
-    RevokePrivileges privs obj role ->
+    RevokePrivileges items object role -> Just (RevokePrivilegesCommand (map (T.toLower . T.pack) items) (T.pack object) (T.pack role))
-        Just (RevokePrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role))
     GrantRole role members -> Just (GrantRoleCommand (T.pack role) (map T.pack members))
     RevokeRole role members -> Just (RevokeRoleCommand (T.pack role) (map T.pack members))
     _ -> Nothing
 
--- | 执行管理命令：管理员全通，普通身份只能转授自己拿到的权限
+-- 执行角色管理或有来源记录的对象授权。
 runPrivilegeCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
-runPrivilegeCommand service principal database command
+runPrivilegeCommand service principal database command = withTables service $ case command of
-    | needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected"))
+    GrantPrivilegesCommand items object role option -> catalog (OA.objectGrant backend directory principal database items object role option)
-    | principalIsRoot principal = withTables service (applyCommand service database command)
+    RevokeGrantOptionCommand items object role -> catalog (OA.objectRevokeGrantOption backend directory principal database items object role)
-    | principalIsCatalogManager principal = case command of
+    RevokePrivilegesCommand items object role -> catalog (OA.objectRevoke backend directory principal database items object role)
-        CreateRoleCommand{} -> withTables service (applyCommand service database command)
+    CreateRoleCommand role
-        DropRoleCommand{} -> pure (Left forbidden)
+        | principalIsCatalogManager principal -> do
-        _ -> withTables service (delegateCommand service principal database command)
+            known <- catalog (readRoleNames directory)
-    | otherwise = withTables service (delegateCommand service principal database command)
-  where
-    -- | 授权到具体对象时需要先选库
-    needsDatabase = T.null database && case command of
-        GrantPrivilegesCommand _ object _ _ -> T.strip object /= "*"
-        RevokePrivilegesCommand _ object _ -> T.strip object /= "*"
-        _ -> False
-
--- | 一条命令会影响的账号：角色连它的成员一起展开，账号名原样留下
-affectedAccounts :: Privileges -> PrivilegeCommand -> IO [Text]
-affectedAccounts service command = do
-    known <- roleNames service
             case known of
-        Left _ -> pure (direct command)
+                Left err -> pure (Left err)
-        Right roles -> walk roles [] (direct command)
+                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
+        | principalIsRoot principal -> after (catalog (dropRole directory role))
+    GrantRoleCommand role members
+        | principalIsRoot principal -> do
+            known <- catalog (readRoleNames directory)
+            edges <- catalog (readMembers directory)
+            case (,) <$> known <*> edges of
+                Left err -> pure (Left err)
+                Right (names, pairs) -> case validateMembers names pairs role members of
+                    Left err -> pure (Left err)
+                    Right () -> eachAction members $ \member -> if (normalizeRole role, normalizeUser member) `elem` pairs then pure (Right ()) else catalog (addMember directory role member)
+    RevokeRoleCommand role members
+        | principalIsRoot principal -> after (eachAction members (catalog . removeMember directory role))
+    _ -> pure (Left forbidden)
   where
-    -- | 命令直接点到的名字
+    backend = pvBackend service
-    direct cmd = case cmd of
+    directory = pvCatalog service
+    -- 清理成员或身份变更失效的授权链。
+    after action = do
+        result <- action
+        case result of Left err -> pure (Left err); Right () -> catalog (OA.objectReconcile backend directory)
+
+-- 在写入前校验全部成员和循环依赖。
+validateMembers :: [Text] -> [(Text, Text)] -> Text -> [Text] -> Either PrivilegeError ()
+validateMembers names pairs role members
+    | parent `notElem` names = Left (PrivilegeError "not_found" ("unknown role: " <> role))
+    | any ((`notElem` names) . normalizeUser) members = Left (PrivilegeError "not_found" "unknown role member")
+    | otherwise = foldMembers pairs members
+  where
+    parent = normalizeRole role
+    -- 逐项加入候选成员边并检查闭包。
+    foldMembers _ [] = Right ()
+    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
+
+-- 展开角色的继承闭包。
+closureUp :: [(Text, Text)] -> [Text] -> [Text]
+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))
+
+-- 展开成员和转授权变更影响的全部身份。
+affectedAccounts :: Privileges -> PrivilegeCommand -> IO (Either PrivilegeError [Text])
+affectedAccounts service command = withTables service (catalog (OA.objectAffected (pvBackend service) (pvCatalog service) direct))
+  where
+    direct = case command of
         CreateRoleCommand _ -> []
         DropRoleCommand role -> [role]
         GrantPrivilegesCommand _ _ role _ -> [role]
+        RevokeGrantOptionCommand _ _ role -> [role]
         RevokePrivilegesCommand _ _ role -> [role]
         GrantRoleCommand _ members -> members
         RevokeRoleCommand _ members -> members
-    -- | 是角色就接着往下走它的成员，走过的名字不再走第二遍
-    walk _ seen [] = pure (reverse seen)
-    walk roles seen (name : rest)
-        | name `elem` seen = walk roles seen rest
-        | normalizeRole name `elem` roles = do
-            members <- membersOfRole service name
-            case members of
-                Left _ -> walk roles (name : seen) rest
-                Right found -> walk roles (name : seen) (found ++ rest)
-        | otherwise = walk roles (name : seen) rest
 
--- | 语句鉴权：管理员全通，普通身份按需查
+-- 检查 SQL 的对象作用域权限。
 authorize :: Privileges -> Principal -> Text -> Statement -> IO (Either PrivilegeError ())
-authorize service principal database stmt
+authorize service principal database statement
     | principalIsRoot principal = pure (Right ())
-    | otherwise = case requiredActions stmt of
+    | otherwise = case statement of
-        Nothing -> pure (Left forbidden)
+        CreateTable{} -> authorizeTables service principal database [("database:" <> database, "create")]
-        Just needed -> authorizeTables service principal database needed
+        DropDatabase name -> owner ("database:" <> T.pack name)
+        DropTable name -> owner (T.pack name)
+        CreateIndex name _ -> owner (T.pack name)
+        DropIndex name _ -> owner (T.pack name)
+        DropColumn name _ -> owner (T.pack name)
+        AddColumn name _ -> owner (T.pack name)
+        RenameColumn name _ _ -> owner (T.pack name)
+        AlterColumnType name _ _ -> owner (T.pack name)
+        AlterColumnDefault name _ _ -> owner (T.pack name)
+        AlterColumnNull name _ _ -> owner (T.pack name)
+        ShowDomains -> authorizeConnect service principal database
+        ShowDatabases -> pure (Right ())
+        _ -> case requiredActions statement of Nothing -> pure (Left forbidden); Just needed -> authorizeTables service principal database needed
+  where
+    -- 检查结构操作的对象所有权。
+    owner object = withTables service (catalog (OA.objectOwner (pvBackend service) (pvCatalog service) principal database object))
 
--- | 直接查一组 (表, 权限)：一键接口用这个
+-- 检查数据库的 CONNECT 权限。
+authorizeConnect :: Privileges -> Principal -> Text -> IO (Either PrivilegeError ())
+authorizeConnect service principal database
+    | principalIsRoot principal = pure (Right ())
+    | otherwise = withTables service (catalog (OA.objectConnect (pvBackend service) (pvCatalog service) principal database))
+
+-- 检查 CONNECT 和表上的业务权限。
 authorizeTables :: Privileges -> Principal -> Text -> [(Text, Text)] -> IO (Either PrivilegeError ())
 authorizeTables service principal database needed
     | principalIsRoot principal = pure (Right ())
+    | T.null database && (not . all (T.isPrefixOf "database:" . fst)) needed = pure (Left (PrivilegeError "no_database" "no database selected"))
     | otherwise = withTables service $ do
-        grants <- grantsOfUser service (principalName principal)
+        connected <- if T.null database then pure (Right ()) else catalog (OA.objectConnect (pvBackend service) (pvCatalog service) principal database)
-        pure (grants >>= \found -> checkAll database found needed)
+        case connected of Left err -> pure (Left err); Right () -> catalog (OA.objectAuthorize (pvBackend service) (pvCatalog service) principal database needed)
 
--- | 只留下用户有 SELECT 权的表
+-- 仅返回拥有 SELECT 权限的表名。
 filterTables :: Privileges -> Principal -> Text -> [Text] -> IO (Either PrivilegeError [Text])
 filterTables service principal database tables
     | principalIsRoot principal = pure (Right tables)
-    | otherwise = withTables service $ do
+    | otherwise = do
-        grants <- grantsOfUser service (principalName principal)
+        connected <- authorizeConnect service principal database
-        pure ((\found -> [table | table <- tables, checkAll database found [(table, "select")] == Right ()]) <$> grants)
+        case connected of
+            Left err -> pure (Left err)
+            Right () -> do
+                results <- mapM (\table -> authorizeTables service principal database [(table, "select")]) tables
+                pure $ case [err | Left err@(PrivilegeError code _) <- results, code /= "forbidden"] of
+                    err : _ -> Left err
+                    [] -> Right [table | (table, Right ()) <- zip tables results]
 
--- | 角色总览（REST 与测试用）
+-- 返回角色的有效对象授权和直接成员。
 listRoleViews :: Privileges -> IO (Either PrivilegeError [RoleView])
 listRoleViews service = withTables service $ do
-    names <- fmap (fmap (map accountUser . filter (not . accountCanLogin))) (catalog (readIdentities (pvCatalog service)))
+    names <- catalog (readIdentities (pvCatalog service))
-    case names of
+    members <- catalog (readMembers (pvCatalog service))
+    case (,) <$> names <*> members of
         Left err -> pure (Left err)
-        Right known -> sequence <$> mapM view (sort known)
+        Right (identities, pairs) -> sequence
+                                       <$>
+                                         mapM
+                                           (view pairs)
+                                           (sort
+                                              (map accountUser (filter (not . accountCanLogin) identities)))
   where
-    -- | 组装一个角色的总览
+    -- 组装一个角色的公开权限视图。
-    view role = do
+    view members name = do
-        grants <- roleGrantsOf service role
+        grants <- catalog (OA.objectViews (pvBackend service) (pvCatalog service) name)
-        members <- membersOfRole service role
+        pure ((\rows -> RoleView name rows [member | (role, member) <- members, role == name]) <$> grants)
-        pure (RoleView role <$> grants <*> members)
 
--- | 一条语句需要哪些 (表, 权限)
+-- 登记创建对象的所有者。
+claimObject :: Privileges -> Principal -> Text -> Text -> IO (Either PrivilegeError ())
+claimObject service principal database object = withTables service (catalog (OA.objectClaim (pvBackend service) (pvCatalog service) principal database object))
+
+-- 持久化即将建表的所有者声明。
+prepareObject :: Privileges -> Principal -> Text -> Text -> IO (Either PrivilegeError ())
+prepareObject service principal database object = withTables service (catalog (OA.objectPrepareCreate (pvBackend service) (pvCatalog service) principal database object))
+
+-- 获取删除对象影响的授权身份。
+affectedObject :: Privileges -> Text -> Text -> IO (Either PrivilegeError [Text])
+affectedObject service database object = withTables service (catalog (OA.objectUsers (pvBackend service) (pvCatalog service) database object))
+
+-- 清理身份或对象删除后的权限记录。
+reconcileObjects :: Privileges -> IO (Either PrivilegeError ())
+reconcileObjects service = withTables service (catalog (OA.objectReconcile (pvBackend service) (pvCatalog service)))
+
+-- 收集数据语句及子查询所需的表权限。
 requiredActions :: Statement -> Maybe [(Text, Text)]
-requiredActions stmt = case stmt of
+requiredActions statement = case statement of
-    Select{} -> Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt)))
+    SelectDistinct q -> requiredActions q
-    SelectExpr{} ->
+    Select{} -> Just [(ref, "select") | ref <- statementTables statement]
-        Just (selectNeeds (selectFrom stmt) (maybe [] (: []) (selectWhere stmt) ++ map snd (selectItems stmt)))
     Insert table _ rows -> Just ((T.pack table, "insert") : selectsOf (concat rows))
-    Update table assigns cond -> Just ((T.pack table, "update") : selectsOf (map snd assigns ++ maybe [] (: []) cond))
+    Update table assignments condition -> Just ((T.pack table, "update") : selectsOf (map snd assignments ++ maybeToList condition))
-    Delete table cond -> Just ((T.pack table, "delete") : selectsOf (maybe [] (: []) cond))
+    Delete table condition -> Just ((T.pack table, "delete") : selectsOf (maybeToList condition))
     _ -> Nothing
   where
-    -- | FROM 子句要的 SELECT 权限
+    -- 收集表达式中子查询的读取权限。
-    selectNeeds source exprs = [(ref, "select") | ref <- nub (tableRefsOf source)] ++ selectsOf exprs
+    selectsOf expressions = [(ref, "select") | ref <- nub (concatMap exprTables expressions)]
-    -- | 表达式里子查询要的 SELECT 权限
-    selectsOf exprs = [(ref, "select") | ref <- nub (concatMap exprTables exprs)]
 
--- | 每项 (表, 权限) 都要被某条授权覆盖
+-- 持目录锁并确保旧权限表存在。
-checkAll :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
-checkAll database grants needed = checkCovered database grants needed "permission denied: "
-
--- | 转授权要查 grant option，报错口径与普通鉴权分开
-checkOptions :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
-checkOptions database grants needed = checkCovered database grants needed "grant option required: "
-
--- | 覆盖检查的公共实现
-checkCovered :: Text -> [Grant] -> [(Text, Text)] -> Text -> Either PrivilegeError ()
-checkCovered database grants needed prefix = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of
-    [] -> Right ()
-    ((table, privilege) : _) ->
-        Left (PrivilegeError "forbidden" (prefix <> T.toUpper privilege <> " ON " <> table))
-  where
-    -- | 某一项是否被授权覆盖
-    covered table privilege =
-        let target = normalizeObject database table
-         in any
-                (\grant -> (grantObject grant == "*" || grantObject grant == target) && grantPrivilege grant == privilege)
-                grants
-
--- | 一个用户实际能用的授权：含角色继承
-grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
-grantsOfUser service user = do
-    members <- catalog (readMembers (pvCatalog service))
-    grants <- catalog (readGrants (pvCatalog service))
-    options <- catalog (readGrantOptions (pvCatalog service))
-    roles <- catalog (readIdentities (pvCatalog service))
-    pure $ do
-        memberRows <- members
-        grantRows <- grants
-        optionRows <- options
-        identities <- roles
-        let known = map accountUser (filter accountEnabled identities)
-            disabled = map accountUser (filter (not . accountEnabled) identities)
-            activeMembers = [(role, member) | (role, member) <- memberRows, role `elem` known, member `notElem` disabled]
-            edges = roleEdges activeMembers known
-            mine = if normalizeUser user `elem` disabled then [] else closureUp edges
-                (normalizeUser user : [role | (role, member) <- activeMembers, member == normalizeUser user])
-        pure [grant | grant <- grantRows ++ optionRows, grantRole grant `elem` mine]
-
--- | 一个用户手里的 grant option，只有这些能再转授
-optionsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
-optionsOfUser service user = fmap (fmap (filter grantable)) (grantsOfUser service user)
-
--- | 角色到角色的成员边：父角色在前
-roleEdges :: [(Text, Text)] -> [Text] -> [(Text, Text)]
-roleEdges members roles = [pair | pair@(_, child) <- members, child `elem` roles]
-
--- | 向上闭包：这群角色直接或间接所属的全部角色
-closureUp :: [(Text, Text)] -> [Text] -> [Text]
-closureUp edges = go
-  where
-    -- | 展开一轮，没有再新增就停
-    go known =
-        let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
-         in if null more then known else go (known ++ more)
-
--- | 一个角色挂着的授权，带 grant option 的会标出来
-roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
-roleGrantsOf service role = do
-    grants <- catalog (readGrants (pvCatalog service))
-    options <- catalog (readGrantOptions (pvCatalog service))
-    pure (do
-        rows <- grants
-        optionRows <- options
-        let mine = filter (\grant -> grantRole grant == normalizeRole role) rows
-        pure (markOptions mine optionRows))
-
--- | 给授权标上有没有对应的 grant option
-markOptions :: [Grant] -> [Grant] -> [Grant]
-markOptions grants options = [grant {grantable = hasOption grant} | grant <- grants]
-  where
-    -- | 有没有一条同角色同权限同对象的 option
-    hasOption grant = any (same grant) options
-    -- | 两条授权指向同一处
-    same one other =
-        grantRole one == grantRole other
-            && grantPrivilege one == grantPrivilege other
-            && grantObject one == grantObject other
-
--- | 角色名清单（统一小写）
-roleNames :: Privileges -> IO (Either PrivilegeError [Text])
-roleNames service = catalog (readRoleNames (pvCatalog service))
-
--- | 一个角色的直接成员：用户与子角色
-membersOfRole :: Privileges -> Text -> IO (Either PrivilegeError [Text])
-membersOfRole service role = do
-    members <- catalog (readMembers (pvCatalog service))
-    pure (map snd . filter (\(name, _) -> name == normalizeRole role) <$> members)
-
--- | 角色必须存在，否则命令不落地
-requireRole :: Privileges -> Text -> IO (Either PrivilegeError ())
-requireRole service role = do
-    known <- roleNames service
-    pure $ case known of
-        Left err -> Left err
-        Right names
-            | normalizeRole role `elem` names -> Right ()
-            | otherwise -> Left (unknownRole role)
-
--- | 真正落库（表已经保证存在）
-applyCommand :: Privileges -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
-applyCommand service database command = case command of
-    CreateRoleCommand role -> do
-        known <- roleNames service
-        case known of
-            Left err -> pure (Left err)
-            Right names
-                | normalizeRole role `elem` names -> pure (Left (PrivilegeError "conflict" ("role already exists: " <> role)))
-                | otherwise -> catalog (insertRole (pvCatalog service) role)
-    DropRoleCommand role -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () -> catalog (dropRole (pvCatalog service) role)
-    GrantPrivilegesCommand privileges object role withOption -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () ->
-                eachAction (expandPrivileges privileges) $ \privilege ->
-                    grantOne service withOption role privilege (normalizeObject database object)
-    RevokePrivilegesCommand privileges object role -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () ->
-                eachAction (expandPrivileges privileges) $ \privilege ->
-                    revokeOne service role privilege (normalizeObject database object)
-    GrantRoleCommand role members -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () -> do
-                known <- roleNames service
-                case known of
-                    Left err -> pure (Left err)
-                    Right roles -> eachAction members (grantMember service roles role)
-    RevokeRoleCommand role users -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user)
-
--- | 落一条授权，带 grant option 的再落一条转授权
-grantOne :: Privileges -> Bool -> Text -> Text -> Text -> IO (Either PrivilegeError ())
-grantOne service withOption role privilege object = do
-    written <- catalog (addGrant (pvCatalog service) role privilege object)
-    case written of
-        Left err -> pure (Left err)
-        Right ()
-            | withOption -> catalog (addGrantOption (pvCatalog service) role privilege object)
-            | otherwise -> pure (Right ())
-
--- | 收一条授权，连同它的 grant option
-revokeOne :: Privileges -> Text -> Text -> Text -> IO (Either PrivilegeError ())
-revokeOne service role privilege object = do
-    dropped <- catalog (removeGrant (pvCatalog service) role privilege object)
-    case dropped of
-        Left err -> pure (Left err)
-        Right () -> catalog (removeGrantOption (pvCatalog service) role privilege object)
-
--- | 普通身份转授权：只放行 GRANT
-delegateCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
-delegateCommand service principal database command = case command of
-    GrantPrivilegesCommand _ _ role _ -> do
-        allowed <- requireRole service role
-        case allowed of
-            Left err -> pure (Left err)
-            Right () -> do
-                owned <- optionsOfUser service (principalName principal)
-                case owned >>= \found -> checkOptions database found needed of
-                    Left err -> pure (Left err)
-                    Right () -> applyCommand service database command
-    _ -> pure (Left forbidden)
-  where
-    -- | 命令里每个 (对象, 权限) 都要对得上
-    needed = case command of
-        GrantPrivilegesCommand privileges object _ _ -> [(object, privilege) | privilege <- expandPrivileges privileges]
-        _ -> []
-
--- | 加一条成员边：名字是角色就查环，否则当用户加
-grantMember :: Privileges -> [Text] -> Text -> Text -> IO (Either PrivilegeError ())
-grantMember service roles role member = do
-    current <- membersOfRole service role
-    case current of
-        Left err -> pure (Left err)
-        Right known
-            | normalizeUser member `elem` known -> pure (Right ())
-            | normalizeRole member `notElem` roles -> catalog (addMember (pvCatalog service) role member)
-            | otherwise -> do
-                edges <- membershipEdges service
-                case edges of
-                    Left err -> pure (Left err)
-                    Right pairs
-                        | normalizeRole member `elem` closureUp pairs [normalizeRole role] ->
-                            pure (Left (cycleMember role member))
-                        | otherwise -> catalog (addMember (pvCatalog service) role member)
-
--- | 只保留两端都是角色的成员边
-membershipEdges :: Privileges -> IO (Either PrivilegeError [(Text, Text)])
-membershipEdges service = do
-    members <- catalog (readMembers (pvCatalog service))
-    roles <- roleNames service
-    pure (roleEdges <$> members <*> roles)
-
--- | 全程持锁，先保证系统表存在再跑动作
 withTables :: Privileges -> IO (Either PrivilegeError a) -> IO (Either PrivilegeError a)
 withTables service action = withCatalogLock (pvCatalog service) $ do
     ready <- ensureCatalog (pvCatalog service)
-    case ready of
+    case ready of Left err -> pure (Left (storageError err)); Right () -> action
-        Left err -> pure (Left (storageError err))
-        Right () -> action
 
--- | 目录操作转成权限错误
+-- 将目录结果转换为权限错误。
 catalog :: IO (Either String a) -> IO (Either PrivilegeError a)
-catalog action = fmap (either (Left . storageError) Right) action
+catalog = fmap (either (Left . storageError) Right)
 
--- | 把 ALL 展开成四种具体权限
+-- 分类稳定对象目录的明确错误。
-expandPrivileges :: [Text] -> [Text]
+storageError :: String -> PrivilegeError
-expandPrivileges privileges = nub (concatMap expand (map (T.toLower . T.strip) privileges))
+storageError message = PrivilegeError code (T.pack message)
   where
-    -- | 展开一条权限名
+    code | message == "no database selected" = "no_database"
-    expand "all" = ["select", "insert", "update", "delete"]
+         | any (`T.isPrefixOf` T.pack message) ["permission denied:", "grant option required:", "object owner required", "administrator required", "system objects cannot be granted"] = "forbidden"
-    expand other = [other]
+         | any (`T.isPrefixOf` T.pack message) ["unknown role:", "unknown table", "unknown database"] = "not_found"
+         | message == "object ACL changed concurrently" = "conflict"
+         | message == "invalid privilege for object scope" = "bad_request"
+         | message == "the last enabled login superuser cannot be removed" = "bad_request"
+         | otherwise = "storage_error"
 
 forbidden :: PrivilegeError
 forbidden = PrivilegeError "forbidden" "administrator required"
 
--- | 未知角色的错误
+-- 查询登录身份自己的有效权限。
-unknownRole :: Text -> PrivilegeError
+listSelfGrants :: Privileges -> Principal -> IO (Either PrivilegeError [Grant])
-unknownRole role = PrivilegeError "not_found" ("unknown role: " <> role)
+listSelfGrants service principal = withTables service (catalog (OA.objectSelfViews (pvBackend service) (pvCatalog service) principal))
-
--- | 角色成员成环的错误
-cycleMember :: Text -> Text -> PrivilegeError
-cycleMember role member =
-    PrivilegeError "conflict" ("role membership would create a cycle: " <> normalizeRole role <> " and " <> normalizeRole member)
-
--- | 存储错误转成权限错误
-storageError :: String -> PrivilegeError
-storageError "the last enabled login superuser cannot be removed" = PrivilegeError "bad_request" "the last enabled login superuser cannot be removed"
-storageError message = PrivilegeError "storage_error" ("privilege storage: " <> T.pack message)

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

@@ -0,0 +1,36 @@
+module ChuSQL.Server.Security (readSecurity, writeSecurity) where
+
+import Control.Monad (when)
+import Control.Concurrent.MVar
+import Control.Exception (bracket_, mask_)
+import System.IO.Unsafe (unsafePerformIO)
+
+-- 共享权限门：查询并行读取，权限和对象变更独占执行。
+
+{-# NOINLINE securityGate #-}
+securityGate :: (MVar (), MVar (), MVar Int)
+securityGate = unsafePerformIO $ do
+    turn <- newMVar ()
+    room <- newMVar ()
+    readers <- newMVar 0
+    pure (turn, room, readers)
+
+-- 并行执行权限稳定期间的查询。
+readSecurity :: IO a -> IO a
+readSecurity = bracket_ enter leave
+  where
+    (turn, room, readers) = securityGate
+    -- 登记共享读取者。
+    enter = withMVar turn $ \_ -> modifyMVar_ readers $ \count -> do
+        when (count == 0) $ takeMVar room
+        pure (count + 1)
+    -- 释放最后一个共享读取者。
+    leave = mask_ $ modifyMVar_ readers $ \count -> do
+        when (count == 1) $ putMVar room ()
+        pure (count - 1)
+
+-- 独占执行权限或对象变更。
+writeSecurity :: IO a -> IO a
+writeSecurity action = withMVar turn $ \_ -> withMVar room (const action)
+  where
+    (turn, room, _) = securityGate

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

@@ -13,9 +13,12 @@ module ChuSQL.Server.Session
     , isPlainIdentifier
     , authenticateSession
     , authenticateSessionCoded
+    , authenticateSudoSessionCoded
     , switchDatabase
     , runStatement
     , runStatementCoded
+    , runStorageCoded
+    , analyzeNormalizationCoded
     , catalog
     , accounts
     , roleViews
@@ -25,8 +28,18 @@ module ChuSQL.Server.Session
     , queryResultJson
     ) where
 
-import ChuSQL.Core.Model (Database, Row, Table (..), Value (..))
+import ChuSQL.Core.Model (Database, Row, Table (..), Value (..), Column (..), typeName)
-import ChuSQL.Core.Protocol (Account (..), Request (..), QueryResult (..), TxnOp (..), queryResultJson)
+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
@@ -37,14 +50,19 @@ import ChuSQL.Interface.Auth (defaultSessionPolicy, newSessionStore)
 import ChuSQL.Server.Accounts
 import ChuSQL.Server.Backend (Backend (..), StatementResult (..), columnsFromStatement, scopeDdl)
 import ChuSQL.Server.Policy (configurePasswordPolicy)
-import ChuSQL.Server.Privileges (PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, affectedAccounts, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
+import ChuSQL.Server.Privileges (PrivilegeCommand (..), PrivilegeError (..), Privileges, RoleView, Grant (..), affectedAccounts, affectedObject, authorize, authorizeTables, authorizeConnect, claimObject, prepareObject, reconcileObjects, filterTables, listRoleViews, listSelfGrants, newPrivileges, privilegeCommand, runPrivilegeCommand)
+import ChuSQL.Server.Security (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)
+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.Time.Clock (getCurrentTime)
 
 -- SQL 会话：Web、命令行与 TCP 服务器共用的账号、权限与语句执行入口。
@@ -66,6 +84,7 @@ data Session = Session
     , ssPrivileges :: Privileges
     , ssCurrent :: IORef Text
     , ssPrincipal :: IORef (Maybe Principal)
+    , ssIdentityStamp :: IORef (Maybe (Integer, Integer))
     , ssSettingsFile :: FilePath
     , ssTransaction :: IORef (Maybe Transaction)
     , ssChanged :: [Text] -> IO ()
@@ -75,7 +94,9 @@ data Session = Session
 data Transaction = Transaction
     { txBase :: Database
     , txStaged :: Database
-    , txSavepoints :: [(String, Database)]
+    , txSavepoints :: [(String, Database, [Statement])]
+    , txStatements :: [Statement]
+    , txObjects :: [(String, A.Value)]
     }
 
 -- | 开一个会话：账号与角色服务、配置策略都和 Web 端一致
@@ -92,8 +113,9 @@ newSessionWith backend name settingsFile changed = do
     -- 服务启动后只有系统库：没 USE 之前不预设任何工作库
     current <- newIORef ""
     principal <- newIORef Nothing
+    identityStamp <- newIORef Nothing
     transaction <- newIORef Nothing
-    pure (Session backend accountsService privileges current principal settingsFile transaction changed)
+    pure (Session backend accountsService privileges current principal identityStamp settingsFile transaction changed)
 
 -- | 当前生效的口令策略（只有管理员能看）
 policyOf :: Session -> IO (Either Text PasswordPolicy)
@@ -142,7 +164,7 @@ authenticateSession session user password =
 
 -- | 登录（带错误码）
 authenticateSessionCoded :: Session -> Text -> Text -> IO (Either SessionError ())
-authenticateSessionCoded session user password = do
+authenticateSessionCoded session user password = readSecurity $ do
     result <- authenticate (ssAccounts session) user password
     case result of
         Left err -> pure (Left (accountErrorOf err))
@@ -150,14 +172,39 @@ authenticateSessionCoded session user password = do
             who <- currentPrincipal (ssAccounts session) token
             case who of
                 Left err -> pure (Left (accountErrorOf err))
-                Right principal -> do
+                Right principal -> storePrincipal session principal
+
+-- 登录已通过本机凭据校验的映射账号。
+authenticateSudoSessionCoded :: Session -> Text -> IO (Either SessionError ())
+authenticateSudoSessionCoded session user = readSecurity $ do
+    result <- authenticateSudo (ssAccounts session) user
+    case result of
+        Left err -> pure (Left (accountErrorOf err))
+        Right token -> do
+            who <- currentPrincipal (ssAccounts session) token
+            case who of
+                Left err -> pure (Left (accountErrorOf err))
+                Right principal -> storePrincipal session principal
+
+-- 绑定身份版本并清理旧登录的事务。
+storePrincipal :: Session -> Principal -> IO (Either SessionError ())
+storePrincipal session principal = do
+    result <- findAccount (ssAccounts session) (principalName principal)
+    case result of
+        Left err -> pure (Left (accountErrorOf err))
+        Right account -> do
             writeIORef (ssPrincipal session) (Just principal)
+            writeIORef (ssIdentityStamp session) (Just (accountId account, accountRevision account))
+            writeIORef (ssTransaction session) Nothing
+            writeIORef (ssCurrent session) ""
             pure (Right ())
 
 -- | 换库；系统库只有 root 能进
 switchDatabase :: Session -> Text -> IO (Either Text ())
 switchDatabase session name =
-    fmap (first sessMessage) (switchDatabaseCoded session name)
+    readSecurity $ do
+        valid <- validatePrincipal session
+        case valid of Left err -> pure (Left (sessMessage err)); Right () -> fmap (first sessMessage) (switchDatabaseCoded session name)
 
 -- | 换库（带错误码）
 switchDatabaseCoded :: Session -> Text -> IO (Either SessionError ())
@@ -171,6 +218,13 @@ switchDatabaseCoded session rawName
     name = T.toLower (T.strip rawName)
     -- | 真的切库并记下当前库
     go = do
+        who <- readIORef (ssPrincipal session)
+        allowed <- case who of
+            Just principal | name /= "system" -> authorizeConnect (ssPrivileges session) principal name
+            _ -> pure (Right ())
+        case allowed of
+            Left err -> pure (Left (privilegeErrorOf err))
+            Right () -> do
                 backend <- currentBackend session
                 result <- beStatement backend ("USE " ++ T.unpack name)
                 case result of
@@ -183,7 +237,43 @@ runStatement session sql = fmap (first sessMessage) (runStatementCoded session s
 
 -- | 跑一条语句（带错误码）
 runStatementCoded :: Session -> Text -> IO (Either SessionError QueryResult)
-runStatementCoded session sql = case parseStatement (T.unpack sql) of
+runStatementCoded session sql = gate $ do
+    valid <- validatePrincipal session
+    case valid of Left err -> pure (Left err); Right () -> runStatementUnlocked session sql
+  where
+    gate = case parseStatement (T.unpack sql) of
+        Right statement | transactionDdl statement || isJust (accountCommand statement) || isJust (privilegeCommand statement) -> writeSecurity
+        _ -> readSecurity
+
+-- 在权限门内检查并执行管理员存储请求。
+runStorageCoded :: Session -> A.Value -> IO (Either SessionError A.Value)
+runStorageCoded session payload = writeSecurity $ do
+    valid <- validatePrincipal session
+    who <- readIORef (ssPrincipal session)
+    case valid of
+        Left err -> pure (Left err)
+        Right () -> case who of
+            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)
+
+-- 检查登录身份的当前版本和启用状态。
+validatePrincipal :: Session -> IO (Either SessionError ())
+validatePrincipal session = do
+    who <- readIORef (ssPrincipal session)
+    stamp <- readIORef (ssIdentityStamp session)
+    case who of
+        Just principal -> do
+            result <- findAccount (ssAccounts session) (principalName principal)
+            pure $ case result of
+                Left err -> Left (accountErrorOf err)
+                Right current | stamp == Just (accountId current, accountRevision current) && accountEnabled current && accountCanLogin current && (not (principalIsRoot principal) || accountIsSuperuser current) -> Right ()
+                _ -> Left (SessionError "unauthorized" "session identity has changed")
+        _ -> pure (Right ())
+
+-- 在共享权限门内分发会话语句。
+runStatementUnlocked :: Session -> Text -> IO (Either SessionError QueryResult)
+runStatementUnlocked session sql = case parseStatement (T.unpack sql) of
     Right (UseDatabase name) -> do
         existing <- readIORef (ssTransaction session)
         case existing of
@@ -201,6 +291,7 @@ runStatementCoded session sql = case parseStatement (T.unpack sql) of
     Right (Savepoint name) -> savepointTransaction session (T.pack name)
     Right (RollbackToSavepoint name) -> rollbackToSavepoint session (T.pack name)
     Right (ReleaseSavepoint name) -> releaseSavepoint session (T.pack name)
+    Right ShowGrants -> showSelfGrants session
     Right ShowRoles -> showIdentities session
     Right statement
         | Just command <- accountCommand statement -> runAccount session command
@@ -215,7 +306,7 @@ runStatementCoded session sql = case parseStatement (T.unpack sql) of
                         Left err -> pure (Left err)
                         Right ()
                             | isJust transaction && transactionData statement -> runInTransaction session statement
-                            | otherwise -> runPlain session sql
+                            | otherwise -> runObjectStatement session statement sql
     Left _ -> runPlain session sql
 
 -- | 事务里不许改结构，会话层直接拦下
@@ -240,8 +331,8 @@ transactionDdl statement = case statement of
 -- | 事务里只有数据语句走快照
 transactionData :: Statement -> Bool
 transactionData statement = case statement of
+    SelectDistinct q -> transactionData q
     Select{} -> True
-    SelectExpr{} -> True
     Insert{} -> True
     Update{} -> True
     Delete{} -> True
@@ -250,6 +341,12 @@ transactionData statement = case statement of
 -- | 开事务：把当前库整库做一份快照当起点
 beginTransaction :: Session -> IO (Either SessionError QueryResult)
 beginTransaction session = do
+    allowed <- sessionConnectAllowed session
+    case allowed of Left err -> pure (Left err); Right () -> beginAuthorized session
+
+-- 在连接权限复核后建立事务快照。
+beginAuthorized :: Session -> IO (Either SessionError QueryResult)
+beginAuthorized session = do
     current <- readIORef (ssCurrent session)
     existing <- readIORef (ssTransaction session)
     case existing of
@@ -262,7 +359,11 @@ beginTransaction session = do
                 case snapshotResult of
                     Left err -> pure (Left (engineErrorCode err))
                     Right db -> do
-                        writeIORef (ssTransaction session) (Just (Transaction db db []))
+                        objects <- snapshotObjectIds session (map fst db)
+                        case objects of
+                            Left err -> pure (Left err)
+                            Right ids -> do
+                                writeIORef (ssTransaction session) (Just (Transaction db db [] [] ids))
                                 pure (Right (emptyResult (Just current)))
 
 -- | 提交：把快照差分交给存储层应用，成功才结束事务
@@ -273,20 +374,56 @@ commitTransaction session = do
     case existing of
         Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
         Just transaction -> do
+            connected <- sessionConnectAllowed session
+            permissions <- mapM (authorized session) (txStatements transaction)
+            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"))
+                          | otherwise -> commitAuthorized session current transaction
+
+-- 对象和权限复核后提交事务差分。
+commitAuthorized :: Session -> Text -> Transaction -> IO (Either SessionError QueryResult)
+commitAuthorized session current transaction = do
             backend <- currentBackend session
             liveResult <- beSnapshot backend
             case liveResult of
                 Left err -> pure (Left (engineErrorCode err))
-                Right live -> case transactionConflict (txBase transaction) (txStaged transaction) live of
+                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 (txBase transaction) (txStaged transaction) live)
+                        applied <- beApplyTransaction backend (transactionOps diffs)
                         case applied of
                             Left err -> pure (Left (engineErrorCode err))
                             Right () -> do
                                 writeIORef (ssTransaction session) Nothing
                                 pure (Right (emptyResult (Just current)))
 
+-- 检查当前数据库连接权限。
+sessionConnectAllowed :: Session -> IO (Either SessionError ())
+sessionConnectAllowed session = do
+    database <- readIORef (ssCurrent session)
+    who <- readIORef (ssPrincipal session)
+    case who of
+        Just principal | not (principalIsRoot principal), not (T.null database) -> fmap (first privilegeErrorOf) (authorizeConnect (ssPrivileges session) principal database)
+        _ -> pure (Right ())
+
+-- 保存事务使用的 catalog 对象编号。
+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
+        results <- mapM (one database) (filter (not . T.isPrefixOf "__system_" . T.pack) names)
+        pure (sequence results)
+  where
+    -- 解析一个快照表的稳定对象编号。
+    one database name = do
+        result <- beStorage (ssBackend session) (A.object ["method" A..= ("resolve_object" :: Text), "database" A..= database, "table" A..= name])
+        pure $ case result of
+            Left err -> Left (SessionError "serialization_failure" (T.pack err))
+            Right value@(A.Object fields) | KM.lookup "status" fields == Just (A.String "object") -> Right (name, value)
+            Right _ -> Left (SessionError "serialization_failure" "transaction object no longer exists")
+
 -- | 回滚：快照丢掉，存储层没被改过
 rollbackTransaction :: Session -> IO (Either SessionError QueryResult)
 rollbackTransaction session = do
@@ -306,7 +443,7 @@ savepointTransaction session name = do
     case existing of
         Nothing -> pure (Left (SessionError "query_error" "no transaction in progress"))
         Just transaction -> do
-            let stack = txSavepoints transaction ++ [(T.unpack name, txStaged transaction)]
+            let stack = txSavepoints transaction ++ [(T.unpack name, txStaged transaction, txStatements transaction)]
             writeIORef (ssTransaction session) (Just transaction {txSavepoints = stack})
             pure (Right (emptyResult (Just current)))
 
@@ -320,10 +457,10 @@ rollbackToSavepoint session name = do
         Just transaction -> case savepointIndex name (txSavepoints transaction) of
             Nothing -> pure (Left (SessionError "query_error" ("no such savepoint: " <> name)))
             Just index -> do
-                let (_, staged) = txSavepoints transaction !! index
+                let (_, staged, statements) = txSavepoints transaction !! index
                 writeIORef
                     (ssTransaction session)
-                    (Just transaction {txStaged = staged, txSavepoints = take (index + 1) (txSavepoints transaction)})
+                    (Just transaction {txStaged = staged, txStatements = statements, txSavepoints = take (index + 1) (txSavepoints transaction)})
                 pure (Right (emptyResult (Just current)))
 
 -- | 释放保存点：该保存点与它之后的保存点一起丢掉
@@ -340,9 +477,9 @@ releaseSavepoint session name = do
                 pure (Right (emptyResult (Just current)))
 
 -- | 最近一次同名保存点的下标
-savepointIndex :: Text -> [(String, Database)] -> Maybe Int
+savepointIndex :: Text -> [(String, Database, [Statement])] -> Maybe Int
 savepointIndex name entries =
-    case [index | (index, (label, _)) <- zip [0 ..] entries, T.pack label == name] of
+    case [index | (index, (label, _, _)) <- zip [0 ..] entries, T.pack label == name] of
         [] -> Nothing
         hits -> Just (last hits)
 
@@ -356,7 +493,7 @@ 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})
+                writeIORef (ssTransaction session) (Just transaction {txStaged = staged, txStatements = statement : txStatements transaction})
                 pure (Right (resultOfStaged (txStaged transaction) statement rows))
 
 -- | 事务内的结果集：空结果回落到解析出来的列名
@@ -376,8 +513,8 @@ data TableDiff = TableDiff
     }
 
 -- | 提交差分：相对快照列出要删、要写与要替换的行
-transactionOps :: Database -> Database -> Database -> [TxnOp]
+transactionOps :: [(String, TableDiff)] -> [TxnOp]
-transactionOps base staged live = concatMap opsOf (transactionDiffs base staged live)
+transactionOps = concatMap opsOf
   where
     -- | 一张表的请求：先删后写
     opsOf (name, diff) =
@@ -386,9 +523,9 @@ transactionOps base staged live = concatMap opsOf (transactionDiffs base staged
             ++ [TxnReplace name rows | Just rows <- [tdReplace diff]]
 
 -- | 提交前校验：本事务动过的行是否已被别人改掉
-transactionConflict :: Database -> Database -> Database -> Maybe String
+transactionConflict :: [(String, TableDiff)] -> Maybe String
-transactionConflict base staged live =
+transactionConflict diffs =
-    case [msg | (_, diff) <- transactionDiffs base staged live, Just msg <- [tdConflict diff]] of
+    case [msg | (_, diff) <- diffs, Just msg <- [tdConflict diff]] of
         (msg : _) -> Just msg
         [] -> Nothing
 
@@ -401,9 +538,8 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
 
     -- | 一张表的差异
     diffFor name
-        | all (isJust . rowKey) (baseRows ++ stagedRows) = keyedDiff
-        -- 没动过这张表：别人改成什么样都不关本事务
         | stagedRows == baseRows = emptyDiff
+        | all (isJust . rowKey) (baseRows ++ stagedRows) = keyedDiff
         -- 动过，库里还是基线：整表替换
         | liveRows == baseRows = emptyDiff {tdReplace = Just stagedRows}
         | otherwise = emptyDiff {tdConflict = Just ("write conflict on table " ++ name)}
@@ -412,27 +548,30 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
         stagedRows = rowsOf name staged
         liveRows = rowsOf name live
 
-        baseByKey = [(k, r) | r <- baseRows, Just k <- [rowKey r]]
+        baseByKey = keyedRows baseRows
-        liveByKey = [(k, r) | r <- liveRows, Just k <- [rowKey r]]
+        liveByKey = keyedRows liveRows
-        stagedByKey = [(k, r) | r <- stagedRows, Just k <- [rowKey r]]
+        stagedByKey = keyedRows stagedRows
+        stagedEntries = [(k, r) | r <- stagedRows, Just k <- [rowKey r]]
 
         -- 本事务动过的键：内容改过、新增，或者删掉
-        written = [k | (k, r) <- stagedByKey, lookup k baseByKey /= Just r]
+        written = [k | (k, r) <- stagedEntries, IM.lookup k baseByKey /= Just r]
-        removed = [k | (k, _) <- baseByKey, not (any ((== k) . fst) stagedByKey)]
+        writtenSet = IS.fromList written
+        removed = [k | r <- baseRows, Just k <- [rowKey r], IM.notMember k stagedByKey]
+        removedSet = IS.fromList removed
         touched = written ++ removed
 
         -- 两边都删了算一致；其余只要跟基线不一样就是冲突
         victims =
             [ k
             | k <- touched
-            , lookup k liveByKey /= lookup k baseByKey
+            , IM.lookup k liveByKey /= IM.lookup k baseByKey
-            , not (k `elem` removed && lookup k liveByKey == Nothing)
+            , not (IS.member k removedSet && IM.notMember k liveByKey)
             ]
 
         keyedDiff =
             emptyDiff
-                { tdDeletes = [k | k <- touched, isJust (lookup k liveByKey)]
+                { tdDeletes = [k | k <- touched, IM.member k liveByKey]
-                , tdWrites = [r | (k, r) <- stagedByKey, k `elem` written]
+                , tdWrites = [r | (k, r) <- stagedEntries, IS.member k writtenSet]
                 , tdConflict = case victims of
                     (k : _) -> Just ("write conflict on table " ++ name ++ ", id " ++ show k)
                     [] -> Nothing
@@ -447,6 +586,10 @@ transactionDiffs base staged live = [(name, diffFor name) | name <- names]
     -- | 库里某张表的行
     rowsOf name db = maybe [] tableRows (lookup name db)
 
+-- | 按整数 id 建立保留首行的查找表
+keyedRows :: [Row] -> IM.IntMap Row
+keyedRows rows = IM.fromListWith (\_ earlier -> earlier) [(key, row) | row <- rows, Just key <- [rowKey row]]
+
 -- | 行 id：只有整数 id 才认，跟存储层删行的口径一致
 rowKey :: Row -> Maybe Int
 rowKey row = case lookup "id" row of
@@ -471,9 +614,64 @@ runPlain session sql = do
     result <- beStatement backend (T.unpack sql)
     pure (either (Left . engineErrorCode) (Right . resultOf) result)
 
+-- 执行对象结构变更并维护所有者和授权。
+runObjectStatement :: Session -> Statement -> Text -> IO (Either SessionError QueryResult)
+runObjectStatement session statement sql = do
+    who <- readIORef (ssPrincipal session)
+    database <- readIORef (ssCurrent session)
+    prepared <- case (who, statement) of
+        (Just principal, CreateTable name _) | database /= "system" -> prepareObject (ssPrivileges session) principal database (T.pack name)
+        _ -> pure (Right ())
+    affected <- case statement of
+        DropTable name | database /= "system" -> affectedObject (ssPrivileges session) database (T.pack name)
+        DropDatabase name | name /= "system" -> affectedObject (ssPrivileges session) "" ("database:" <> T.pack name)
+        _ -> pure (Right [])
+    case prepared >> affected of
+        Left err -> pure (Left (privilegeErrorOf err))
+        Right names -> do
+            result <- runPreparedObject session statement sql
+            notifyChanged session names
+            pure result
+
+-- 执行已登记创建声明的对象变更。
+runPreparedObject :: Session -> Statement -> Text -> IO (Either SessionError QueryResult)
+runPreparedObject session statement sql = do
+    result <- runPlain session sql
+    case result of
+        Left err -> case statement of
+            CreateTable{} -> do
+                cleaned <- reconcileObjects (ssPrivileges session)
+                pure $ case cleaned of
+                    Left failure -> Left (SessionError "storage_error" (sessMessage err <> "; creator intent cleanup failed: " <> privilegeMessage failure))
+                    Right () -> Left err
+            _ -> pure (Left err)
+        Right value -> do
+            who <- readIORef (ssPrincipal session)
+            database <- readIORef (ssCurrent session)
+            maintained <- case (who, statement) of
+                (Just principal, CreateTable name _) | database /= "system" -> claimObject (ssPrivileges session) principal database (T.pack name)
+                (Just principal, CreateDatabase name) -> claimObject (ssPrivileges session) principal "" ("database:" <> T.pack name)
+                (_, DropTable{}) -> reconcileObjects (ssPrivileges session)
+                (_, DropDatabase{}) -> reconcileObjects (ssPrivileges session)
+                _ -> pure (Right ())
+            case maintained of
+                Right () -> pure (Right value)
+                Left err -> do
+                    cleanup <- case statement of
+                        CreateTable name _ -> runPlain session ("DROP TABLE " <> T.pack name)
+                        CreateDatabase name -> runPlain session ("DROP DATABASE " <> T.pack name)
+                        _ -> pure (Right value)
+                    pure $ case cleanup of
+                        Left failure -> Left (SessionError "storage_error" (privilegeMessage err <> "; object cleanup failed: " <> sessMessage failure))
+                        Right _ -> Left (privilegeErrorOf err)
+
 -- | 数据字典；普通身份只看到有 SELECT 权的表
 catalog :: Session -> IO (Either Text [TableInfo])
-catalog session = do
+catalog session = withReadSession session (catalogUnlocked session)
+
+-- 在权限共享门内读取可见表目录。
+catalogUnlocked :: Session -> IO (Either Text [TableInfo])
+catalogUnlocked session = do
     current <- readIORef (ssCurrent session)
     if T.null current
         then pure (Left "no database selected")
@@ -509,13 +707,31 @@ withAccountInfo session tables = do
 
 -- | 库清单（\l 用）
 databases :: Session -> IO (Either Text [Text])
-databases session = do
+databases session = withReadSession session $ do
     result <- beDatabases (ssBackend session)
-    pure (either (Left . T.pack) (Right . map T.pack) result)
+    who <- readIORef (ssPrincipal session)
+    case (result, who) of
+        (Left err, _) -> pure (Left (T.pack err))
+        (Right names, Just principal) | not (principalIsRoot principal) -> do
+            checks <- mapM (check principal . T.pack) names
+            pure $ case [err | Left err@(PrivilegeError code _) <- checks, code /= "forbidden"] of
+                err : _ -> Left (privilegeMessage err)
+                [] -> Right [T.pack name | (name, Right ()) <- zip names checks]
+        (Right names, _) -> pure (Right (map T.pack names))
+  where
+    -- 检查业务库连接或系统目录管理权限。
+    check principal "system" = pure (if principalIsCatalogManager principal then Right () else Left (PrivilegeError "forbidden" "system catalog manager required"))
+    check principal name = authorizeConnect (ssPrivileges session) principal name
+
+-- 在共享权限门内复核会话并读取接口。
+withReadSession :: Session -> IO (Either Text a) -> IO (Either Text a)
+withReadSession session action = readSecurity $ do
+    valid <- validatePrincipal session
+    case valid of Left err -> pure (Left (sessMessage err)); Right () -> action
 
 -- | 角色总览，只给管理员
 roleViews :: Session -> IO (Either Text [RoleView])
-roleViews session = do
+roleViews session = withReadSession session $ do
     admin <- sessionIsAdmin session
     if not admin
         then pure (Left "administrator required")
@@ -525,7 +741,7 @@ roleViews session = do
 
 -- | 账号清单（\du 与账号管理页用）；只给管理员
 accounts :: Session -> IO (Either Text [Account])
-accounts session = do
+accounts session = withReadSession session $ do
     admin <- sessionIsAdmin session
     if not admin
         then pure (Left "administrator required")
@@ -547,9 +763,9 @@ showIdentities session = do
         result <- beAccounts (ssBackend session) ReqAccountsList
         pure $ case result of
             Left err -> Left (SessionError "storage_error" (T.pack err))
-            Right identities -> Right (QueryResult ["id", "name", "can_login", "is_superuser", "enabled", "system_catalog_manager", "created_at"]
+            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), VStr (T.unpack (accountRegisteredAt a))] | a <- identities]
+                    VBool (accountIsSuperuser a), VBool (accountEnabled a), VBool (accountSystemCatalogManager a), VBool (accountAllowSudoAuth a), VStr (T.unpack (accountRegisteredAt a))] | a <- identities]
                 (length identities) False Nothing)
 
 -- | 执行身份管理并通知受影响会话
@@ -562,13 +778,17 @@ runAccount session command = do
             affected <- case command of
                 AlterAccountAttributes name _ -> affectedAccounts (ssPrivileges session) (DropRoleCommand name)
                 DropAccount name -> affectedAccounts (ssPrivileges session) (DropRoleCommand name)
-                _ -> pure (accountCommandUsers command)
+                _ -> pure (Right (accountCommandUsers command))
+            case affected of
+                Left err -> pure (Left (privilegeErrorOf err))
+                Right names -> do
                     result <- runAccountCommand (ssAccounts session) principal command
                     case result of
                         Left err -> pure (Left (accountErrorOf err))
                         Right () -> do
-                    notifyChanged session affected
+                            cleaned <- reconcileObjects (ssPrivileges session)
-                    pure (Right (emptyResult Nothing))
+                            notifyChanged session names
+                            pure (either (Left . privilegeErrorOf) (const (Right (emptyResult Nothing))) cleaned)
 
 -- | 一条账号命令影响的账号
 accountCommandUsers :: AccountCommand -> [Text]
@@ -588,11 +808,14 @@ runPrivilege session command = do
             database <- readIORef (ssCurrent session)
             -- 受影响账号要趁命令落地之前算：删角色之后成员就查不到了
             affected <- affectedAccounts (ssPrivileges session) command
+            case affected of
+                Left err -> pure (Left (privilegeErrorOf err))
+                Right names -> do
                     result <- runPrivilegeCommand (ssPrivileges session) principal database command
                     case result of
                         Left err -> pure (Left (privilegeErrorOf err))
                         Right () -> do
-                    notifyChanged session affected
+                            notifyChanged session names
                             pure (Right (emptyResult Nothing))
 
 -- | 通知变更：把受影响的账号交给会话的变更钩子
@@ -613,7 +836,7 @@ privilegeMessage (PrivilegeError _ message) = message
 
 -- | 只带库名的空结果
 emptyResult :: Maybe Text -> QueryResult
-emptyResult database = QueryResult [] [] 0 False database
+emptyResult = QueryResult [] [] 0 False
 
 -- | 存储结果转成查询结果
 resultOf :: StatementResult -> QueryResult
@@ -627,5 +850,74 @@ resultOf result =
         }
   where
     -- | 按列名取单元格
-    cellOf row name = maybe VNull id (lookup name row)
+    cellOf row name = fromMaybe VNull (lookup name row)
 
+
+-- 展示当前登录身份自己的有效权限。
+showSelfGrants :: Session -> IO (Either SessionError QueryResult)
+showSelfGrants session = do
+    who <- readIORef (ssPrincipal session)
+    case who of
+        Nothing -> pure (Left (SessionError "unauthorized" "sign in first"))
+        Just principal -> do
+            grants <- listSelfGrants (ssPrivileges session) principal
+            pure $ case grants of
+                Left err -> Left (privilegeErrorOf err)
+                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)
+
+
+-- 在连接视图及权限稳定期间分析范式。
+analyzeNormalizationCoded :: Session -> NormalizationRequest -> IO (Either SessionError A.Value)
+analyzeNormalizationCoded session payload = do
+    result <- normalizationBudget $ readSecurity $ do
+        valid <- validatePrincipal session
+        current <- readIORef (ssCurrent session)
+        who <- readIORef (ssPrincipal session)
+        let table = last (T.splitOn "." (nrTable payload))
+        case (valid, who, A.fromJSON (A.toJSON payload) :: A.Result NormalizationRequest) of
+            (Left err, _, _) -> pure (Left (sessCode err, sessMessage err))
+            (_, Nothing, _) -> pure (Left ("unauthorized", "sign in first"))
+            (_, _, A.Error message) -> pure (Left ("bad_request", T.pack message))
+            (_, Just principal, A.Success _)
+                | BL.length (A.encode payload) > 65000 -> pure (Left ("too_large", "normalization request exceeds transport budget"))
+                | current /= nrDatabase payload -> pure (Left ("bad_request", "normalization database differs from the selected database"))
+                | current == "system" || "__system_" `T.isPrefixOf` table -> pure (Left ("forbidden", "normalization does not expose system objects"))
+                | otherwise -> do
+                    allowed <- authorizeTables (ssPrivileges session) principal current [(table, "select")]
+                    case allowed of
+                        Left (PrivilegeError code message) -> pure (Left (code, message))
+                        Right () -> normalizationView session table payload
+    pure (either (Left . uncurry SessionError) Right result)
+
+-- 读取目录结构或当前连接的事务 schema。
+normalizationView :: Session -> Text -> NormalizationRequest -> IO (Either (Text, Text) A.Value)
+normalizationView session table payload = do
+    live <- snapshotObjectIds session [T.unpack table]
+    transaction <- readIORef (ssTransaction session)
+    case live >>= maybe (Left (SessionError "not_found" "unknown table")) Right . lookup (T.unpack table) of
+        Left err -> pure (Left (sessCode err, sessMessage err))
+        Right object -> case objectIdentity object of
+            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 ->
+                        pure (normalizationReport identity (map normalizationColumn (tableCols relation)) "transaction_snapshot" payload)
+                    _ -> pure (Left ("conflict", "normalization snapshot object has changed"))
+                Nothing -> do
+                    backend <- currentBackend session
+                    infos <- beCatalog backend
+                    pure $ case infos of
+                        Left message -> Left ("storage_error", T.pack message)
+                        Right relations -> case [tiColumns info | info <- relations, tiTable info == T.unpack table] of
+                            [columns] -> normalizationReport identity columns "live_schema" payload
+                            _ -> Left ("not_found", "unknown table")
+
+-- 从目录响应中只取稳定编号。
+objectIdentity :: A.Value -> Either Text ObjectIdentity
+objectIdentity = first T.pack . parseEither (A.withObject "catalog object" $ \o -> ObjectIdentity <$> o A..: "database_id" <*> o A..: "object_id")
+
+-- 将事务 schema 转成同一线上列结构。
+normalizationColumn :: (String, Column) -> SchemaColumn
+normalizationColumn (name, c) = SchemaColumn name (typeName (columnType c)) (columnNullable c) (columnDefault c) (columnAutoIncrement c) (columnPrimaryKey c) (columnUnique c) (columnCheck c)

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module ChuSQL.Server.TCP (
@@ -11,25 +13,30 @@ module ChuSQL.Server.TCP (
     ServerHandle (..),
     startServer,
     runServer,
+    isLocalPeer,
 ) where
 
 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.Server.Backend (Backend (..))
-import ChuSQL.Server.Session (QueryResult (..), Session, SessionError (..), accounts, authenticateSessionCoded, catalog, databases, newSessionWith, policyOf, reloadPolicy, roleViews, runStatementCoded, sessionIsAdmin, sessionUser)
+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 Control.Concurrent (forkIO)
 import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
-import Control.Exception (IOException, finally, try)
+import Control.Exception (IOException, bracket, finally, onException, try)
-import Control.Monad (filterM, void)
+import Control.Monad (filterM, void, when)
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Network.Socket (
@@ -48,13 +55,14 @@ import Network.Socket (
     defaultProtocol,
     getAddrInfo,
     getSocketName,
+    getPeerName,
     listen,
     setSocketOption,
     socket,
     socketToHandle,
   )
-import System.IO (BufferMode (LineBuffering), IOMode (ReadWriteMode), hClose, hFlush, hPutStrLn, hSetBuffering, hSetNewlineMode, noNewlineTranslation, stderr)
+import System.IO (BufferMode (LineBuffering), Handle, IOMode (ReadWriteMode), hClose, hFlush, hPutStrLn, hSetBuffering, hSetNewlineMode, noNewlineTranslation, stderr)
-import System.IO.Error (isEOFError)
+import System.IO.Error (eofErrorType, isEOFError, mkIOError)
 
 -- TCP 服务器：监听端口，一连接一会话，按一行一 JSON 收发协议消息。
 
@@ -64,6 +72,8 @@ import System.IO.Error (isEOFError)
 data LiveEntry = LiveEntry
     { leWho :: IORef (Maybe Text)
     , leDropped :: IORef Bool
+    , leLocal :: Bool
+    , leChallenge :: IORef (Maybe (Text, UTCTime))
     }
 
 -- | 在线连接登记：自增编号到连接条目
@@ -77,8 +87,8 @@ newLiveConnections :: IO LiveConnections
 newLiveConnections = LiveConnections <$> newIORef 0 <*> newMVar Map.empty
 
 -- | 新建一条连接条目
-newLiveEntry :: IO LiveEntry
+newLiveEntry :: Bool -> IO LiveEntry
-newLiveEntry = LiveEntry <$> newIORef Nothing <*> newIORef False
+newLiveEntry local = LiveEntry <$> newIORef Nothing <*> newIORef False <*> pure local <*> newIORef Nothing
 
 -- | 登记一条连接，返回注销动作
 registerConnection :: LiveConnections -> LiveEntry -> IO (IO ())
@@ -112,6 +122,7 @@ data ServerEnv = ServerEnv
     , srvConfig :: ServerConfig
     , srvLimiter :: RateLimiter
     , srvLive :: LiveConnections
+    , srvSudo :: MVar (Maybe (Int, Text, SudoCredential))
     }
 
 -- | 组装服务器环境：每个连接再各开一个会话
@@ -124,7 +135,13 @@ newServerEnv backend rootName settingsFile config limiter = do
             | any (\a -> accountEnabled a && accountCanLogin a && accountIsSuperuser a) identities -> pure ()
             | otherwise -> ioError (userError "identity migration failed: no enabled login superuser; stop all processes and try csql-bootstrap recover --config <settings.toml>; reset replaces system identities and grants")
     live <- newLiveConnections
-    pure (ServerEnv backend rootName settingsFile config limiter live)
+    privileges <- newPrivileges backend
+    recovered <- writeSecurity (reconcileObjects privileges)
+    case recovered of
+        Left err -> ioError (userError ("object privilege recovery failed: " ++ show err))
+        Right () -> pure ()
+    sudo <- newMVar Nothing
+    pure (ServerEnv backend rootName settingsFile config limiter live sudo)
 
 data ServerHandle = ServerHandle
     { shPort :: Int
@@ -136,18 +153,45 @@ startServer :: ServerEnv -> IO ServerHandle
 startServer env = do
     sock <- listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))
     port <- actualPort sock
+    enableSudo env port `onException` close sock
     stopped <- newMVar False
     _ <- forkIO (acceptLoop env sock stopped)
-    pure (ServerHandle port (stopListening sock stopped))
+    pure (ServerHandle port (stopListening sock stopped `finally` disableSudo env))
 
 -- | 在调用线程里收连接（可执行文件用）；绑好端口先回调一次
 runServer :: ServerEnv -> (Int -> IO ()) -> IO ()
-runServer env announce = do
+runServer env announce = bracket (listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))) close $ \sock -> do
-    sock <- listenSocket (scHost (srvConfig env)) (scPort (srvConfig env))
     port <- actualPort sock
+    enableSudo env port
+    (do
         announce port
         stopped <- newMVar False
-    acceptLoop env sock stopped
+        acceptLoop env sock stopped) `finally` disableSudo env
+
+-- 为显式配置的本机身份映射创建凭据。
+enableSudo :: ServerEnv -> Int -> IO ()
+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
+                                                        hPutStrLn
+                                                          stderr
+                                                          ("sudo_auth enabled: local elevated identity -> " ++ T.unpack user)
+                                                        pure (Just (port, user, credential))
+  where
+    user = scSudoUser (srvConfig env)
+
+-- 清理本次服务实例的本机认证凭据。
+disableSudo :: ServerEnv -> IO ()
+disableSudo env = modifyMVar_ (srvSudo env) $ \current -> do
+    case current of
+        Nothing -> pure ()
+        Just (port, _, _) -> removeSudoCredential port
+    pure Nothing
 
 -- | 置停止标记并关掉监听套接字
 stopListening :: Socket -> MVar Bool -> IO ()
@@ -209,26 +253,26 @@ reportConnection env conn = do
 -- | 一个连接一个会话：一行一条 JSON，读到 EOF 就收工
 serveConnection :: ServerEnv -> Socket -> IO ()
 serveConnection env conn = do
+    peer <- getPeerName conn
     h <- socketToHandle conn ReadWriteMode
     hSetBuffering h LineBuffering
     hSetNewlineMode h noNewlineTranslation
-    entry <- newLiveEntry
+    entry <- newLiveEntry (isLocalPeer peer)
     unregister <- registerConnection (srvLive env) entry
-    session <- newSessionWith (srvBackend env) (srvRootName env) (srvSettingsFile env) (\names -> void (dropConnectionsOf (srvLive env) names))
+    session <- newSessionWith (srvBackend env) (srvRootName env) (srvSettingsFile env) (void . dropConnectionsOf (srvLive env))
-    outcome <- try (loop h session entry `finally` unregister) :: IO (Either IOException ())
+    outcome <- try (loop h session entry BSC.empty `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 = do
+    loop h session entry pending = do
-        line <- BSC.hGetLine h
+        frame <- readRequestLine h (scMaxMessage (srvConfig env)) pending
-        let cleaned = BSC.dropWhileEnd (== '\r') line
+        case frame of
-        if BSC.length cleaned > scMaxMessage (srvConfig env)
+            Nothing -> send h (RespError "too_large" "request line too large")
-            then send h (RespError "too_large" "request line too large") >> loop h session entry
+            Just (cleaned, remaining) -> case decodeRequest cleaned of
-            else case decodeRequest cleaned of
+                Left message -> send h (RespError "bad_request" message) >> loop h session entry remaining
-                Left message -> send h (RespError "bad_request" message) >> loop h session entry
                 Right request -> do
                     expired <- readIORef (leDropped entry)
                     if expired
@@ -236,13 +280,36 @@ serveConnection env conn = do
                         else do
                             (response, keepGoing) <- dispatch env session entry request
                             send h response
-                            if keepGoing then loop h session entry else pure ()
+                            when keepGoing $ loop h session entry remaining
     -- | 发一条响应并冲缓冲
     send h response = do
         BLC.hPutStr h (encodeResponse response)
         BLC.hPutStr h "\n"
         hFlush h
 
+-- | 限长读取一行并保留后续帧
+readRequestLine :: Handle -> Int -> BSC.ByteString -> IO (Maybe (BSC.ByteString, BSC.ByteString))
+readRequestLine handle limit = collect [] 0
+  where
+    -- | 按块读取至换行、超限或 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
+            | used > limit && (used - limit > 1 || BSC.null bytes || BSC.last bytes /= '\r') -> pure Nothing
+            | otherwise -> do
+                next <- BSC.hGetSome handle (max 1 (min 4094 (limit - used) + 2))
+                if BSC.null next
+                    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))
+
 -- | 一条请求一条响应，quit 后停连接
 dispatch :: ServerEnv -> Session -> LiveEntry -> ClientRequest -> IO (ServerResponse, Bool)
 dispatch env session entry request = case request of
@@ -250,11 +317,28 @@ dispatch env session entry request = case request of
         | version == protocolVersion -> pure (RespHello protocolVersion, True)
         | otherwise -> pure (RespError "bad_request" ("unsupported protocol version: " <> tshow version), True)
     ReqLogin user password -> do
+        writeIORef (leChallenge entry) Nothing
         response <- login env session user password
         case response of
             RespLogin who _ -> writeIORef (leWho entry) (Just who)
             _ -> pure ()
         pure (response, True)
+    ReqSudoChallenge -> do
+        configured <- readMVar (srvSudo env)
+        who <- sessionUser session
+        case configured of
+            Just _ | leLocal entry && isNothing who -> do
+                nonce <- sudoChallenge
+                now <- getCurrentTime
+                writeIORef (leChallenge entry) (Just (nonce, now))
+                pure (RespSudoChallenge nonce, True)
+            _ -> pure (RespError "forbidden" "local sudo authentication is unavailable", True)
+    ReqSudoLogin user proof -> do
+        response <- sudoLogin env session entry user proof
+        pure (response, True)
+    ReqNormalization payload -> do
+        result <- analyzeNormalizationCoded session payload
+        pure (either (\err -> RespError (sessCode err) (sessMessage err)) RespNormalization result, True)
     ReqQuery sql -> do
         who <- sessionUser session
         response <- case who of
@@ -268,17 +352,9 @@ dispatch env session entry request = case request of
                         Right queryResult -> RespResult (trimResult (scMaxRows (srvConfig env)) queryResult)
         pure (response, True)
     ReqStorage payload -> do
-        who <- sessionUser session
+        result <- runStorageCoded session payload
-        response <- case who of
+        let response = case result of
-            Nothing -> pure (RespError "unauthorized" "sign in first")
+                Left err -> RespError (sessCode err) (sessMessage err)
-            Just _ -> do
-                admin <- sessionIsAdmin session
-                if not admin
-                    then pure (RespError "forbidden" "administrator required")
-                    else do
-                        result <- beStorage (srvBackend env) payload
-                        pure $ case result of
-                            Left err -> RespError "storage_error" (T.pack err)
                 Right value -> RespStorage value
         pure (response, True)
     ReqCatalog -> do
@@ -302,6 +378,45 @@ dispatch env session entry request = case request of
     ReqPing -> pure (RespPong, True)
     ReqQuit -> pure (RespBye, False)
 
+-- 消费一次性证明并登录本机映射账号。
+sudoLogin :: ServerEnv -> Session -> LiveEntry -> Text -> Text -> IO ServerResponse
+sudoLogin env session entry user proof = do
+    challenge <- atomicModifyIORef' (leChallenge entry) (Nothing,)
+    configured <- readMVar (srvSudo env)
+    now <- getCurrentTime
+    who <- sessionUser session
+    let key = T.toLower (T.strip user)
+        mapped = maybe "" (\(_, name, _) -> name) configured
+        valid = leLocal entry && isNothing who && key == mapped
+            && case configured of
+                Just (_, _, credential) -> validSudoChallenge credential now challenge key proof
+                Nothing -> False
+    blocked <- rateLimitBlock (srvLimiter env) key
+    response <- case blocked of
+        Just _ -> pure (RespError "too_many_attempts" "too many failed sudo logins")
+        Nothing | not valid -> do
+            rateLimitRecord (srvLimiter env) key
+            pure (RespError "unauthorized" "sudo authentication refused")
+        Nothing -> do
+            result <- authenticateSudoSessionCoded session key
+            case result of
+                Left err -> do
+                    rateLimitRecord (srvLimiter env) key
+                    pure (RespError (sessCode err) (sessMessage err))
+                Right () -> do
+                    rateLimitClear (srvLimiter env) key
+                    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)
+    pure response
+  where
+    -- 提取不包含凭据的认证审计结果。
+    auditResult RespLogin{} = "accepted"
+    auditResult (RespError code _) = T.unpack code
+    auditResult _ = "refused"
+
 -- | 口令策略在线上只有两个数字：最短长度与至少几类字符
 policyResponse :: PasswordPolicy -> ServerResponse
 policyResponse (PasswordPolicy minLength classes) = RespPolicy minLength classes

chusql-web/app/Main.hs

@@ -2,6 +2,7 @@
 
 module Main (main) where
 
+import Control.Monad (when)
 import ChuSQL.Web.API (AppEnv (..), Live (..), newAppEnvAt, setLive, webApp)
 import ChuSQL.Interface.Auth (SessionPolicy (..), setPayloadPolicy)
 import ChuSQL.Interface.Config (
@@ -17,10 +18,8 @@ import ChuSQL.Interface.Config (
  )
 import ChuSQL.Interface.Link (clientPing, closeClient, connectClient)
 import ChuSQL.Interface.RateLimit (newRateLimiter)
-import ChuSQL.Interface.Session (authenticateSession, newSession)
 import ChuSQL.Interface.Settings (effectiveSettings)
 import ChuSQL.Interface.TOML (resolveConfigPath)
-import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
 import Control.Exception (IOException, try)
 import Data.Char (toLower)
 import Data.String (fromString)
@@ -52,7 +51,6 @@ data Options = Options
     , optMaxPageSize :: Maybe Int
     , optMaxRows :: Maybe Int
     , optMaxSqlLength :: Maybe Int
-    , optSeedDemo :: Maybe Bool
     , optHelp :: Bool
     }
 
@@ -74,7 +72,6 @@ emptyOptions =
         , optMaxPageSize = Nothing
         , optMaxRows = Nothing
         , optMaxSqlLength = Nothing
-        , optSeedDemo = Nothing
         , optHelp = False
         }
 
@@ -99,7 +96,6 @@ parseArgs = go emptyOptions
     go opts ("--max-page-size" : v : rest) = withInt "--max-page-size" v (\n -> go opts{optMaxPageSize = Just n} rest)
     go opts ("--max-rows" : v : rest) = withInt "--max-rows" v (\n -> go opts{optMaxRows = Just n} rest)
     go opts ("--max-sql-length" : v : rest) = withInt "--max-sql-length" v (\n -> go opts{optMaxSqlLength = Just n} rest)
-    go opts ("--seed" : v : rest) = go opts{optSeedDemo = Just (isTrue v)} rest
     go opts ("--cookie-secure" : v : rest) = go opts{optCookieSecure = Just (isTrue v)} rest
     go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
 
@@ -136,7 +132,6 @@ usage = do
     putStrLn "  --max-page-size N      rows per page ceiling       ([web] max_page_size, default 500)"
     putStrLn "  --max-rows N           rows returned per query     ([web] max_rows, default 1000)"
     putStrLn "  --max-sql-length N     max SQL characters          ([web] max_sql_length, default 20000)"
-    putStrLn "  --seed BOOL            load demo data when the db is empty ([web] seed, default false)"
     putStrLn ""
     putStrLn "administrator password: lives in the __system_users system table, never in settings.toml"
     putStrLn "  the installer always sets one; an account whose hash is still empty signs in with an empty password"
@@ -164,7 +159,6 @@ applyOptions cfg opts =
         , wcMaxPageSize = orElse (optMaxPageSize opts) (wcMaxPageSize cfg)
         , wcMaxRows = orElse (optMaxRows opts) (wcMaxRows cfg)
         , wcMaxSqlLength = orElse (optMaxSqlLength opts) (wcMaxSqlLength cfg)
-        , wcSeedDemo = orElse (optSeedDemo opts) (wcSeedDemo cfg)
         }
   where
     -- | 有就用新的，没有留旧值
@@ -220,7 +214,6 @@ run opts = do
             printBanner cfg configPath staticDir
             reportCredential cfg legacy
             checkServer (aeServerHost env) (aeServerPort env)
-            seedIfWanted cfg (aeServerHost env) (aeServerPort env)
             let settings =
                     Warp.setPort (wcPort cfg) (Warp.setHost (fromString (wcHost cfg)) Warp.defaultSettings)
             serve settings app
@@ -256,37 +249,11 @@ serve settings app = do
 reportCredential :: WebConfig -> Bool -> IO ()
 reportCredential cfg legacy = do
     putStrLn ("administrator: " ++ T.unpack (rootUserName cfg))
-    if legacy
+    when legacy
-        then do
+      $ do putStrLn
-            putStrLn "  !! the [web] section still carries a plaintext password key; it is ignored now"
+             "  !! 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"
+           putStrLn
-        else pure ()
+             "  !! remove it: the administrator password lives in the __system_users system table"
-
--- | 配了 seed 就补演示数据（管理员已设口令时跳过）
-seedIfWanted :: WebConfig -> Text -> Int -> IO ()
-seedIfWanted cfg host port
-    | not (wcSeedDemo cfg) = pure ()
-    | otherwise = do
-        opened <- connectClient host port
-        case opened of
-            Left message -> TIO.putStrLn ("demo data skipped: " <> message)
-            Right client -> do
-                session <- newSession client
-                signed <- authenticateSession session (rootUserName cfg) ""
-                case signed of
-                    Left message -> TIO.putStrLn ("demo data skipped: " <> message <> " (set the administrator password after seeding)")
-                    Right () -> do
-                        result <- seedDemo session
-                        case result of
-                            Left message -> TIO.putStrLn ("demo data skipped: " <> message)
-                            Right report ->
-                                TIO.putStrLn
-                                    ( "demo data: "
-                                        <> (if null (srCreated report) then "already present" else "created " <> T.pack (unwords (srCreated report)))
-                                        <> (if null (srSkipped report) then "" else ", kept " <> T.pack (unwords (srSkipped report)))
-                                        <> (if null (srIndexes report) then "" else ", index on " <> T.pack (unwords (srIndexes report)))
-                                    )
-                closeClient client
 
 -- | ping 一次 server，报告它通不通
 checkServer :: Text -> Int -> IO ()

chusql-web/chusql-web.cabal

@@ -12,7 +12,6 @@ build-type:     Simple
 library
     hs-source-dirs:   src
     exposed-modules:  ChuSQL.Web.API
-                      ChuSQL.Web.Demo
                       ChuSQL.Web.Secure
                       ChuSQL.Web.Static
                       ChuSQL.Web.UISettings
@@ -20,6 +19,7 @@ library
                     , aeson
                     , bytestring
                     , chusql-core-model
+                    , chusql-core-engine
                     , chusql-interface
                     , containers
                     , directory