Add dual HTTPS repository sources and dependency fallback

.agents/README.md

@@ -1,13 +0,0 @@
-# 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

@@ -1,113 +0,0 @@
-# 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

@@ -1,56 +0,0 @@
-# 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

@@ -1,22 +0,0 @@
-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

@@ -1,41 +0,0 @@
-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

@@ -1,16 +0,0 @@
-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

@@ -1,64 +0,0 @@
----
-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

@@ -1,53 +0,0 @@
----
-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

@@ -1,48 +0,0 @@
----
-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`，区分当前类型用法与未来约束设计。以上源码模块是契约核对入口。

.env.example

@@ -0,0 +1,11 @@
+PUBLIC_ORIGIN=https://blog.example.com
+SITE_ADDRESS=blog.example.com
+ADMIN_USERNAME=admin
+# Generate with chublog-api hash-password; keep single quotes around the hash.
+ADMIN_PASSWORD_HASH='$argon2id$REPLACE_WITH_GENERATED_HASH'
+ALLOW_REGISTRATION=true
+CHUSQL_ROOT_PASSWORD=replace-with-random-root-password-at-least-16-characters
+CHUSQL_PASSWORD=replace-with-different-random-index-password-at-least-16-characters
+SSH_PORT=2222
+HTTP_PORT=80
+HTTPS_PORT=443

.github/workflows/build.yml

@@ -1,14 +0,0 @@
-# 构建状态：调用共用 Linux 构建流程。
-name: build
-on:
-  push:
-  pull_request:
-  merge_group:
-  workflow_dispatch:
-permissions:
-  contents: read
-jobs:
-  build:
-    uses: ./.github/workflows/linux.yml
-    with:
-      phase: build

.github/workflows/gate.yml

@@ -1,11 +0,0 @@
-# 门禁状态：仅由所有者手动触发全量入口。
-name: gate
-on:
-  workflow_dispatch:
-permissions:
-  contents: read
-jobs:
-  gate:
-    uses: ./.github/workflows/linux.yml
-    with:
-      phase: gate

.github/workflows/linux.yml

@@ -1,131 +0,0 @@
-# Linux CI：构建 Rust 与 Haskell，运行各组件测试。
-name: tests
-
-on:
-  push:
-  pull_request:
-  merge_group:
-  workflow_dispatch:
-  workflow_call:
-    inputs:
-      phase:
-        type: string
-        default: tests
-
-permissions:
-  contents: read
-
-concurrency:
-  group: linux-${{ inputs.phase || 'tests' }}-${{ github.ref }}
-  cancel-in-progress: true
-
-env:
-  CARGO_TERM_COLOR: always
-  LD_LIBRARY_PATH: ${{ github.workspace }}/chusql-core/storage/target/release
-
-jobs:
-  linux:
-    name: ${{ inputs.phase || 'tests' }}
-    runs-on: ubuntu-latest
-    timeout-minutes: 90
-    steps:
-      - uses: actions/checkout@v4
-
-      # ---------- Rust 存储 ----------
-      - name: Rust toolchain
-        uses: dtolnay/rust-toolchain@stable
-        with:
-          components: clippy
-
-      - name: Cache cargo
-        uses: actions/cache@v4
-        with:
-          path: |
-            ~/.cargo/registry
-            ~/.cargo/git
-            chusql-core/storage/target
-          key: ${{ runner.os }}-cargo-${{ hashFiles('chusql-core/storage/Cargo.lock') }}
-          restore-keys: ${{ runner.os }}-cargo-
-
-      - name: cargo build (release)
-        working-directory: chusql-core/storage
-        run: cargo build --release
-
-      - name: cargo test
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-core/storage
-        run: cargo test --release
-
-      - name: cargo clippy (-D warnings)
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-core/storage
-        run: cargo clippy --all-targets -- -D warnings
-
-      # 故意不做 rustfmt 检查：仓库里没有 rustfmt.toml，历史代码也不是按当前 rustfmt 的
-      # 默认风格排的，直接跑会报上百处折行与 use 排序差异；格式化不是本仓的门禁，别拿它
-      # 当交付标准。
-
-      # ---------- Haskell ----------
-      - name: Haskell toolchain
-        uses: haskell-actions/setup@v2
-        with:
-          ghc-version: '9.10.3'
-          enable-stack: true
-          stack-version: '3.11.1'
-
-      - name: Cache stack
-        uses: actions/cache@v4
-        with:
-          path: |
-            ~/.stack
-            chusql-core/engine/.stack-work
-            chusql-bootstrap/.stack-work
-            chusql-server/.stack-work
-            chusql-web/.stack-work
-            chusql-cli/.stack-work
-            benchmark/.stack-work
-          key: ${{ runner.os }}-stack-${{ hashFiles('**/stack.yaml', '**/stack.yaml.lock') }}
-          restore-keys: ${{ runner.os }}-stack-
-
-      - name: stack build (cabal 里带 -Wall)
-        working-directory: chusql-cli
-        run: stack build --fast
-
-      - name: bootstrap build
-        working-directory: chusql-bootstrap
-        run: stack build --fast
-
-      - name: benchmark4csql build
-        working-directory: benchmark
-        run: stack build benchmark4csql --fast
-
-      - name: owner-triggered gate
-        if: inputs.phase == 'gate'
-        shell: pwsh
-        run: ./gate-check/run-gate.ps1
-
-      - name: engine tests
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-core/engine
-        run: stack test --fast
-
-      - name: server tests
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-server
-        run: stack test --fast
-
-      - name: web tests
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-web
-        run: stack test --fast
-
-      - name: cli tests
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-cli
-        run: stack test chusql-cli --fast
-
-
-      - name: bootstrap tests
-        if: inputs.phase != 'build' && inputs.phase != 'gate'
-        working-directory: chusql-bootstrap
-        run: stack test chusql-bootstrap --fast

.github/workflows/release.yml

@@ -1,163 +0,0 @@
-# 发版流水线：构建 Windows 与 Linux 安装包，验证后上传 Release。
-#
-# 资源命名（install.sh / install.ps1 按 <os>-<arch> 挑资源，见 scripts/install.sh）：
-#   chusql-linux-x86_64.tar.gz     chusql-windows-x86_64.zip
-#
-# 一个平台一个包，里面 Web 前端与命令行客户端两部分都在；装哪几个由包内的安装脚本
-# 当场问（非交互时用 --component / -Component 指定）。
-#
-# 装的人拿到的就是编好的二进制，不需要 GHC / Rust：
-#   curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh \
-#       | sh -s -- --component web
-# 没有对应平台的资源时，同一个脚本可以退回本地编译：
-#   sh scripts/install.sh --component web --from-source
-#
-name: release
-
-on:
-  push:
-    tags: ['v*']
-  workflow_dispatch:
-    inputs:
-      tag:
-        description: 'tag to build and publish (must already exist)'
-        required: true
-
-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 }}
-    timeout-minutes: 150
-    strategy:
-      fail-fast: false
-      matrix:
-        include:
-          - { os: ubuntu-latest, platform: linux-x86_64 }
-          - { os: windows-latest, platform: windows-x86_64 }
-    steps:
-      - uses: actions/checkout@v4
-        with:
-          ref: ${{ inputs.tag || github.ref }}
-
-      # ---------- 工具链 ----------
-      - name: Rust toolchain
-        uses: dtolnay/rust-toolchain@stable
-
-      - name: Cache cargo
-        uses: actions/cache@v4
-        with:
-          path: |
-            ~/.cargo/registry
-            ~/.cargo/git
-            chusql-core/storage/target
-          key: ${{ runner.os }}-${{ matrix.platform }}-cargo-${{ hashFiles('chusql-core/storage/Cargo.lock') }}
-          restore-keys: ${{ runner.os }}-cargo-
-
-      - name: Haskell toolchain
-        uses: haskell-actions/setup@v2
-        with:
-          ghc-version: '9.10.3'
-          enable-stack: true
-          stack-version: '3.11.1'
-
-      - name: Cache stack
-        uses: actions/cache@v4
-        with:
-          path: |
-            ~/.stack
-            chusql-core/engine/.stack-work
-            chusql-web/.stack-work
-            chusql-cli/.stack-work
-          key: ${{ runner.os }}-${{ matrix.platform }}-stack-${{ hashFiles('**/stack.yaml', '**/stack.yaml.lock') }}
-          restore-keys: ${{ runner.os }}-stack-
-
-      # ---------- 构建 ----------
-      - name: build storage (Rust)
-        working-directory: chusql-core/storage
-        run: cargo build --release
-
-      - name: build web front end
-        working-directory: chusql-cli
-        run: stack build --fast chusql-web:exe:chusql-web
-
-      - name: build cli
-        working-directory: chusql-cli
-        run: stack build --fast chusql-cli:exe:csql
-
-      - name: build tcp server
-        working-directory: chusql-cli
-        run: stack build --fast chusql-server:exe:chusql-server
-
-      - name: build bootstrap program
-        working-directory: chusql-bootstrap
-        run: stack build --fast chusql-bootstrap:exe:csql-bootstrap
-
-      - name: package and verify (Unix)
-        if: runner.os != 'Windows'
-        shell: bash
-        run: sh scripts/package.sh --out-dir "$PWD/dist" --platform '${{ matrix.platform }}' --version '${{ inputs.tag || github.ref_name }}' --no-build
-
-      - name: package and verify (Windows)
-        if: runner.os == 'Windows'
-        shell: pwsh
-        run: ./scripts/package.ps1 -OutDir dist -Platform '${{ matrix.platform }}' -Version '${{ inputs.tag || github.ref_name }}' -NoBuild
-      - name: checksum
-        shell: pwsh
-        run: |
-          Get-ChildItem dist -File | Where-Object { $_.Name -match '\.(zip|tar\.gz)$' } | ForEach-Object {
-            $hash = (Get-FileHash $_.FullName -Algorithm SHA256).Hash.ToLower()
-            "$hash  $($_.Name)" | Set-Content -NoNewline "$($_.FullName).sha256"
-            Write-Host "$($_.Name)  $hash"
-          }
-
-      - name: upload
-        uses: actions/upload-artifact@v4
-        with:
-          name: ${{ matrix.platform }}
-          path: |
-            dist/*.zip
-            dist/*.tar.gz
-            dist/*.sha256
-          if-no-files-found: error
-
-  publish:
-    name: publish release
-    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
-          merge-multiple: true
-
-      - name: attach assets to the release
-        env:
-          GH_TOKEN: ${{ github.token }}
-          TAG: ${{ inputs.tag || github.ref_name }}
-        run: |
-          set -eu
-          ls -l dist
-          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

@@ -1,105 +1,11 @@
-# ============================================================
+/target/
-# ChuSQL 单仓库 .gitignore
+/data/
-#   chusql-core/engine/   Haskell (Stack + Cabal)
-#   chusql-core/storage/  Rust (Cargo)
-#   chusql-web/      前端 (手写 HTML / CSS / JS，无 Node 工具链)
-# ============================================================
-
-# ------------------------------------------------------------
-# Haskell / Stack / Cabal —— chusql-core/engine
-# ------------------------------------------------------------
-.stack-work/
-dist-newstyle/
-dist/
-*.hi
-*.o
-*.hie
-*.dyn_hi
-*.dyn_o
-*.prof
-*.aux
-*.hp
-*.eventlog
-*.tix
-.ghc.environment.*
-cabal.project.local
-cabal.project.local~
-
-# 锁文件要入库，不要忽略：
-#   chusql-core/engine/stack.yaml.lock
-#   cabal.project.freeze
-
-# ------------------------------------------------------------
-# Rust / Cargo —— chusql-core/storage
-# ------------------------------------------------------------
-target/
-**/*.rs.bk
-
-# 运行时数据（Rust 服务默认数据目录 CHUSQL_DATA_DIR=data/），不入库
-chusql-core/storage/data/
-
-# 本地运行产物：一键启动的数据目录、门禁各车道日志与临时目录、打包产物，不入库
-logs/
-
-# 本机打出来的发行包（scripts/package.sh / package.ps1 的产物），不入库
-releases/
-
-# 前端 IDE 设置（字体等，由 /api/ui-settings 读写），本机专用，不入库；resources/ 不参与打包
-resources/chusql.ui.settings.json
-
-# Cargo.lock 要入库（本项目是要产出可执行程序的 crate，不是纯库）
-
-# ------------------------------------------------------------
-# 前端 —— chusql-web/static 是手写的源文件，必须入库
-# ------------------------------------------------------------
-# 这里曾经放着 node_modules / .vite / *.tsbuildinfo 等 Node 工具链规则；
-# 前端已改为纯 HTML + CSS + JS 静态资源，不再需要它们。
-
-# 环境变量：只提交 .env.example，本地实际配置不入库
 .env
-.env.local
+node_modules/
-.env.*.local
+dist/
-
+.astro/
-# ------------------------------------------------------------
-# 日志
-# ------------------------------------------------------------
 *.log
-
+/deploy/bin/
-# ------------------------------------------------------------
+/deploy/secrets/
-# 编辑器 / IDE
+__pycache__/
-# ------------------------------------------------------------
+*.pyc
-.idea/
-*.iml
-.vscode/
-*.swp
-*.swo
-*~
-\#*\#
-.\#*
-.dsh
-# 注意：.zed/tasks.json 是本仓库共享的构建任务（stack build / run / test / repl），
-# 需要入库，所以这里不忽略 .zed/
-
-# ------------------------------------------------------------
-# 项目计划 / 提示词 / 设计决策 / 已知问题（本机文档，不入库）
-# ------------------------------------------------------------
-plandocs/
-
-# ------------------------------------------------------------
-# 操作系统
-# ------------------------------------------------------------
-.DS_Store
-._*
-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

.gitmodules

@@ -0,0 +1,6 @@
+[submodule "external/ChuSQL"]
+	path = external/ChuSQL
+	url = https://github.com/TheBadRoger/ChuSQL.git
+[submodule "external/ChuSQL-RustDriver"]
+	path = external/ChuSQL-RustDriver
+	url = https://github.com/TheBadRoger/ChuSQL-RustDriver.git

.zed/tasks.json

@@ -1,52 +0,0 @@
-[
-    {
-        "label": "haskell: stack build",
-        "command": "stack build",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
-        "reveal": "always",
-        "hide": "on_success",
-        "save": "all",
-    },
-    {
-        "label": "haskell: stack test",
-        "command": "stack test",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
-        "reveal": "always",
-        "hide": "never",
-        "save": "all",
-    },
-    {
-        "label": "haskell: stack run",
-        "command": "stack run",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
-        "reveal": "always",
-        "hide": "never",
-        "save": "all",
-    },
-    {
-        "label": "haskell: stack repl",
-        "command": "stack ghci",
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/engine",
-        "reveal": "always",
-        "hide": "never",
-        "save": "all",
-    },
-    {
-        "label": "rust: cargo check",
-        "command": "cargo",
-        "args": ["check", "--all-targets"],
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/storage",
-        "reveal": "always",
-        "hide": "on_success",
-        "save": "all",
-    },
-    {
-        "label": "rust: cargo test",
-        "command": "cargo",
-        "args": ["test"],
-        "cwd": "$ZED_WORKTREE_ROOT/chusql-core/storage",
-        "reveal": "always",
-        "hide": "never",
-        "save": "all",
-    },
-]

AGENTS.md

@@ -1,41 +0,0 @@
-# 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 构建串行，存储协议改动须重建实际动态库。
-- 改动说明只在交流中记录。

Cargo.toml

@@ -0,0 +1,4 @@
+[workspace]
+members = ["apps/api"]
+exclude = ["external/ChuSQL", "external/ChuSQL-RustDriver"]
+resolver = "3"

LICENSE

@@ -1,21 +0,0 @@
-MIT License
-
-Copyright (c) 2026 TheBadRoger
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.

PLAN.md

@@ -0,0 +1,225 @@
+# ChuBlog — 项目规划
+
+> 状态：规划草案 v1.0 · 2026-10-15  
+> 定位：自托管个人技术博客；Markdown 文件是内容源，Git 管理版本，ChuSQL 提供可重建的内容索引。
+
+## 1. 目标与原则
+
+- 面向个人作者，支持公开阅读、文章归档、标签、代码高亮、目录、SEO、RSS 和深色模式。
+- 管理员可在经过认证的后台上传 Markdown、预览、修改元数据、发布、撤回与删除文章；也支持本地 Git 工作流。
+- **Git 仓库内的 Markdown 与资源文件是唯一权威内容源**；ChuSQL 不保存唯一一份正文，只维护可重建索引。
+- 未授权用户不得发布页面、提交到内容仓库或触发任意服务器 Git 命令。
+- 保持 MVP 小而可靠；不引入公共用户注册、评论、插件市场、队列/微服务或复杂角色系统。
+- ChuSQL 暂不视为已通过生产验证的数据库；博客即使索引丢失，也能从 Git 恢复文章。
+
+## 2. 技术栈
+
+| 层 | 选型 | 职责 |
+| --- | --- | --- |
+| 站点 | Astro + TypeScript | 内容页面、按需服务端渲染、SEO、RSS |
+| 样式 | Tailwind CSS | 响应式设计、暗色模式 |
+| Markdown | Astro Markdown 管线（remark/rehype、Shiki） | Markdown/Frontmatter 解析、代码高亮 |
+| 后端 | Rust + Axum + Tokio + Serde | 管理员接口、认证、上传校验、Git 操作、索引同步 |
+| 数据库 | ChuSQL | 已发布文章元数据、标签、搜索索引（按当前能力逐步实现） |
+| DB 客户端 | `chusql-rs`（独立 crate） | ChuSQL 网络协议连接、查询、错误处理 |
+| 反向代理 | Caddy | HTTPS、请求体限制、路由 |
+| 运行 | Debian + Docker Compose | 管理服务与持久卷 |
+| 版本控制 | Git | 文章与图片的版本记录、审计与恢复 |
+
+不自行编写 Markdown 语法解释器。MVP 禁止文章中的原始 HTML 或采用严格清理策略；默认不启用任意 MDX/JS 组件，因为上传文档不能成为服务器执行代码的入口。
+
+## 3. 系统架构
+
+```text
+读者浏览器 ── HTTPS ── Caddy ── Astro（公共页面）
+                                 │
+                                 ├─ 只读文章文件 / content（挂载）
+                                 └─ Axum 只读 API（必要时）── ChuSQL（索引）
+
+管理员浏览器 ── HTTPS ── Caddy ── Axum（后台 API）
+                                      │
+                                      ├─ 管理员认证 / CSRF / 限流
+                                      ├─ Markdown 校验及暂存
+                                      ├─ 受控 Git 内容仓库
+                                      └─ 索引同步 ── chusql-rs ── ChuSQL
+
+管理员本地编辑器 ── Git 受保护分支 / 仓库同步流程 ── 内容仓库
+```
+
+- 只暴露 80/443 TCP；Axum、Astro 与 ChuSQL 使用私有 Docker 网络。
+- 现有 P2P 服务可独立继续使用 UDP 7001，互不影响。
+- **不允许用户请求决定任意磁盘路径、Git 仓库地址、Git 参数或 shell 命令。**
+- Astro 若需上传后立即生效，使用按需 SSR 读取受控的内容快照；不要依赖仅构建时扫描的静态内容集合。若改用纯静态生成，则明确采用“提交后重新构建并原子部署”的发布策略。MVP 选择 **SSR + 已发布内容快照**。
+
+## 4. 内容模型与存储布局
+
+```text
+chublog/
+├── apps/
+│   ├── web/                    # Astro 站点
+│   └── api/                    # Axum 后台与只读 API
+├── crates/
+│   └── chusql-rs/              # 若尚无独立仓库，可先工作区开发再拆分
+├── content/                    # 独立 Git 仓库或子目录（受控工作树）
+│   ├── posts/
+│   │   └── haskell-monad/
+│   │       ├── index.md
+│   │       └── cover.webp
+│   └── .gitignore
+├── deploy/
+│   ├── compose.yaml
+│   └── Caddyfile
+└── PLAN.md
+```
+
+文章 Frontmatter 规范示例：
+
+```md
+---
+title: "Haskell Monad 入门"
+slug: "haskell-monad"
+date: "2026-10-15"
+updated: "2026-10-15"
+status: "published"
+tags: ["Haskell", "Functional Programming"]
+description: "Monad 的基础概念"
+---
+
+# Haskell Monad 入门
+
+正文……
+```
+
+- `slug` 是唯一的 URL 标识，仅允许小写英文字母、数字、短横线，校验长度和保留名称。
+- 文件路径由服务端基于已校验 slug 固定计算；禁止 `../`、绝对路径、符号链接和路径穿越。
+- `status` 取 `draft | published`；草稿不可被未授权访问或从公开索引枚举。
+- 图片仅允许必要类型（如 PNG/JPEG/WebP），按真实文件内容与尺寸校验，限制单文件和文章总大小。SVG 暂不开放后台上传。
+- 内容文件和 Frontmatter 是权威信息；ChuSQL 中的记录可由全量扫描重新建立。
+
+## 5. Git 内容管理工作流
+
+### 5.1 后台上传与发布
+
+1. 管理员登录，上传 `.md` 与附属图片；后端检查会话、CSRF 与限流。
+2. 在隔离的暂存目录校验文件、解析 Frontmatter、检查重复 slug、限制大小和 Markdown 语法范围。
+3. 展示预览；管理员明确点击“发布”。预览默认不公开。
+4. 服务端通过受控文件操作写入仓库指定目录，创建 Git commit（提交者为固定服务身份，日志可附管理员操作 ID）。
+5. 提交成功后生成/切换已发布内容快照，并更新 ChuSQL 索引；公开页面仅读取已发布快照。
+6. 若索引更新失败，保留 Git 提交和待同步状态，由可重复执行的扫描任务恢复，不得静默显示“全部成功”。
+
+### 5.2 本地 Git 编写
+
+- 管理员可以在本地仓库编辑 Markdown，向受保护的主分支推送，或通过 PR 合并。
+- 推荐在 CI 检查 Frontmatter、路径、大小、图片、链接及危险内容；只有已认证维护者可合并。
+- 服务器采用**只读拉取/受控部署**，不接受互联网匿名推送；可使用带最小权限的部署凭证。
+- **双入口写入存在冲突风险**：MVP 应只开放一个写入主入口。建议首先采用“后台上传写入本地 Git 仓库”，后续引入远端同步时再明确由 CI 部署作为唯一发布入口；或者反过来完全让后台创建 PR。禁止两个入口不加协调地向同一工作树写入。
+
+### 5.3 更新、撤回、删除
+
+- 更新是新的 Git commit；保留文章稳定 slug，必要时配置显式重定向。
+- 撤回把 `status` 改为 `draft`，新快照不可公开访问。
+- 删除从当前版本移除，但 Git 历史可能仍含内容；对于秘密泄露需要额外执行历史清理与凭证轮换，不能认为删除 commit 就彻底清除。
+- 上传的草稿与私有资源必须与公开静态目录隔离，避免直链泄露。
+
+## 6. 身份认证与抗垃圾页面
+
+**MVP 采用单管理员、无公开注册、无公开投稿。** 未登录者没有任何创建、编辑、上传或 Git 写权限。这比单纯依靠验证码或限流更能从根源上避免垃圾页面泛滥。
+
+安全控制：
+
+1. 管理员账户配置在受保护的服务端环境或安全存储中；口令以 Argon2id 等成熟密码哈希存储，绝不保留明文。
+2. 登录成功后发放服务端会话；Cookie 使用 `HttpOnly`、`Secure`、`SameSite`，设置到期时间和退出失效机制。生产建议支持 TOTP 2FA 或使用成熟身份代理实现 MFA。
+3. 所有状态变更接口强制验证身份与 CSRF（包括上传、提交、发布和删除）；校验 `Origin`，设置合理 CORS 策略。
+4. 登录端点按 IP 与账户维度限流、失败退避和审计；上传限制文件大小、数量、总磁盘配额、请求频率、并发和执行耗时。
+5. 反向代理和 API 分层限制请求体大小；服务仅接受预期 MIME 与文件结构；禁止 HTML/脚本执行、可疑链接协议与不受控资源嵌入。
+6. Git 命令通过固定参数的进程 API 执行，**不用拼接 shell 字符串**；Git 工作树不允许访问任意仓库 hook，服务运行身份权限最小化。
+7. 公开内容启用合理 CSP、HTML 清理、链接安全属性；后台不暴露到不必要的外部域名。
+8. 采用日志审计：谁在什么时候上传、预览、发布、撤回、删除，以及对应 commit hash；不要记录口令或会话令牌。
+
+若以后支持访客投稿：所有投稿必须进入**待审核区**，经管理员人工批准后才能进入正式 Git 分支；不得让访客直接触发公开发布。
+
+## 7. API 草案
+
+| 方法 | 路径 | 权限 | 说明 |
+| --- | --- | --- | --- |
+| `POST` | `/api/admin/login` | 公共、限流 | 管理员登录 |
+| `POST` | `/api/admin/logout` | 管理员 + CSRF | 注销会话 |
+| `GET` | `/api/posts` | 公共 | 查询已发布文章元数据 |
+| `GET` | `/api/posts/:slug` | 公共 | 已发布文章信息（或由 Astro 直接读取文件） |
+| `POST` | `/api/admin/uploads` | 管理员 + CSRF | 上传临时文件、验证 |
+| `POST` | `/api/admin/posts/preview` | 管理员 + CSRF | 安全预览 |
+| `POST` | `/api/admin/posts/publish` | 管理员 + CSRF | 固定目录落盘并 Git 提交 |
+| `PATCH` | `/api/admin/posts/:slug` | 管理员 + CSRF | 更新元数据/内容 |
+| `POST` | `/api/admin/posts/:slug/unpublish` | 管理员 + CSRF | 撤回文章 |
+| `DELETE` | `/api/admin/posts/:slug` | 管理员 + CSRF | 删除当前版本 |
+| `POST` | `/api/admin/index/rebuild` | 管理员 + CSRF | 从 Git 内容重建 ChuSQL 索引 |
+
+API 路由仅为计划，后续以实现的最小接口为准；对发布、更新、删除操作加互斥与幂等处理，防止并发提交损坏仓库状态。
+
+## 8. ChuSQL 集成与一致性
+
+MVP 仅需要 `posts` 元数据与 `tags`，字段例如 `slug, title, description, status, published_at, updated_at, path, git_commit`。字段类型、DDL、过滤和分页查询应按现有 ChuSQL 协议确定，不能预设兼容 PostgreSQL 或 SQLx。
+
+- `chusql-rs` 第一版支持：连接、超时、查询/执行、结果与类型映射、错误处理、断线识别、集成测试。
+- 不依赖目前未实现或未经验证的 ChuSQL 多语句事务；应用端以 Git 快照为权威，数据库仅做派生索引。
+- 每次发布记录 Git commit hash，索引带对应内容版本号。建立独立的 `rebuild-index` 命令与定期一致性检查。
+- ChuSQL 不可用时，已生成的公开内容快照仍能被读取；列表、标签等可从文件快照构建简易只读索引。禁止在数据库错误时覆盖或删除文章文件。
+- 上传发布时采用严格顺序和可恢复状态：校验 → 暂存 → Git commit → 更新已发布快照 → 尝试索引同步；出错后可依据 commit 重新同步。
+- 文章页面不要因 ChuSQL 宕机而泄露内部错误或凭证。
+
+## 9. 实施阶段与验收
+
+### Phase 0 — 先验证接口
+
+- [ ] 检查 ChuSQL 服务端网络协议、查询语法和持久化行为。
+- [ ] 决定 Astro SSR 在容器内读取哪个受控内容目录。
+- [ ] 确定 Git 仓库部署路径、最小权限和快照切换方式。
+
+### Phase 1 — 纯文件博客 MVP
+
+- [ ] Astro 页面：首页、文章详情、标签、归档、404、暗色模式。
+- [ ] Markdown + Frontmatter 校验、Shiki 代码高亮、文章目录。
+- [ ] Astro SSR 读取已发布内容快照；提供 RSS、sitemap 和 SEO 元信息。
+- [ ] 测试异常文件、超大文件和 XSS 内容不会被执行。
+
+### Phase 2 — 后台 + Git 发布
+
+- [ ] 单管理员认证、会话与 CSRF。
+- [ ] 上传、预览、发布、编辑、撤回、删除。
+- [ ] 每次发布产生可追踪的 Git commit；冲突与重复提交有明确错误反馈。
+- [ ] 通过限流、文件配额、路径校验和无公开注册测试。
+
+### Phase 3 — ChuSQL 驱动与索引
+
+- [ ] 开发 `chusql-rs` 最小客户端及协议测试。
+- [ ] 建立文章元数据表、查询接口与索引同步。
+- [ ] 完成从 Git 仓库重建索引的命令与故障注入测试。
+- [ ] 验证 ChuSQL 故障期间公开阅读不中断、恢复后索引一致。
+
+### Phase 4 — 部署与运维
+
+- [ ] Docker Compose、Caddy TLS、仅开放必要公网端口。
+- [ ] 持久化 Git 内容与资源；数据库卷、日志独立管理。
+- [ ] 备份 Git 仓库（含远端镜像）与上传资源；定期进行真实恢复演练。
+- [ ] 监测磁盘、接口错误、登录失败、索引同步延迟。
+- [ ] 更新依赖、最小容器权限、限制容器挂载与网络访问。
+
+**MVP 完成判定**：未经认证无法写入或发布；管理员可上传并发布一篇 Markdown，页面即刻可读，Git 中有对应提交；重启容器后内容存在；故意停止 ChuSQL 后仍可浏览已发布文章；重新建立数据库后可重建索引；恶意路径、超大文件和脚本注入测试均不能成功。
+
+## 10. 生产就绪与风险边界
+
+- **文章内容生产可用性**来自 Git、可恢复的文件快照、访问控制、备份及恢复演练，不取决于 ChuSQL 当前成熟度。
+- **ChuSQL 仍按实验性组件管理**：在事务原子性、并发控制、进程崩溃恢复、备份/恢复、认证与长时间稳定性未经验证前，不作为任何不可重建数据的唯一存储。
+- 文件与数据库之间不追求假想的跨系统原子事务，而采用幂等同步和可回放 Git 提交恢复一致性。
+- 不把管理员凭证、Git 写入凭证或 ChuSQL 密码写入 Git 仓库、镜像层和日志。
+
+## 11. 暂不纳入 MVP
+
+- 访客注册、公开投稿、评论、点赞与复杂权限角色。
+- 前端在线富文本编辑器、协同编辑和复杂草稿工作流。
+- 全文搜索引擎、消息队列、分布式部署、对象存储、多租户。
+- 自建 Markdown 解释器、通用插件机制和 ChuSQL ORM/SQLx 适配。
+
+## 12. 近期第一步
+
+优先确认 ChuSQL 现有协议，同时创建 Astro 静态界面与 Axum 认证/上传原型。先跑通**管理员上传 → 校验 → Git 提交 → 公开页面读取文件**，之后再接入 ChuSQL 元数据索引。这样即使数据库研发推迟，博客仍可独立推进。

README.md

@@ -1,55 +1,169 @@
-# ChuSQL
+# ChuBlog
 
-<p align="center">
+Rust/Axum 博客后端。文章作者在本地编辑 Markdown，通过受限 SSH Git 推送发布。注册、登录、权限管理使用 HTTP API；文章仅通过 Git 修改。ChuSQL 通过外部子模块 `external/ChuSQL-RustDriver` 接入，只存可重建索引。
-  <img src="https://img.shields.io/badge/Haskell-5e5086?style=flat-square" alt="Haskell">
-  <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 自定义类型及用户与角色管理。
+本轮按最新需求只实现后端，没有前端或在线文章管理。`PLAN.md` 保留原始规划，当前范围与后续安排见 [TODO.md](TODO.md)。
 
-## 快速开始
+## 项目与运行
 
-### 安装
+```text
+ChuBlog/
+├── apps/api/
+├── external/
+│   ├── ChuSQL/             # Git 子模块，主仓库只记录版本指针
+│   └── ChuSQL-RustDriver/  # Git 子模块
+└── scripts/init-deps.py
+```
 
-Linux / macOS：
+项目提供两个 HTTPS 仓库，任选其一克隆：
 
 ```sh
-curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web
+git clone https://github.com/TheBadRoger/ChuBlog.git
+# 或：git clone https://repo.chunana.cn/ChuNa7a/ChuBlog.git
+cd ChuBlog
+python3 scripts/init-deps.py
 ```
 
-Windows（PowerShell 里下下来再跑；也有下载 zip 解压的包内安装）：
+数据库和驱动均提供两个 HTTPS 源：
 
-```powershell
+| 依赖 | GitHub | 自建仓库 |
-irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1"
+| --- | --- | --- |
-& "$env:TEMP\install.ps1" -Component web
+| ChuSQL | https://github.com/TheBadRoger/ChuSQL.git | https://repo.chunana.cn/ChuNa7a/ChuSQL.git |
-```
+| ChuSQL-RustDriver | https://github.com/TheBadRoger/ChuSQL-RustDriver.git | https://repo.chunana.cn/ChuNa7a/ChuSQL-RustDriver.git |
 
-### 启动
+初始化先尝试 GitHub HTTPS，连接、访问或固定提交获取失败时回退自建 HTTPS，无需 SSH 身份。已正确初始化的固定版本直接复用，有未提交修改时拒绝覆盖；回退不改为任意最新分支。项目不设置全局 `insteadOf`、localhost 映射、OS 用户或服务器 SSH 配置。
+
+开发电脑仍可显式选择已有本地来源（仅开发覆盖参数，不是服务器默认流程）；只读取已提交版本：
 
 ```sh
-csql
+python3 scripts/init-deps.py --database-repo ../ChuSQL --driver-repo ../ChuSQLDriver
 ```
 
-启动CLI界面，或
+子模块固定到已提交版本；源仓库必须包含这些提交。依赖源码和构建产物不进入博客仓库，更新依赖时只提交 `.gitmodules`/配置及子模块指针。不要对主仓库使用 `git add --force` 重新收录依赖文件。
+
+
+开发检查：
 
 ```sh
-csql-web
+cargo test --all-targets
+cargo fmt --check
+cargo clippy --all-targets -- -D warnings
 ```
 
-启动web界面，默认通过7778端口访问
+部署基于 Debian 13。`scripts/deploy.sh` 会使用同一个依赖初始化脚本，自动在上述两个 HTTPS 源之间回退，再构建外部数据库与 Docker 镜像；沿用运行者现有的 Git 配置，不在项目内覆盖服务器环境。
 
-## 更多参考文档
+```sh
+scripts/deploy.sh
+```
 
-- [安装与卸载](docs/install.md)
+首次部署先准备 `.env`；也可以手动执行以下同架构构建步骤：
-- [配置选项](docs/config.md)
+
-- [命令与选项](docs/commands.md)
+```sh
-- [SQL 语法](docs/syntax.md)
+# ChuSQL 尚未编译时，先按其项目说明构建 Rust 存储库、server 与 bootstrap。
-- [类型与类型目录](docs/types.md)
+python3 scripts/prepare-deploy.py --build-database
-- [用户、角色与属性](docs/users-and-roles.md)
+cp .env.example .env
-- [系统引导与恢复](docs/bootstrap.md)
+chmod 600 .env
-- [架构与组件](docs/architecture.md)
+# 从标准输入输入管理员口令，Ctrl-D 结束；不要把明文写进命令行历史。
-- [性能基准与瓶颈分析](docs/performance.md)
+./deploy/bin/chublog-api hash-password
+# 将输出以单引号包裹写入 .env 的 ADMIN_PASSWORD_HASH；同时配置域名及两份不同的随机 DB 口令。
+docker compose --env-file .env -f deploy/compose.yaml up -d --build
+# db 启动就绪后，创建 chublog 库和非超级用户 chublog_index；失败时检查日志后重试。
+docker compose --env-file .env -f deploy/compose.yaml run --rm db-init
+```
+
+部署入口启动服务后，首次仍需执行上面的 `db-init` 命令；入口不会在数据库启动竞态中静默吞掉初始化错误。
+
+构建时若 Debian 官方下载源较慢，可在 `.env` 配置 `DEBIAN_MIRROR=mirrors.ustc.edu.cn`，仍使用 Debian 签名校验。
+
+`prepare-deploy.py` 默认从数据库子模块读取编译产物；`--build-database` 会先构建其 Rust 存储库、Haskell server 和 bootstrap。也可用 `--chusql-source /已有构建的/ChuSQL` 选择已有外部构建，没有产物会明确失败。编译产物只暂存在被忽略的 `deploy/bin/`。跨平台部署须先在目标 Debian/架构构建，不能复制 macOS、Windows 或其他架构二进制。镜像不含编译器、源码、`.env` 或密码文件。首次启动从环境中的哈希创建管理员，后续账号与权限以持久文件为准，修改初始哈希不会覆盖已有账户。
+
+Caddy 根据 `SITE_ADDRESS` 提供 HTTPS 和 API 反向代理；`PUBLIC_ORIGIN` 必须与外部站点完全一致，不带结尾斜杠。HTTP 仅对 localhost 开发场景允许。只需公网 TCP 80/443 和 Git SSH 2222（可改）；主机管理 SSH 另行管理，数据库和 API 不映射宿主端口。既有 UDP 7001 不受影响。参考 [Caddy 请求体限制](https://caddyserver.com/docs/caddyfile/directives/request_body) 与 [反向代理文档](https://caddyserver.com/docs/caddyfile/directives/reverse_proxy)。
+
+## 用户与发布授权
+
+完整接口见 [docs/API.md](docs/API.md)。
+
+1. 注册：`POST /api/auth/register`，正文 `{ "username": "alice", "password": "至少12字节的口令" }`。默认角色 `reader`，绝不接受客户端指定角色。`ALLOW_REGISTRATION=false` 可关闭注册。
+2. 登录：`POST /api/auth/login`，相同字段。浏览器保存 HttpOnly Cookie；返回 `csrf`。所有修改请求必须携带站点 `Origin` 和 `X-CSRF-Token`。
+3. 本地生成 `ssh-keygen -t ed25519` 或 `ssh-keygen -t rsa -b 3072`；登录后 `PUT /api/account/ssh-key` 提交 `{ "public_key": "ssh-ed25519 AAAA..." }`，只交公钥。RSA 使用标准 `ssh-rsa AAAA...` 公钥文本，支持 2048–8192 位；实际认证使用 RSA/SHA-256 或 RSA/SHA-512，不启用旧的 SHA-1 签名。见 [OpenSSH 说明](https://www.openssh.com/txt/release-8.8)。
+4. 管理员登录后调用 `PATCH /api/admin/users/alice`，正文 `{ "enabled": true, "role": "publisher", "prefixes": ["alice-"] }`。不同有效发布者的前缀不能重叠。
+5. 此时 SSH 才接受该用户的密钥；`reader`、停用用户、未绑密钥的用户均不能访问 Git。管理员也需显式分配前缀和公钥才能发布。
+
+授权与密钥独立：知道服务器地址、有网站账户、上传了公钥都不足以推送。设回 `reader` 或 `enabled:false` 会撤回发布授权，并使现有网站会话失效。禁止管理员停用自己或取消自己的管理角色。
+
+## 本地 Git 工作流
+
+先通过可信渠道核对服务器 Ed25519 主机密钥指纹；不要禁用主机密钥检查。主机密钥保存在独立持久卷，重建容器不会更换。所有发布者使用同一个 OS 账户 `git`，身份由对应公钥的强制命令绑定，不由 Git author/email 决定。
+
+```sh
+# ~/.ssh/config
+Host chublog
+    HostName blog.example.com
+    Port 2222
+    User git
+    IdentityFile ~/.ssh/id_ed25519
+    IdentitiesOnly yes
+
+# 首次发布，远端是空仓库时：
+git init --initial-branch=main my-articles
+cd my-articles
+git remote add origin chublog:content.git
+# 创建 posts/alice-first/index.md，规范参考 content/posts/welcome/index.md。
+# 样例 slug welcome 需要改成自己获授权的 alice-first。
+git add posts/alice-first
+git commit -m 'Publish first article'
+git push -u origin main
+
+# 已有内容时先 clone；每轮编辑前拉取最新内容。
+git clone chublog:content.git
+cd content
+git pull --ff-only
+# 编辑 posts/alice-first/index.md
+git add posts/alice-first
+git commit -m 'Update article'
+git push
+```
+
+MVP 每次只接受 **一个直接继承远端 main 的提交**，首次仅允许一个根提交。禁止 merge、force push、删除 main、标签及其他分支；本地有多次提交时先整理为单次提交，再拉取/变基到最新远端。发生并发冲突时，拉取并解决后重试。
+
+`status: published` 发布，改为 `draft` 撤回，删除文章目录则删除当前版本。图片置于同一目录，Markdown 使用 `![说明](cover.png)`，不允许外链图片。API 在同步后读取新内容，一般约 2 秒；索引重建期间可能延迟到约 32 秒。`GET /api/admin/status` 查看已导入与已索引 commit；Git 接受只表示接收校验完成，尚不代表索引同步成功。
+
+**授权发布者可以 clone 全部文章仓库及历史，包括其他发布者的草稿。** 草稿只对公开 HTTP 隔离，当前仓库不提供发布者之间的草稿保密；不要提交秘密或私钥。删除/撤回不能抹掉 Git 历史。
+
+## 内容与隔离边界
+
+- 唯一内容入口是 `posts/<slug>/index.md` 和同目录 PNG/JPEG/WebP；禁止额外文件、目录、符号链接、可执行位、子模块和 LFS 指针。
+- Markdown 上限 256 KiB；图片单张 2 MiB、最多 12 张、尺寸 4096×4096；文章合计 6 MiB；快照原始文件合计 64 MiB、最多 1000 篇。
+- Git 输入 pack 上限 8 MiB；接收仓库达到 256 MiB 后拒绝新 SSH 会话，需要管理员离线维护。此阈值是应用检查，生产还应为 Docker 数据盘配置真实文件系统配额。
+- 使用成熟 Markdown 解析器，拒绝原始 HTML、危险链接协议、外链图片、控制符和双向隐藏字符；代码块是惰性文本，绝不执行 MDX、JS、仓库脚本、构建任务或上传内容。
+- 支持 Ed25519 和 2048–8192 位 RSA 公钥，拒绝弱密钥、负数/畸形 RSA 参数及额外二进制数据；拒绝把 `authorized_keys` 选项当作公钥上传。SSH 只接受精确的 `git-receive-pack 'content.git'` / `git-upload-pack 'content.git'`，没有 shell、SCP/SFTP、TTY、转发、隧道、用户环境变量。
+- 接收仓库由 UID 10002 管理；API 为独立 UID 10001，正式仓库/用户密码文件不挂载给 SSH 容器；SSH 只读授权文件和只读固定 hook。接收内容再次验证后才导入 API 自己的 Git 仓库。
+- HTTP 请求体 8 KiB；注册/登录合计全局 10 次/分钟，修改操作全局 60 次/分钟；密码哈希并发最多 2。1000 用户、1000 个有效会话上限，一小时固定会话期限。全局限制偏保守，后续可细化 IP/账户限制以改善公平性。
+- 统计不收集 IP/访客身份：公开文章数、标签数、Markdown 字节数、启动以来文章 API 请求数。请求数不是独立访客数，重启后清零。
+
+服务器只返回 JSON Markdown 与图片；后续前端必须把元数据当文本输出，并继续禁用原始 HTML、MDX和危险链接，不能将接口字段直接作为 HTML 执行。隔离不能替代 Git/OpenSSH/解码库的持续安全更新。
+
+## 持久化、故障和恢复
+
+`content` 卷包含正式 `content.git`、`users.json` 和公开 `published.json`；`authorization` 卷是独立发布授权与公钥；`ingress` 是 SSH 接收仓库；`ssh-host-keys` 保留服务器身份。数据库和数据库日志为独立卷。日志输出 stdout，由 Docker 分卷轮换，不记录口令、会话或私钥。
+
+文章索引失败不会修改 Git 或阻塞 HTTP 阅读，后台约每分钟重试并检查索引是否丢失。恢复数据库后可自动重建；离线命令为 `chublog-api rebuild-index`（必须停止同一数据卷上的 API 进程后运行，防止并发），或等待在线自动重试。`indexed_commit:null` 表示尚无已确认可用的索引，旧值表示尚未追平当前内容。应用不依赖 ChuSQL 事务。
+
+备份必须同时包含正式 Git、用户文件、授权卷、SSH 主机密钥；备份包含密码哈希，须加密并限制权限。接收 Git 可额外镜像备份。恢复时先停止写入，从同一备份恢复各卷，再启动；不要只恢复 ChuSQL，也不要直接向正式仓库推送。应用启动从 Git 重新校验并生成快照。进程重启会注销所有会话。
+
+本实现对文件写入执行原子替换与 fsync，Git 引用采用受控更新；磁盘故障、主机断电和备份恢复仍需真实环境演练。不要对含正式数据的项目执行 `docker compose down -v`。
+
+## 联调
+
+```sh
+python3 scripts/prepare-deploy.py --build-database
+python3 scripts/smoke.py
+python3 scripts/smoke.py --key-type rsa
+```
+
+联调使用独立随机命名的 Compose 项目、本机 18080/18443/12222 端口，测试结束清理自己创建的容器与卷。覆盖真实 SSH 身份与授权、非法推送、发布撤回、ChuSQL 索引、断库阅读、重启与撤权。该测试会拉取基础镜像，需要 Docker 可用。
+
+
+## 历史清理后的协作
+
+驱动的旧源码副本已从主仓库可达历史移除，后续只保留外部子模块配置。历史重写后，已有克隆建议重新克隆并初始化依赖；不要把旧 main 合并回来，否则可能重新引入已删除的依赖历史。自建服务器的不可达对象清理与其他人的旧克隆需要分别处理，GitHub 缓存和旧提交直链的回收由平台管理。

TODO.md

@@ -0,0 +1,64 @@
+# ChuBlog — 后续待办计划
+
+更新：2026-10-15。本文依据最新需求划分后续工作；`PLAN.md` 保留原始总体规划。当前只做后端，Git 是唯一文章写入入口。
+
+## 当前已实现
+
+- [x] Rust/Axum API：公开文章列表、详情、图片、基础统计、健康接口。
+- [x] 用户注册、登录、退出、修改密码；Argon2id、服务端会话、Cookie、Origin/CSRF 校验。
+- [x] reader / publisher / admin 权限；注册不能自选权限，管理员单独审批发布权、停用用户，修改权限使已有会话失效。
+- [x] 用户上传/轮换自己的 Ed25519/RSA 公钥，公钥存在与具有发布权分别检查。
+- [x] OpenSSH 强制命令：仅固定仓库的 Git push/clone；禁用 shell、SFTP/SCP、TTY、代理/端口转发、隧道与用户环境。
+- [x] 发布者 slug 前缀授权，不允许重叠授权或修改其他命名空间。
+- [x] pre-receive 校验 Git quarantine 内的候选提交：单次一个线性提交、仅 main、禁止删除分支、强推、标签及其他分支。
+- [x] Markdown Frontmatter、路径、文件模式、大小配额、图片类型/内容/尺寸与链接安全校验；拒绝原始 HTML、隐藏控制符、符号链接、可执行文件及额外文件。
+- [x] 独立 SSH 接收仓库与 API 正式仓库；从 Git 恢复公开快照，草稿不出现在公开 API/资源接口。
+- [x] 外部 `ChuSQL`/`ChuSQL-RustDriver` 子模块配置、GitHub HTTPS 默认来源及授权设备 SSH 优先/HTTPS 回退；ChuSQL 公开元数据/标签索引及失败自动重建，数据库不承担唯一内容或账户存储。
+- [x] Docker Compose、Caddy 反向代理、独立持久卷、容器资源限制、最小进程身份与网络隔离。
+- [x] 后端/驱动自动测试、真实容器 SSH 联调脚本、运行/API/架构说明。
+
+## 第一优先级：部署环境验收
+
+- [ ] 配置真实域名、DNS、服务器防火墙与 Caddy 公网证书，确认只有所需 80/443/文章 SSH 端口对外开放。
+- [ ] 从真实作者电脑验证 SSH 主机指纹、注册、公钥登记、管理员授权、首次推送和多人并发冲突处理。
+- [ ] 给 Docker 数据目录设置文件系统硬配额；用压缩炸弹、大量失败推送和连接洪泛验证空间、CPU、内存、超时及进程数边界。
+- [ ] 对正式 Git、用户哈希、授权文件、SSH 主机密钥制定加密备份与保留策略，执行完整恢复演练。
+- [ ] 验证断电/磁盘满时 Git 引用、快照、账户及权限文件的一致性；故障恢复后不保留过期发布权。
+- [ ] 在实际 ChuSQL 版本执行长期并发、进程崩溃恢复及索引故障注入验证；保持其派生索引定位。
+- [ ] 固定经过验证的镜像 digest，建立 Git/OpenSSH/Rust 依赖和基础系统安全更新流程。
+
+验收：有完整恢复记录；恶意推送不能影响正式内容；撤权后不能再次推送；数据库宕机仍可阅读，恢复后索引 commit 与内容一致。
+
+## 第二优先级：账户与权限完善
+
+- [ ] 管理员 MFA（成熟身份代理或 TOTP），敏感授权操作二次验证。
+- [ ] 安全的管理员离线恢复/重置流程；用户密码找回需要先决定可信邮件或邀请渠道，禁止不验证身份的重置接口。
+- [ ] 每用户多把公钥、指纹展示、单钥撤销、最后使用时间；保留每钥身份绑定。
+- [ ] 在全局限流之上增加可信代理来源的 IP 与账户维度限制、失败退避，减轻公共认证桶被恶意占满的问题。
+- [ ] 注册开放策略、邀请注册或邮件验证；保留注册与发布审批的权限分离。
+- [ ] 持久化结构化审计，明确记录每次接受的 commit 对应站内用户与公钥指纹，并设置保留周期。当前 SSH 接收日志已有身份与 commit，API 导入日志只有 commit，尚无统一审计查询。
+- [ ] 发布者之间的草稿隔离需求确认：当前授权作者能 clone 全仓库及历史。如需作者之间保密，改用独立收稿仓库，再统一发布。
+
+## 第三优先级：Astro + TypeScript 阅读前端
+
+- [ ] SSR 读取后端已发布 API：首页、文章详情、标签、归档、404、暗色模式与移动端排版。
+- [ ] 使用 Astro Markdown/remark/rehype 和 Shiki：持续禁用原始 HTML/MDX，并清理输出，元数据必须作为文本转义。
+- [ ] 文章目录、SEO、canonical、Open Graph、RSS、sitemap、robots。
+- [ ] 注册/登录/账户页面、SSH 公钥设置和管理员发布授权页面；不增加在线文章写入口。
+- [ ] 无障碍、错误状态、限流提示、安全 CSP 与浏览器端 XSS 回归验证。
+
+验收：作者只需在本地编辑并 push，阅读端自动看到更新；草稿及资源无法由未登录访问者枚举或直链读取。
+
+## 第四优先级：发布和运维体验
+
+- [ ] 发布状态查询：区分 Git 已接受、内容已导入、索引已同步，向作者提供 commit 级诊断。
+- [ ] 支持有上限的多次线性提交推送，逐个验证新增历史；保留对 merge/force push 的明确策略。
+- [ ] 目录配额预警、安全 GC 与维护窗口；禁止在 SSH 请求里运行任意维护命令。
+- [ ] 扩充现有 commit/行数对账为完整字段与标签对账；增加磁盘/登录失败/索引延迟/导入失败告警，以及受控恢复工具。
+- [ ] API 分页与条件缓存：保留撤回后不可继续公开访问的语义。
+- [ ] 更完整的统计：先定义访问口径与隐私策略，再决定是否持久化每日聚合；当前请求计数不是独立访客数，重启清零。
+- [ ] 外部资源链接检查、slug 重定向与图片元数据清理；不能因此在服务器执行作者提供的命令。
+
+## 后续再评估
+
+在线编辑/上传/预览、全文检索、评论、多副本和更复杂的角色。若引入在线编辑，应先明确其如何经过同一授权、校验与发布协调流程，不能在现有 Git 仓库上新增未经协调的第二个写入口。

apps/api/Cargo.toml

@@ -0,0 +1,27 @@
+[package]
+name = "chublog-api"
+version = "0.1.0"
+edition = "2024"
+
+[dependencies]
+anyhow = "1"
+argon2 = "0.5"
+axum = "0.8"
+base64 = "0.22"
+chrono = { version = "0.4", features = ["serde"] }
+chusql-driver = { path = "../../external/ChuSQL-RustDriver" }
+fs2 = "0.4"
+image = { version = "0.25", default-features = false, features = ["png", "jpeg", "webp"] }
+rand = "0.8"
+serde = { version = "1", features = ["derive"] }
+serde_json = "1"
+serde_yaml = "0.9"
+ssh-key = { version = "0.6.7", default-features = false, features = ["std"] }
+tokio = { version = "1", features = ["full"] }
+pulldown-cmark = "0.13"
+tracing = "0.1"
+tracing-subscriber = { version = "0.3", features = ["env-filter"] }
+
+[dev-dependencies]
+tempfile = "3"
+tower = { version = "0.5", features = ["util"] }

apps/api/src/accounts.rs

@@ -0,0 +1,669 @@
+use crate::{ApiError, ApiResult, App, bad, internal, origin, ssh};
+use anyhow::{Context, Result, ensure};
+use argon2::{
+    Argon2, PasswordHash, PasswordHasher, PasswordVerifier,
+    password_hash::{SaltString, rand_core::OsRng},
+};
+use axum::{
+    Json,
+    extract::{Path, State},
+    http::{HeaderMap, HeaderValue, StatusCode, header},
+    response::{IntoResponse, Response},
+};
+use base64::{Engine, engine::general_purpose::URL_SAFE_NO_PAD};
+use rand::RngCore;
+use serde::{Deserialize, Serialize};
+use serde_json::{Value, json};
+use std::{
+    collections::{BTreeMap, VecDeque},
+    path::Path as FilePath,
+    sync::Arc,
+    time::{Duration, Instant},
+};
+use tokio::io::AsyncWriteExt;
+
+#[derive(Clone, Copy, Debug, Serialize, Deserialize, PartialEq, Eq)]
+#[serde(rename_all = "lowercase")]
+pub enum Role {
+    Reader,
+    Publisher,
+    Admin,
+}
+#[derive(Clone, Deserialize, Serialize)]
+#[serde(deny_unknown_fields)]
+pub struct Grant {
+    pub enabled: bool,
+    pub role: Role,
+    pub prefixes: Vec<String>,
+    pub ssh_key: Option<String>,
+}
+#[derive(Serialize, Deserialize)]
+struct Credential {
+    hash: String,
+}
+struct Session {
+    username: String,
+    csrf: String,
+    expires: Instant,
+}
+pub struct Accounts {
+    credentials: BTreeMap<String, Credential>,
+    pub grants: ssh::Config,
+    sessions: BTreeMap<String, Session>,
+    attempts: VecDeque<Instant>,
+    changes: VecDeque<Instant>,
+}
+
+pub async fn atomic(path: &FilePath, bytes: &[u8], mode: u32) -> Result<()> {
+    use std::os::unix::fs::PermissionsExt;
+    let tmp = path.with_extension("tmp");
+    let mut file = tokio::fs::OpenOptions::new()
+        .create(true)
+        .truncate(true)
+        .write(true)
+        .mode(mode)
+        .open(&tmp)
+        .await?;
+    file.write_all(bytes).await?;
+    file.sync_all().await?;
+    tokio::fs::set_permissions(&tmp, std::fs::Permissions::from_mode(mode)).await?;
+    tokio::fs::rename(&tmp, path).await?;
+    let directory = std::fs::File::open(path.parent().context("文件缺少父目录")?)?;
+    directory.sync_all()?;
+    Ok(())
+}
+fn username(value: &str) -> Result<()> {
+    ensure!(
+        (3..=32).contains(&value.len())
+            && value
+                .bytes()
+                .all(|b| b.is_ascii_lowercase() || b.is_ascii_digit() || b == b'-')
+            && value.starts_with(|c: char| c.is_ascii_lowercase()),
+        "用户名必须为 3–32 位小写字母、数字或短横线，以字母开头"
+    );
+    Ok(())
+}
+fn password(value: &str) -> Result<()> {
+    ensure!(
+        (12..=1024).contains(&value.len()),
+        "口令必须为 12–1024 字节"
+    );
+    Ok(())
+}
+pub async fn hash_password(value: String) -> Result<String> {
+    password(&value)?;
+    tokio::task::spawn_blocking(move || {
+        Argon2::default()
+            .hash_password(value.as_bytes(), &SaltString::generate(&mut OsRng))
+            .map(|hash| hash.to_string())
+            .map_err(|e| anyhow::anyhow!(e.to_string()))
+    })
+    .await?
+}
+pub async fn load(
+    data: &FilePath,
+    config: &FilePath,
+    repository: std::path::PathBuf,
+) -> Result<Accounts> {
+    let credentials: BTreeMap<String, Credential> =
+        match tokio::fs::read(data.join("users.json")).await {
+            Ok(bytes) => serde_json::from_slice(&bytes)?,
+            Err(error) if error.kind() == std::io::ErrorKind::NotFound => BTreeMap::new(),
+            Err(error) => return Err(error.into()),
+        };
+    let grants = match tokio::fs::read(config).await {
+        Ok(bytes) => serde_json::from_slice(&bytes)?,
+        Err(error) if error.kind() == std::io::ErrorKind::NotFound => ssh::Config {
+            repository,
+            publishers: BTreeMap::new(),
+        },
+        Err(error) => return Err(error.into()),
+    };
+    let mut accounts = Accounts {
+        credentials,
+        grants,
+        sessions: BTreeMap::new(),
+        attempts: VecDeque::new(),
+        changes: VecDeque::new(),
+    };
+    if accounts.credentials.is_empty() {
+        let name = std::env::var("ADMIN_USERNAME").unwrap_or_else(|_| "admin".into());
+        username(&name)?;
+        let hash =
+            std::env::var("ADMIN_PASSWORD_HASH").context("首次启动必须设置 ADMIN_PASSWORD_HASH")?;
+        let parsed = PasswordHash::new(&hash).map_err(|_| anyhow::anyhow!("管理员哈希格式无效"))?;
+        ensure!(
+            parsed.algorithm.as_str() == "argon2id",
+            "管理员哈希必须为 Argon2id"
+        );
+        accounts
+            .credentials
+            .insert(name.clone(), Credential { hash });
+        accounts.grants.publishers.insert(
+            name,
+            Grant {
+                enabled: true,
+                role: Role::Admin,
+                prefixes: vec![],
+                ssh_key: None,
+            },
+        );
+        atomic(config, &serde_json::to_vec_pretty(&accounts.grants)?, 0o644).await?;
+        atomic(
+            &data.join("users.json"),
+            &serde_json::to_vec(&accounts.credentials)?,
+            0o600,
+        )
+        .await?;
+    }
+    ensure!(
+        accounts
+            .grants
+            .publishers
+            .iter()
+            .any(|(name, g)| g.role == Role::Admin
+                && g.enabled
+                && accounts.credentials.contains_key(name)),
+        "至少需要一个启用的管理员"
+    );
+    Ok(accounts)
+}
+fn rate(accounts: &mut Accounts) -> ApiResult<()> {
+    let now = Instant::now();
+    while accounts
+        .attempts
+        .front()
+        .is_some_and(|t| now.duration_since(*t) >= Duration::from_secs(60))
+    {
+        accounts.attempts.pop_front();
+    }
+    // One global bucket also bounds attacks distributed across IPs and account names.
+    if accounts.attempts.len() >= 10 {
+        return Err(ApiError(
+            StatusCode::TOO_MANY_REQUESTS,
+            "认证请求过于频繁，请稍后再试".into(),
+        ));
+    }
+    accounts.attempts.push_back(now);
+    Ok(())
+}
+fn token() -> String {
+    let mut bytes = [0; 32];
+    rand::thread_rng().fill_bytes(&mut bytes);
+    URL_SAFE_NO_PAD.encode(bytes)
+}
+pub async fn authorize(
+    app: &App,
+    headers: &HeaderMap,
+    change: bool,
+    admin: bool,
+) -> ApiResult<String> {
+    let cookie = headers
+        .get(header::COOKIE)
+        .and_then(|v| v.to_str().ok())
+        .unwrap_or("")
+        .split(';')
+        .filter_map(|p| p.trim().split_once('='))
+        .find(|(name, _)| *name == "chublog_session")
+        .map(|(_, v)| v)
+        .unwrap_or("");
+    let mut accounts = app.accounts.lock().await;
+    let session = accounts
+        .sessions
+        .get(cookie)
+        .filter(|s| s.expires > Instant::now())
+        .ok_or_else(|| ApiError(StatusCode::UNAUTHORIZED, "请先登录".into()))?;
+    let grant = accounts
+        .grants
+        .publishers
+        .get(&session.username)
+        .filter(|g| g.enabled)
+        .ok_or_else(|| ApiError(StatusCode::FORBIDDEN, "用户已停用".into()))?;
+    if admin && grant.role != Role::Admin {
+        return Err(ApiError(StatusCode::FORBIDDEN, "需要管理员权限".into()));
+    }
+    if change {
+        origin(app, headers)?;
+        if headers.get("x-csrf-token").and_then(|v| v.to_str().ok()) != Some(session.csrf.as_str())
+        {
+            return Err(ApiError(StatusCode::FORBIDDEN, "CSRF 校验失败".into()));
+        }
+    }
+    let username = session.username.clone();
+    if change {
+        let now = Instant::now();
+        while accounts
+            .changes
+            .front()
+            .is_some_and(|t| now.duration_since(*t) >= Duration::from_secs(60))
+        {
+            accounts.changes.pop_front();
+        }
+        if accounts.changes.len() >= 60 {
+            return Err(ApiError(
+                StatusCode::TOO_MANY_REQUESTS,
+                "修改请求过于频繁".into(),
+            ));
+        }
+        accounts.changes.push_back(now);
+    }
+    Ok(username)
+}
+#[derive(Deserialize)]
+#[serde(deny_unknown_fields)]
+pub struct Login {
+    username: String,
+    password: String,
+}
+pub async fn register(
+    State(app): State<Arc<App>>,
+    headers: HeaderMap,
+    Json(input): Json<Login>,
+) -> ApiResult<Json<Value>> {
+    origin(&app, &headers)?;
+    if !app.registration {
+        return Err(ApiError(StatusCode::FORBIDDEN, "注册已关闭".into()));
+    }
+    username(&input.username).map_err(bad)?;
+    password(&input.password).map_err(bad)?;
+    {
+        let mut accounts = app.accounts.lock().await;
+        rate(&mut accounts)?;
+        if accounts.credentials.len() >= 1000 {
+            return Err(bad("用户配额已满"));
+        }
+    }
+    let _permit = app
+        .hash_slots
+        .clone()
+        .try_acquire_owned()
+        .map_err(|_| ApiError(StatusCode::TOO_MANY_REQUESTS, "认证服务繁忙".into()))?;
+    let hash = hash_password(input.password).await.map_err(internal)?;
+    let mut accounts = app.accounts.lock().await;
+    if accounts.credentials.contains_key(&input.username) {
+        return Err(ApiError(StatusCode::CONFLICT, "用户名不可用".into()));
+    }
+    if accounts.credentials.len() >= 1000 {
+        return Err(bad("用户配额已满"));
+    }
+    let mut grants = accounts.grants.clone();
+    grants.publishers.insert(
+        input.username.clone(),
+        Grant {
+            enabled: true,
+            role: Role::Reader,
+            prefixes: vec![],
+            ssh_key: None,
+        },
+    );
+    atomic(
+        &app.ssh_config,
+        &serde_json::to_vec_pretty(&grants).map_err(internal)?,
+        0o644,
+    )
+    .await
+    .map_err(internal)?;
+    accounts.grants = grants;
+    accounts
+        .credentials
+        .insert(input.username.clone(), Credential { hash });
+    if let Err(error) = atomic(
+        &app.data.join("users.json"),
+        &serde_json::to_vec(&accounts.credentials).map_err(internal)?,
+        0o600,
+    )
+    .await
+    {
+        accounts.credentials.remove(&input.username);
+        return Err(internal(error));
+    }
+    tracing::info!(action = "register", user = %input.username);
+    Ok(Json(json!({"username": input.username, "role": "reader"})))
+}
+pub async fn login(
+    State(app): State<Arc<App>>,
+    headers: HeaderMap,
+    Json(input): Json<Login>,
+) -> ApiResult<Response> {
+    origin(&app, &headers)?;
+    username(&input.username).map_err(bad)?;
+    password(&input.password).map_err(bad)?;
+    let hash = {
+        let mut accounts = app.accounts.lock().await;
+        rate(&mut accounts)?;
+        accounts
+            .credentials
+            .get(&input.username)
+            .or_else(|| accounts.credentials.values().next())
+            .map(|c| c.hash.clone())
+            .ok_or_else(|| internal("无管理员"))?
+    };
+    let _permit = app
+        .hash_slots
+        .clone()
+        .try_acquire_owned()
+        .map_err(|_| ApiError(StatusCode::TOO_MANY_REQUESTS, "认证服务繁忙".into()))?;
+    let verified = tokio::task::spawn_blocking(move || {
+        PasswordHash::new(&hash).ok().is_some_and(|h| {
+            Argon2::default()
+                .verify_password(input.password.as_bytes(), &h)
+                .is_ok()
+        })
+    })
+    .await
+    .map_err(internal)?;
+    let mut accounts = app.accounts.lock().await;
+    if !verified
+        || !accounts.credentials.contains_key(&input.username)
+        || !accounts
+            .grants
+            .publishers
+            .get(&input.username)
+            .is_some_and(|g| g.enabled)
+    {
+        tracing::warn!(action = "login_failed", user = %input.username);
+        return Err(ApiError(StatusCode::UNAUTHORIZED, "登录失败".into()));
+    }
+    let now = Instant::now();
+    accounts
+        .sessions
+        .retain(|_, s| s.expires > now && s.username != input.username);
+    if accounts.sessions.len() >= 1000 {
+        return Err(bad("会话配额已满"));
+    }
+    let id = token();
+    let csrf = token();
+    accounts.sessions.insert(
+        id.clone(),
+        Session {
+            username: input.username.clone(),
+            csrf: csrf.clone(),
+            expires: now + Duration::from_secs(3600),
+        },
+    );
+    let cookie = format!(
+        "chublog_session={id}; Path=/; HttpOnly; SameSite=Strict; Max-Age=3600{}",
+        if app.secure { "; Secure" } else { "" }
+    );
+    let mut response = Json(json!({"csrf": csrf, "username": input.username, "role": accounts.grants.publishers[&input.username].role})).into_response();
+    response.headers_mut().insert(
+        header::SET_COOKIE,
+        HeaderValue::from_str(&cookie).map_err(internal)?,
+    );
+    tracing::info!(action = "login", user = %input.username);
+    Ok(response)
+}
+pub async fn me(State(app): State<Arc<App>>, headers: HeaderMap) -> ApiResult<Json<Value>> {
+    let name = authorize(&app, &headers, false, false).await?;
+    let accounts = app.accounts.lock().await;
+    let csrf = accounts
+        .sessions
+        .values()
+        .find(|s| s.username == name)
+        .map(|s| &s.csrf);
+    Ok(Json(
+        json!({"username": name, "permissions": accounts.grants.publishers[&name], "csrf": csrf}),
+    ))
+}
+pub async fn logout(State(app): State<Arc<App>>, headers: HeaderMap) -> ApiResult<Response> {
+    let name = authorize(&app, &headers, true, false).await?;
+    app.accounts
+        .lock()
+        .await
+        .sessions
+        .retain(|_, s| s.username != name);
+    let mut response = StatusCode::NO_CONTENT.into_response();
+    response.headers_mut().insert(
+        header::SET_COOKIE,
+        HeaderValue::from_str(&format!(
+            "chublog_session=; Path=/; HttpOnly; SameSite=Strict; Max-Age=0{}",
+            if app.secure { "; Secure" } else { "" }
+        ))
+        .map_err(internal)?,
+    );
+    Ok(response)
+}
+pub fn public_key(value: &str) -> Result<String> {
+    ensure!(
+        value.len() <= 4096 && !value.contains(['\n', '\r']),
+        "公钥格式无效"
+    );
+    let key = ssh_key::PublicKey::from_openssh(value)
+        .context("SSH 公钥格式无效，禁止 authorized_keys 选项")?;
+    match key.key_data() {
+        ssh_key::public::KeyData::Ed25519(_) => {}
+        ssh_key::public::KeyData::Rsa(rsa) => {
+            let modulus = rsa.n.as_positive_bytes().context("RSA 模数必须为正数")?;
+            let first = modulus.first().context("RSA 模数为空")?;
+            let bits = modulus.len() * 8 - first.leading_zeros() as usize;
+            ensure!(
+                (2048..=8192).contains(&bits) && modulus.last().is_some_and(|b| b & 1 == 1),
+                "RSA 模数必须为 2048–8192 位正奇数"
+            );
+            let exponent = rsa.e.as_positive_bytes().context("RSA 指数必须为正数")?;
+            ensure!(exponent.len() <= 4, "RSA 指数过大");
+            let exponent = exponent.iter().fold(0_u32, |n, b| (n << 8) | u32::from(*b));
+            ensure!(
+                exponent >= 3 && exponent % 2 == 1,
+                "RSA 指数必须为至少 3 的奇数"
+            );
+        }
+        _ => anyhow::bail!("仅支持 Ed25519 或 RSA 公钥"),
+    }
+    // Drop comments and options: the stored value is exactly the parsed public key.
+    Ok(format!(
+        "{} {}",
+        key.algorithm().as_str(),
+        key.to_bytes()
+            .map(|bytes| base64::engine::general_purpose::STANDARD.encode(bytes))?
+    ))
+}
+#[derive(Deserialize)]
+#[serde(deny_unknown_fields)]
+pub struct KeyInput {
+    public_key: String,
+}
+pub async fn set_key(
+    State(app): State<Arc<App>>,
+    headers: HeaderMap,
+    Json(input): Json<KeyInput>,
+) -> ApiResult<Json<Value>> {
+    let name = authorize(&app, &headers, true, false).await?;
+    let key = public_key(&input.public_key).map_err(bad)?;
+    let mut accounts = app.accounts.lock().await;
+    if accounts
+        .grants
+        .publishers
+        .iter()
+        .any(|(user, grant)| user != &name && grant.ssh_key.as_deref() == Some(&key))
+    {
+        return Err(bad("公钥已被其他用户绑定"));
+    }
+    let mut grants = accounts.grants.clone();
+    grants
+        .publishers
+        .get_mut(&name)
+        .ok_or_else(|| bad("用户不存在"))?
+        .ssh_key = Some(key);
+    atomic(
+        &app.ssh_config,
+        &serde_json::to_vec_pretty(&grants).map_err(internal)?,
+        0o644,
+    )
+    .await
+    .map_err(internal)?;
+    accounts.grants = grants;
+    tracing::info!(action = "ssh_key_changed", user = %name);
+    Ok(Json(
+        json!({"status": "saved", "message": "密钥已保存，发布仍需管理员授权"}),
+    ))
+}
+pub async fn users(State(app): State<Arc<App>>, headers: HeaderMap) -> ApiResult<Json<Value>> {
+    authorize(&app, &headers, false, true).await?;
+    Ok(Json(json!(app.accounts.lock().await.grants.publishers)))
+}
+#[derive(Deserialize)]
+#[serde(deny_unknown_fields)]
+pub struct GrantInput {
+    enabled: bool,
+    role: Role,
+    prefixes: Vec<String>,
+}
+pub async fn grant(
+    State(app): State<Arc<App>>,
+    headers: HeaderMap,
+    Path(name): Path<String>,
+    Json(input): Json<GrantInput>,
+) -> ApiResult<Json<Value>> {
+    let actor = authorize(&app, &headers, true, true).await?;
+    ensure_prefixes(&input.prefixes).map_err(bad)?;
+    if input.role == Role::Publisher && input.prefixes.is_empty() {
+        return Err(bad("发布者必须分配文章前缀"));
+    }
+    let mut accounts = app.accounts.lock().await;
+    if !accounts
+        .grants
+        .publishers
+        .get(&actor)
+        .is_some_and(|g| g.enabled && g.role == Role::Admin)
+    {
+        return Err(ApiError(StatusCode::FORBIDDEN, "管理员权限已失效".into()));
+    }
+    if !accounts.credentials.contains_key(&name) {
+        return Err(ApiError(StatusCode::NOT_FOUND, "用户不存在".into()));
+    }
+    if actor == name && (input.role != Role::Admin || !input.enabled) {
+        return Err(bad("不能取消自己的管理权限或停用自己"));
+    }
+    for (other, grant) in &accounts.grants.publishers {
+        if other == &name || !grant.enabled || grant.role == Role::Reader {
+            continue;
+        }
+        if input.enabled
+            && input.role != Role::Reader
+            && input.prefixes.iter().any(|a| {
+                grant
+                    .prefixes
+                    .iter()
+                    .any(|b| a.starts_with(b) || b.starts_with(a))
+            })
+        {
+            return Err(bad("发布前缀与其他用户重叠"));
+        }
+    }
+    let mut grants = accounts.grants.clone();
+    let entry = grants
+        .publishers
+        .get_mut(&name)
+        .ok_or_else(|| bad("用户授权缺失"))?;
+    entry.enabled = input.enabled;
+    entry.role = input.role;
+    entry.prefixes = if input.role == Role::Reader {
+        vec![]
+    } else {
+        input.prefixes
+    };
+    atomic(
+        &app.ssh_config,
+        &serde_json::to_vec_pretty(&grants).map_err(internal)?,
+        0o644,
+    )
+    .await
+    .map_err(internal)?;
+    accounts.grants = grants;
+    accounts
+        .sessions
+        .retain(|_, s| s.username != name || s.username == actor);
+    tracing::info!(action = "permission_changed", user = %name, administrator = %actor);
+    Ok(Json(json!({"status": "saved"})))
+}
+fn ensure_prefixes(prefixes: &[String]) -> Result<()> {
+    ensure!(
+        prefixes.len() <= 8
+            && prefixes.iter().all(|p| (2..=64).contains(&p.len())
+                && p.ends_with('-')
+                && p.bytes()
+                    .all(|b| b.is_ascii_lowercase() || b.is_ascii_digit() || b == b'-')),
+        "前缀必须为 2–64 位小写英文、数字、短横线且以短横线结尾，最多 8 个"
+    );
+    Ok(())
+}
+
+#[derive(Deserialize)]
+#[serde(deny_unknown_fields)]
+pub struct PasswordInput {
+    old_password: String,
+    new_password: String,
+}
+pub async fn change_password(
+    State(app): State<Arc<App>>,
+    headers: HeaderMap,
+    Json(input): Json<PasswordInput>,
+) -> ApiResult<Json<Value>> {
+    let name = authorize(&app, &headers, true, false).await?;
+    password(&input.old_password).map_err(bad)?;
+    password(&input.new_password).map_err(bad)?;
+    let _permit = app
+        .hash_slots
+        .clone()
+        .try_acquire_owned()
+        .map_err(|_| ApiError(StatusCode::TOO_MANY_REQUESTS, "认证服务繁忙".into()))?;
+    let previous = app
+        .accounts
+        .lock()
+        .await
+        .credentials
+        .get(&name)
+        .ok_or_else(|| bad("用户不存在"))?
+        .hash
+        .clone();
+    let hash = previous.clone();
+    let verified = tokio::task::spawn_blocking(move || {
+        PasswordHash::new(&hash).ok().is_some_and(|h| {
+            Argon2::default()
+                .verify_password(input.old_password.as_bytes(), &h)
+                .is_ok()
+        })
+    })
+    .await
+    .map_err(internal)?;
+    if !verified {
+        return Err(ApiError(StatusCode::UNAUTHORIZED, "旧口令错误".into()));
+    }
+    let hash = hash_password(input.new_password).await.map_err(internal)?;
+    let mut accounts = app.accounts.lock().await;
+    if !accounts
+        .grants
+        .publishers
+        .get(&name)
+        .is_some_and(|g| g.enabled)
+    {
+        return Err(ApiError(StatusCode::FORBIDDEN, "用户已停用".into()));
+    }
+    let credential = accounts
+        .credentials
+        .get_mut(&name)
+        .ok_or_else(|| bad("用户不存在"))?;
+    if credential.hash != previous {
+        return Err(ApiError(
+            StatusCode::CONFLICT,
+            "口令已变更，请重新登录".into(),
+        ));
+    }
+    credential.hash = hash;
+    if let Err(error) = atomic(
+        &app.data.join("users.json"),
+        &serde_json::to_vec(&accounts.credentials).map_err(internal)?,
+        0o600,
+    )
+    .await
+    {
+        accounts.credentials.get_mut(&name).unwrap().hash = previous;
+        return Err(internal(error));
+    }
+    accounts.sessions.retain(|_, s| s.username != name);
+    tracing::info!(action = "password_changed", user = %name);
+    Ok(Json(
+        json!({"status": "saved", "message": "请使用新口令重新登录"}),
+    ))
+}

apps/api/src/content.rs

@@ -0,0 +1,374 @@
+use anyhow::{Context, Result, ensure};
+use base64::{Engine, engine::general_purpose::STANDARD};
+use chrono::NaiveDate;
+use serde::{Deserialize, Serialize};
+use std::{
+    collections::BTreeMap,
+    path::{Path, PathBuf},
+    process::Stdio,
+    time::Duration,
+};
+use tokio::{
+    io::{AsyncReadExt, AsyncWriteExt},
+    process::Command,
+};
+
+pub const MAX_MARKDOWN: usize = 256 * 1024;
+pub const MAX_SNAPSHOT: usize = 64 * 1024 * 1024;
+
+#[derive(Clone, Debug, Deserialize, Serialize, PartialEq, Eq)]
+#[serde(rename_all = "lowercase")]
+pub enum Status {
+    Draft,
+    Published,
+}
+
+#[derive(Clone, Debug, Deserialize, Serialize)]
+#[serde(deny_unknown_fields)]
+pub struct Metadata {
+    pub title: String,
+    pub slug: String,
+    pub date: String,
+    pub updated: String,
+    pub status: Status,
+    pub tags: Vec<String>,
+    pub description: String,
+}
+
+#[derive(Clone, Debug, Deserialize, Serialize)]
+#[serde(deny_unknown_fields)]
+pub struct Asset {
+    pub name: String,
+    pub data: String,
+}
+
+#[derive(Clone, Debug, Deserialize, Serialize)]
+pub struct Post {
+    pub meta: Metadata,
+    pub markdown: String,
+    pub assets: Vec<Asset>,
+}
+
+#[derive(Clone, Default, Deserialize, Serialize)]
+pub struct Snapshot {
+    pub commit: String,
+    pub posts: BTreeMap<String, Post>,
+}
+
+pub fn slug(value: &str) -> Result<&str> {
+    ensure!(
+        (1..=80).contains(&value.len())
+            && value
+                .bytes()
+                .all(|c| c.is_ascii_lowercase() || c.is_ascii_digit() || c == b'-')
+            && !value.starts_with('-')
+            && !value.ends_with('-'),
+        "slug 仅允许 1–80 位小写英文、数字和中间短横线"
+    );
+    ensure!(
+        ![
+            "admin", "api", "posts", "tags", "archive", "rss", "sitemap", "404"
+        ]
+        .contains(&value),
+        "slug 为保留名称"
+    );
+    Ok(value)
+}
+
+pub fn parse(markdown: String, assets: Vec<Asset>) -> Result<Post> {
+    ensure!(markdown.len() <= MAX_MARKDOWN, "Markdown 超过 256 KiB");
+    let normalized = markdown.replace("\r\n", "\n");
+    let rest = normalized
+        .strip_prefix("---\n")
+        .context("缺少 YAML Frontmatter")?;
+    let (yaml, _) = rest.split_once("\n---\n").context("Frontmatter 未闭合")?;
+    let meta: Metadata = serde_yaml::from_str(yaml).context("Frontmatter 无效")?;
+    slug(&meta.slug)?;
+    ensure!(
+        !meta.title.trim().is_empty() && meta.title.len() <= 240 && meta.description.len() <= 1000,
+        "标题或摘要长度无效"
+    );
+    for date in [&meta.date, &meta.updated] {
+        let parsed =
+            NaiveDate::parse_from_str(date, "%Y-%m-%d").context("日期必须为 YYYY-MM-DD")?;
+        ensure!(
+            parsed.format("%Y-%m-%d").to_string() == *date,
+            "日期格式不规范"
+        );
+    }
+    ensure!(meta.updated >= meta.date, "更新时间不能早于发布日期");
+    ensure!(
+        meta.tags.len() <= 12
+            && meta
+                .tags
+                .iter()
+                .all(|t| !t.trim().is_empty() && t.len() <= 80),
+        "标签无效"
+    );
+    ensure!(assets.len() <= 12, "最多 12 张图片");
+    let mut names = std::collections::HashSet::new();
+    let mut total = normalized.len();
+    for asset in &assets {
+        ensure!(names.insert(&asset.name), "图片名称重复");
+        let bytes = decode_asset(asset)?;
+        total += bytes.len();
+    }
+    ensure!(total <= 6 * 1024 * 1024, "文章及图片总计不得超过 6 MiB");
+    validate_markdown(rest.split_once("\n---\n").unwrap().1, &assets)?;
+    Ok(Post {
+        meta,
+        markdown: normalized,
+        assets,
+    })
+}
+
+pub fn decode_asset(asset: &Asset) -> Result<Vec<u8>> {
+    let name = &asset.name;
+    ensure!(
+        name.len() <= 100
+            && !name.starts_with('.')
+            && !name.contains("..")
+            && name
+                .bytes()
+                .all(|b| b.is_ascii_alphanumeric() || b"-_.".contains(&b))
+            && name != "index.md",
+        "图片文件名无效"
+    );
+    ensure!(asset.data.len() <= 3 * 1024 * 1024, "图片超过大小限制");
+    let bytes = STANDARD.decode(&asset.data).context("图片编码无效")?;
+    ensure!(bytes.len() <= 2 * 1024 * 1024, "单张图片不得超过 2 MiB");
+    let format = image::guess_format(&bytes).context("无法识别图片")?;
+    let extension = name.rsplit('.').next().unwrap_or("").to_ascii_lowercase();
+    ensure!(
+        matches!(
+            (format, extension.as_str()),
+            (image::ImageFormat::Png, "png")
+                | (image::ImageFormat::Jpeg, "jpg" | "jpeg")
+                | (image::ImageFormat::WebP, "webp")
+        ),
+        "仅支持与扩展名一致的 PNG/JPEG/WebP"
+    );
+    let reader = image::ImageReader::with_format(std::io::Cursor::new(&bytes), format);
+    let (width, height) = reader.into_dimensions().context("图片头无效")?;
+    ensure!(
+        width > 0 && height > 0 && width <= 4096 && height <= 4096,
+        "图片尺寸不得超过 4096×4096"
+    );
+    image::load_from_memory_with_format(&bytes, format).context("图片内容损坏")?;
+    Ok(bytes)
+}
+
+pub async fn git(repo: &Path, args: &[&str], input: Option<&[u8]>) -> Result<Vec<u8>> {
+    let mut command = Command::new("git");
+    command
+        .arg("--no-pager")
+        .arg("-c")
+        .arg("core.hooksPath=/dev/null")
+        .arg("-c")
+        .arg("commit.gpgsign=false")
+        .arg("-C")
+        .arg(repo)
+        .args(args)
+        .env("GIT_CONFIG_NOSYSTEM", "1")
+        .env("GIT_CONFIG_GLOBAL", "/etc/chublog/gitconfig")
+        .env("GIT_AUTHOR_NAME", "ChuBlog")
+        .env("GIT_AUTHOR_EMAIL", "blog@localhost")
+        .env("GIT_COMMITTER_NAME", "ChuBlog")
+        .env("GIT_COMMITTER_EMAIL", "blog@localhost")
+        .env("GIT_INDEX_FILE", repo.join("publish.index"))
+        .stdin(Stdio::piped())
+        .stdout(Stdio::piped())
+        .stderr(Stdio::piped())
+        .kill_on_drop(true);
+    let output = tokio::time::timeout(Duration::from_secs(15), async {
+        let mut child = command.spawn().context("启动 Git 失败")?;
+        let mut stdin = child.stdin.take().context("Git stdin")?;
+        let stdout = child.stdout.take().context("Git stdout")?;
+        let stderr = child.stderr.take().context("Git stderr")?;
+        let write = async {
+            stdin.write_all(input.unwrap_or_default()).await?;
+            drop(stdin);
+            Ok::<_, std::io::Error>(())
+        };
+        let read_out = async {
+            let mut out = Vec::new();
+            stdout
+                .take(4 * 1024 * 1024 + 1)
+                .read_to_end(&mut out)
+                .await?;
+            Ok::<_, std::io::Error>(out)
+        };
+        let read_err = async {
+            let mut err = Vec::new();
+            stderr.take(65537).read_to_end(&mut err).await?;
+            Ok::<_, std::io::Error>(err)
+        };
+        let (_, stdout, stderr) = tokio::try_join!(write, read_out, read_err)?;
+        ensure!(
+            stdout.len() <= 4 * 1024 * 1024 && stderr.len() <= 65536,
+            "Git 输出超过限制"
+        );
+        let status = child.wait().await?;
+        Ok::<_, anyhow::Error>(std::process::Output {
+            status,
+            stdout,
+            stderr,
+        })
+    })
+    .await
+    .context("Git 操作超时")??;
+    ensure!(
+        output.status.success(),
+        "Git 操作失败: {}",
+        String::from_utf8_lossy(&output.stderr)
+    );
+    Ok(output.stdout)
+}
+
+pub async fn init(data: &Path) -> Result<PathBuf> {
+    tokio::fs::create_dir_all(data).await?;
+    let repo = data.join("content.git");
+    if !repo.exists() {
+        tokio::fs::create_dir(&repo).await?;
+        git(
+            &repo,
+            &["init", "--bare", "--initial-branch=main", "."],
+            None,
+        )
+        .await?;
+        git(&repo, &["read-tree", "--empty"], None).await?;
+        let tree = git(&repo, &["write-tree"], None).await?;
+        let tree = String::from_utf8(tree)?;
+        let commit = git(
+            &repo,
+            &[
+                "commit-tree",
+                tree.trim(),
+                "-m",
+                "Initialize content repository",
+            ],
+            None,
+        )
+        .await?;
+        let commit = String::from_utf8(commit)?;
+        git(
+            &repo,
+            &["update-ref", "refs/heads/main", commit.trim()],
+            None,
+        )
+        .await?;
+    }
+    Ok(repo)
+}
+
+pub async fn scan(repo: &Path) -> Result<Snapshot> {
+    let commit = String::from_utf8(git(repo, &["rev-parse", "refs/heads/main"], None).await?)?
+        .trim()
+        .to_owned();
+    scan_at(repo, &commit).await
+}
+
+pub async fn scan_at(repo: &Path, commit: &str) -> Result<Snapshot> {
+    let commit = commit.to_owned();
+    let entries = git(repo, &["ls-tree", "-rz", &commit], None).await?;
+    let mut grouped: BTreeMap<String, (Option<String>, Vec<Asset>)> = BTreeMap::new();
+    let mut total = 0;
+    for entry in entries.split(|b| *b == 0).filter(|e| !e.is_empty()) {
+        let entry = std::str::from_utf8(entry)?;
+        let (info, path) = entry.split_once('\t').context("Git 树格式错误")?;
+        let info: Vec<_> = info.split_whitespace().collect();
+        ensure!(
+            info.len() == 3 && info[0] == "100644" && info[1] == "blob",
+            "禁止符号链接及特殊文件"
+        );
+        let parts: Vec<_> = path.split('/').collect();
+        ensure!(
+            parts.len() == 3 && parts[0] == "posts",
+            "仓库包含非文章路径"
+        );
+        slug(parts[1])?;
+        let size = String::from_utf8(git(repo, &["cat-file", "-s", info[2]], None).await?)?
+            .trim()
+            .parse::<usize>()?;
+        let limit = if parts[2] == "index.md" {
+            MAX_MARKDOWN
+        } else {
+            2 * 1024 * 1024
+        };
+        ensure!(size <= limit, "文件超过大小限制");
+        let bytes = git(repo, &["cat-file", "blob", info[2]], None).await?;
+        total += bytes.len();
+        ensure!(total <= MAX_SNAPSHOT, "内容仓库超过 64 MiB 配额");
+        let group = grouped.entry(parts[1].into()).or_default();
+        if parts[2] == "index.md" {
+            group.0 = Some(String::from_utf8(bytes)?);
+        } else {
+            group.1.push(Asset {
+                name: parts[2].into(),
+                data: STANDARD.encode(bytes),
+            });
+        }
+        ensure!(grouped.len() <= 1000, "最多 1000 篇文章");
+    }
+    let mut posts = BTreeMap::new();
+    for (key, (markdown, assets)) in grouped {
+        let post = parse(markdown.context("文章缺少 index.md")?, assets)?;
+        ensure!(post.meta.slug == key, "slug 与 Git 路径不一致");
+        posts.insert(key, post);
+    }
+    Ok(Snapshot { commit, posts })
+}
+
+pub async fn persist(data: &Path, snapshot: &Snapshot) -> Result<()> {
+    let public = Snapshot {
+        commit: snapshot.commit.clone(),
+        posts: snapshot
+            .posts
+            .iter()
+            .filter(|(_, p)| p.meta.status == Status::Published)
+            .map(|(k, p)| (k.clone(), p.clone()))
+            .collect(),
+    };
+    let bytes = serde_json::to_vec(&public)?;
+    let tmp = data.join("published.json.tmp");
+    let mut file = tokio::fs::File::create(&tmp).await?;
+    file.write_all(&bytes).await?;
+    file.sync_all().await?;
+    tokio::fs::rename(tmp, data.join("published.json")).await?;
+    Ok(())
+}
+
+pub fn validate_markdown(body: &str, assets: &[Asset]) -> Result<()> {
+    use pulldown_cmark::{Event, Parser, Tag};
+    ensure!(
+        !body.chars().any(|c| c == '\0'
+            || (c.is_control() && !"\n\r\t".contains(c))
+            || matches!(c, '\u{202a}'..='\u{202e}' | '\u{2066}'..='\u{2069}')),
+        "禁止控制符及双向隐藏字符"
+    );
+    for event in Parser::new_ext(body, pulldown_cmark::Options::all()) {
+        match event {
+            Event::Html(_) | Event::InlineHtml(_) => anyhow::bail!("Markdown 不允许原始 HTML"),
+            Event::Start(Tag::Link { dest_url, .. }) => {
+                ensure!(
+                    dest_url.starts_with("https://")
+                        || dest_url.starts_with("http://")
+                        || dest_url.starts_with("mailto:")
+                        || dest_url.starts_with('#')
+                        || (dest_url.starts_with('/') && !dest_url.starts_with("//")),
+                    "链接协议不允许"
+                );
+                ensure!(
+                    !dest_url.contains('\\') && !dest_url.chars().any(char::is_control),
+                    "链接含非法字符"
+                );
+            }
+            Event::Start(Tag::Image { dest_url, .. }) => ensure!(
+                assets.iter().any(|a| a.name == dest_url.as_ref()),
+                "图片必须引用同文章已验证的图片文件"
+            ),
+            _ => {}
+        }
+    }
+    Ok(())
+}

apps/api/src/index.rs

@@ -0,0 +1,145 @@
+use crate::content::{Snapshot, Status};
+use anyhow::{Context, Result, ensure};
+use chusql_driver::{Client, Options, Query};
+use std::time::Duration;
+
+async fn connect() -> Result<Client> {
+    let database = std::env::var("CHUSQL_DATABASE").context("未配置 ChuSQL")?;
+    ensure!(
+        !database.is_empty()
+            && !database.starts_with(|c: char| c.is_ascii_digit())
+            && database
+                .bytes()
+                .all(|b| b.is_ascii_alphanumeric() || b == b'_'),
+        "数据库名称无效"
+    );
+    let db = Client::connect_with_options(
+        std::env::var("CHUSQL_ADDRESS").unwrap_or_else(|_| "127.0.0.1:7777".into()),
+        &std::env::var("CHUSQL_USER")?,
+        &std::env::var("CHUSQL_PASSWORD")?,
+        Options {
+            timeout: Duration::from_secs(3),
+            max_response_bytes: 1024 * 1024,
+        },
+    )
+    .await?;
+    db.query(&format!("USE {database}")).await?;
+    Ok(db)
+}
+
+pub async fn rebuild(snapshot: &Snapshot) -> Result<()> {
+    let db = connect().await?;
+    // Probe before creating: ChuSQL does not promise IF NOT EXISTS syntax.
+    if db
+        .query("SELECT slug FROM blog_posts LIMIT 1")
+        .await
+        .is_err()
+    {
+        db.query("CREATE TABLE blog_posts (slug TEXT PRIMARY KEY, title TEXT, description TEXT, published_at TEXT, updated_at TEXT, path TEXT, git_commit TEXT)").await?;
+    }
+    if db
+        .query("SELECT slug FROM blog_tags LIMIT 1")
+        .await
+        .is_err()
+    {
+        db.query("CREATE TABLE blog_tags (slug TEXT, tag TEXT, git_commit TEXT)")
+            .await?;
+    }
+    db.query("DELETE FROM blog_tags").await?;
+    db.query("DELETE FROM blog_posts").await?;
+    for post in snapshot
+        .posts
+        .values()
+        .filter(|p| p.meta.status == Status::Published)
+    {
+        let meta = &post.meta;
+        let q = Query::new("INSERT INTO blog_posts (slug, title, description, published_at, updated_at, path, git_commit) VALUES (")
+            .bind(meta.slug.as_str()).push(", ").bind(meta.title.as_str()).push(", ")
+            .bind(meta.description.as_str()).push(", ").bind(meta.date.as_str()).push(", ")
+            .bind(meta.updated.as_str()).push(", ").bind(format!("posts/{}/index.md", meta.slug).as_str())
+            .push(", ").bind(snapshot.commit.as_str()).push(")");
+        db.query(q.as_str()).await?;
+        for tag in &meta.tags {
+            let q = Query::new("INSERT INTO blog_tags (slug, tag, git_commit) VALUES (")
+                .bind(meta.slug.as_str())
+                .push(", ")
+                .bind(tag.as_str())
+                .push(", ")
+                .bind(snapshot.commit.as_str())
+                .push(")");
+            db.query(q.as_str()).await?;
+        }
+    }
+    db.close().await;
+    Ok(())
+}
+
+pub async fn provision() -> Result<()> {
+    let db = Client::connect(
+        std::env::var("CHUSQL_ADDRESS").unwrap_or_else(|_| "127.0.0.1:7777".into()),
+        "root",
+        &std::env::var("CHUSQL_ROOT_PASSWORD")?,
+    )
+    .await?;
+    if db.query("USE chublog").await.is_err() {
+        db.query("CREATE DATABASE chublog").await?;
+    }
+    let roles = db.query("SHOW ROLES").await?;
+    ensure!(!roles.truncated, "身份列表被截断，请人工检查数据库初始化");
+    if !roles
+        .rows
+        .iter()
+        .flatten()
+        .any(|v| v.as_str() == Some("chublog_index"))
+    {
+        let password = std::env::var("CHUSQL_PASSWORD")?;
+        ensure!(password.len() >= 16, "数据库口令至少 16 字节");
+        let q = Query::new("CREATE USER chublog_index IDENTIFIED BY ").bind(password.as_str());
+        db.query(q.as_str())
+            .await
+            .map_err(|_| anyhow::anyhow!("创建索引用户失败"))?;
+    }
+    db.query("REVOKE CONNECT ON DATABASE chublog FROM PUBLIC")
+        .await?;
+    db.query("GRANT CONNECT, CREATE ON DATABASE chublog TO chublog_index")
+        .await?;
+    db.close().await;
+    Ok(())
+}
+
+// Detect a lost/recreated index even if no new article was pushed.
+pub async fn consistent(snapshot: &Snapshot) -> Result<bool> {
+    let db = connect().await?;
+    let result = db
+        .query("SELECT slug, git_commit FROM blog_posts LIMIT 1000")
+        .await?;
+    let expected: std::collections::BTreeSet<_> = snapshot
+        .posts
+        .values()
+        .filter(|p| p.meta.status == Status::Published)
+        .map(|p| (p.meta.slug.as_str(), snapshot.commit.as_str()))
+        .collect();
+    let actual: std::collections::BTreeSet<_> = result
+        .rows
+        .iter()
+        .filter_map(|row| Some((row.first()?.as_str()?, row.get(1)?.as_str()?)))
+        .collect();
+    let count = db.query("SELECT count(*) FROM blog_tags").await?;
+    let tags = snapshot
+        .posts
+        .values()
+        .filter(|p| p.meta.status == Status::Published)
+        .map(|p| p.meta.tags.len())
+        .sum::<usize>() as u64;
+    let matches = !result.truncated
+        && result.rows.len() == expected.len()
+        && actual == expected
+        && count
+            .rows
+            .first()
+            .and_then(|row| row.first())
+            .and_then(|v| v.as_u64())
+            == Some(tags);
+    db.close().await;
+    Ok(matches)
+}

apps/api/src/main.rs

@@ -0,0 +1,330 @@
+mod accounts;
+mod content;
+mod index;
+mod ssh;
+
+use anyhow::{Context, Result, ensure};
+use axum::{
+    Json, Router,
+    body::Body,
+    extract::{DefaultBodyLimit, Path, State},
+    http::{HeaderMap, HeaderValue, StatusCode, header},
+    response::{IntoResponse, Response},
+    routing::{get, patch, post, put},
+};
+use base64::Engine;
+use content::{Snapshot, Status};
+use serde_json::{Value, json};
+use std::{
+    path::PathBuf,
+    sync::{
+        Arc,
+        atomic::{AtomicU64, Ordering},
+    },
+    time::Duration,
+};
+use tokio::sync::{Mutex, RwLock, Semaphore};
+use tracing::{info, warn};
+
+type ApiResult<T> = std::result::Result<T, ApiError>;
+struct ApiError(StatusCode, String);
+impl IntoResponse for ApiError {
+    fn into_response(self) -> Response {
+        (self.0, Json(json!({"error": self.1}))).into_response()
+    }
+}
+fn bad(error: impl std::fmt::Display) -> ApiError {
+    ApiError(StatusCode::BAD_REQUEST, error.to_string())
+}
+fn internal(error: impl std::fmt::Display) -> ApiError {
+    tracing::error!(error = %error, "operation failed");
+    ApiError(
+        StatusCode::INTERNAL_SERVER_ERROR,
+        "服务器操作失败，请联系管理员".into(),
+    )
+}
+struct App {
+    data: PathBuf,
+    ssh_config: PathBuf,
+    origin: String,
+    secure: bool,
+    registration: bool,
+    accounts: Mutex<accounts::Accounts>,
+    hash_slots: Arc<Semaphore>,
+    snapshot: RwLock<Snapshot>,
+    indexed: RwLock<Option<String>>,
+    views: AtomicU64,
+}
+fn origin(app: &App, headers: &HeaderMap) -> ApiResult<()> {
+    if headers.get("origin").and_then(|h| h.to_str().ok()) != Some(app.origin.as_str()) {
+        return Err(ApiError(StatusCode::FORBIDDEN, "Origin 校验失败".into()));
+    }
+    Ok(())
+}
+async fn posts(State(app): State<Arc<App>>) -> Json<Value> {
+    let snapshot = app.snapshot.read().await;
+    let mut posts: Vec<_> = snapshot
+        .posts
+        .values()
+        .filter(|p| p.meta.status == Status::Published)
+        .map(|p| &p.meta)
+        .collect();
+    posts.sort_by(|a, b| b.date.cmp(&a.date).then(a.slug.cmp(&b.slug)));
+    Json(json!({"commit": snapshot.commit, "posts": posts}))
+}
+async fn public_post(
+    State(app): State<Arc<App>>,
+    Path(key): Path<String>,
+) -> ApiResult<Json<Value>> {
+    let snapshot = app.snapshot.read().await;
+    let post = snapshot
+        .posts
+        .get(&key)
+        .filter(|p| p.meta.status == Status::Published)
+        .ok_or_else(|| ApiError(StatusCode::NOT_FOUND, "文章不存在".into()))?;
+    // Relaxed is sufficient: this independent counter does not synchronize other state.
+    app.views.fetch_add(1, Ordering::Relaxed);
+    Ok(Json(
+        json!({"meta": post.meta, "markdown": post.markdown, "assets": post.assets.iter().map(|a| json!({"name": a.name, "url": format!("/api/assets/{key}/{}", a.name)})).collect::<Vec<_>>()}),
+    ))
+}
+async fn asset(
+    State(app): State<Arc<App>>,
+    Path((key, name)): Path<(String, String)>,
+) -> ApiResult<Response> {
+    let snapshot = app.snapshot.read().await;
+    let asset = snapshot
+        .posts
+        .get(&key)
+        .filter(|p| p.meta.status == Status::Published)
+        .and_then(|p| p.assets.iter().find(|a| a.name == name))
+        .ok_or_else(|| ApiError(StatusCode::NOT_FOUND, "资源不存在".into()))?;
+    let bytes = base64::engine::general_purpose::STANDARD
+        .decode(&asset.data)
+        .map_err(internal)?;
+    let mime = match name
+        .rsplit('.')
+        .next()
+        .unwrap_or("")
+        .to_ascii_lowercase()
+        .as_str()
+    {
+        "png" => "image/png",
+        "jpg" | "jpeg" => "image/jpeg",
+        "webp" => "image/webp",
+        _ => return Err(internal("invalid stored image")),
+    };
+    Ok(([(header::CONTENT_TYPE, mime)], Body::from(bytes)).into_response())
+}
+async fn stats(State(app): State<Arc<App>>) -> Json<Value> {
+    let snapshot = app.snapshot.read().await;
+    let posts: Vec<_> = snapshot
+        .posts
+        .values()
+        .filter(|p| p.meta.status == Status::Published)
+        .collect();
+    let tags: std::collections::BTreeSet<_> = posts.iter().flat_map(|p| &p.meta.tags).collect();
+    Json(
+        json!({"published_posts": posts.len(), "tags": tags.len(), "markdown_bytes": posts.iter().map(|p| p.markdown.len()).sum::<usize>(), "article_requests_since_start": app.views.load(Ordering::Relaxed)}),
+    )
+}
+async fn admin_status(State(app): State<Arc<App>>, headers: HeaderMap) -> ApiResult<Json<Value>> {
+    accounts::authorize(&app, &headers, false, true).await?;
+    let snapshot = app.snapshot.read().await;
+    Ok(Json(
+        json!({"commit": snapshot.commit, "total_posts": snapshot.posts.len(), "drafts": snapshot.posts.values().filter(|p| p.meta.status == Status::Draft).count(), "indexed_commit": *app.indexed.read().await}),
+    ))
+}
+async fn sync_index(app: &App, snapshot: &Snapshot) {
+    match tokio::time::timeout(Duration::from_secs(30), index::rebuild(snapshot)).await {
+        Ok(Ok(())) => {
+            *app.indexed.write().await = Some(snapshot.commit.clone());
+            info!(action = "index_synced", commit = %snapshot.commit);
+        }
+        Ok(Err(error)) => warn!(action = "index_pending", error = %error),
+        Err(_) => warn!(action = "index_pending", "rebuild timeout"),
+    }
+}
+fn router(app: Arc<App>) -> Router {
+    Router::new()
+        .route(
+            "/api/health",
+            get(|| async { Json(json!({"status": "ok"})) }),
+        )
+        .route("/api/posts", get(posts))
+        .route("/api/posts/{slug}", get(public_post))
+        .route("/api/assets/{slug}/{name}", get(asset))
+        .route("/api/stats", get(stats))
+        .route("/api/auth/register", post(accounts::register))
+        .route("/api/auth/login", post(accounts::login))
+        .route("/api/auth/logout", post(accounts::logout))
+        .route("/api/account", get(accounts::me))
+        .route("/api/account/ssh-key", put(accounts::set_key))
+        .route("/api/account/password", put(accounts::change_password))
+        .route("/api/admin/users", get(accounts::users))
+        .route("/api/admin/users/{username}", patch(accounts::grant))
+        .route("/api/admin/status", get(admin_status))
+        .layer(DefaultBodyLimit::max(8 * 1024))
+        .layer(axum::middleware::from_fn(
+            |request: axum::extract::Request, next: axum::middleware::Next| async move {
+                let mut response = next.run(request).await;
+                for (key, value) in [
+                    (header::CACHE_CONTROL, "no-store"),
+                    (header::X_CONTENT_TYPE_OPTIONS, "nosniff"),
+                    (
+                        header::CONTENT_SECURITY_POLICY,
+                        "default-src 'none'; frame-ancestors 'none'",
+                    ),
+                    (header::REFERRER_POLICY, "no-referrer"),
+                ] {
+                    response
+                        .headers_mut()
+                        .insert(key, HeaderValue::from_static(value));
+                }
+                response
+            },
+        ))
+        .with_state(app)
+}
+async fn refresh(app: &App, repo: &std::path::Path, source: &std::path::Path) -> Result<()> {
+    // Recover a previously committed ref even if snapshot publication was interrupted.
+    let mut current = app.snapshot.read().await.clone();
+    let head =
+        String::from_utf8(content::git(repo, &["rev-parse", "refs/heads/main"], None).await?)?;
+    if current.commit != head.trim() {
+        current = content::scan(repo).await?;
+    }
+    let snapshot = ssh::import(repo, source, &current).await?;
+    if snapshot.commit != app.snapshot.read().await.commit {
+        content::persist(&app.data, &snapshot).await?;
+        info!(action = "published", commit = %snapshot.commit);
+        *app.snapshot.write().await = snapshot;
+    }
+    Ok(())
+}
+#[tokio::main]
+async fn main() -> Result<()> {
+    tracing_subscriber::fmt()
+        .with_env_filter(tracing_subscriber::EnvFilter::from_default_env())
+        .init();
+    let command = std::env::args().nth(1);
+    match command.as_deref() {
+        Some("ssh-gate") => {
+            return ssh::gate(&std::env::args().nth(2).context("缺少发布者身份")?).await;
+        }
+        Some("pre-receive") => return ssh::pre_receive().await,
+        Some("authorized-keys") => return ssh::authorized_keys(),
+        Some("provision-db") => return index::provision().await,
+        Some("hash-password") => {
+            use std::io::Read;
+            let mut value = String::new();
+            std::io::stdin().take(1025).read_to_string(&mut value)?;
+            println!(
+                "{}",
+                accounts::hash_password(value.trim_end_matches(['\r', '\n']).into()).await?
+            );
+            return Ok(());
+        }
+        None | Some("rebuild-index") => {}
+        Some(_) => anyhow::bail!("未知命令"),
+    }
+    let data = PathBuf::from(std::env::var("DATA_DIR").unwrap_or_else(|_| "data".into()));
+    tokio::fs::create_dir_all(&data).await?;
+    let data = tokio::fs::canonicalize(data).await?;
+    let lock_file = std::fs::OpenOptions::new()
+        .create(true)
+        .truncate(false)
+        .write(true)
+        .open(data.join("writer.lock"))?;
+    fs2::FileExt::try_lock_exclusive(&lock_file).context("内容目录已被另一个 API 进程使用")?;
+    let repo = content::init(&data).await?;
+    let snapshot = content::scan(&repo).await?;
+    content::persist(&data, &snapshot).await?;
+    if command.as_deref() == Some("rebuild-index") {
+        index::rebuild(&snapshot).await?;
+        return Ok(());
+    }
+    let origin = std::env::var("PUBLIC_ORIGIN").context("必须设置 PUBLIC_ORIGIN")?;
+    let parsed: axum::http::Uri = origin.parse().context("PUBLIC_ORIGIN 无效")?;
+    let secure = parsed.scheme_str() == Some("https");
+    ensure!(
+        secure
+            || (parsed.scheme_str() == Some("http")
+                && matches!(parsed.host(), Some("localhost" | "127.0.0.1"))),
+        "生产环境必须使用 HTTPS"
+    );
+    ensure!(
+        !origin.ends_with('/')
+            && parsed.path() == "/"
+            && parsed.query().is_none()
+            && parsed
+                .authority()
+                .is_some_and(|a| !a.as_str().contains('@')),
+        "PUBLIC_ORIGIN 必须为不带末尾斜杠的站点 origin"
+    );
+    let source = PathBuf::from(
+        std::env::var("INGRESS_REPO").unwrap_or_else(|_| "/srv/ingress/content.git".into()),
+    );
+    ensure!(source.is_absolute(), "INGRESS_REPO 必须是绝对路径");
+    let ssh_config = PathBuf::from(
+        std::env::var("CHUBLOG_SSH_CONFIG")
+            .unwrap_or_else(|_| data.join("publishers.json").to_string_lossy().into_owned()),
+    );
+    let accounts = accounts::load(&data, &ssh_config, source.clone()).await?;
+    ensure!(
+        accounts.grants.repository == source,
+        "授权配置仓库与 INGRESS_REPO 不一致"
+    );
+    let app = Arc::new(App {
+        data,
+        ssh_config,
+        origin,
+        secure,
+        registration: std::env::var("ALLOW_REGISTRATION").as_deref() == Ok("true"),
+        accounts: Mutex::new(accounts),
+        hash_slots: Arc::new(Semaphore::new(2)),
+        snapshot: RwLock::new(snapshot),
+        indexed: RwLock::new(None),
+        views: AtomicU64::new(0),
+    });
+    let worker_app = app.clone();
+    let worker = tokio::spawn(async move {
+        let mut ticks = 0;
+        loop {
+            if let Err(error) = refresh(&worker_app, &repo, &source).await {
+                warn!(action = "import_pending", error = %error);
+            }
+            if ticks % 30 == 0 {
+                let snapshot = worker_app.snapshot.read().await.clone();
+                if worker_app.indexed.read().await.as_deref() != Some(snapshot.commit.as_str()) {
+                    sync_index(&worker_app, &snapshot).await;
+                } else if !matches!(
+                    tokio::time::timeout(Duration::from_secs(10), index::consistent(&snapshot))
+                        .await,
+                    Ok(Ok(true))
+                ) {
+                    *worker_app.indexed.write().await = None;
+                    sync_index(&worker_app, &snapshot).await;
+                }
+            }
+            ticks += 1;
+            tokio::time::sleep(Duration::from_secs(2)).await;
+        }
+    });
+    let bind = std::env::var("API_BIND").unwrap_or_else(|_| "127.0.0.1:3001".into());
+    let listener = tokio::net::TcpListener::bind(&bind).await?;
+    info!(%bind, "ChuBlog API ready");
+    let mut terminate = tokio::signal::unix::signal(tokio::signal::unix::SignalKind::terminate())?;
+    axum::serve(listener, router(app))
+        .with_graceful_shutdown(async move {
+            tokio::select! { _ = tokio::signal::ctrl_c() => {}, _ = terminate.recv() => {} }
+        })
+        .await?;
+    worker.abort();
+    let _ = worker.await;
+    drop(lock_file);
+    Ok(())
+}
+
+#[cfg(test)]
+mod tests;

apps/api/src/ssh.rs

@@ -0,0 +1,274 @@
+use crate::accounts::{Grant, Role};
+use crate::content::{self, Snapshot};
+use anyhow::{Context, Result, bail, ensure};
+use serde::{Deserialize, Serialize};
+use std::{
+    collections::BTreeMap,
+    os::unix::fs::MetadataExt,
+    path::{Path, PathBuf},
+    process::Stdio,
+    time::Duration,
+};
+use tokio::{io::AsyncReadExt, process::Command};
+
+#[derive(Clone, Deserialize, Serialize)]
+#[serde(deny_unknown_fields)]
+pub struct Config {
+    pub repository: PathBuf,
+    pub publishers: BTreeMap<String, Grant>,
+}
+
+pub fn config(path: &Path) -> Result<Config> {
+    let meta = std::fs::symlink_metadata(path)?;
+    ensure!(
+        meta.is_file() && (meta.uid() == 0 || meta.uid() == 10001) && meta.mode() & 0o022 == 0,
+        "SSH 授权配置必须为 root 或 API UID 10001 所有且不可被组或其他用户写入"
+    );
+    let bytes = std::fs::read(path)?;
+    ensure!(bytes.len() < 65536, "SSH 配置过大");
+    let cfg: Config = serde_json::from_slice(&bytes)?;
+    ensure!(cfg.repository.is_absolute(), "接收仓库必须为绝对路径");
+    Ok(cfg)
+}
+fn authorized<'a>(cfg: &'a Config, identity: &str) -> Result<&'a Grant> {
+    ensure!(
+        !identity.is_empty()
+            && identity.len() <= 64
+            && identity
+                .bytes()
+                .all(|b| b.is_ascii_alphanumeric() || b"_-".contains(&b)),
+        "发布者身份无效"
+    );
+    let publisher = cfg
+        .publishers
+        .get(identity)
+        .filter(|p| p.enabled && p.role != Role::Reader && p.ssh_key.is_some())
+        .context("服务器未授权此身份发布文章")?;
+    ensure!(
+        !publisher.prefixes.is_empty()
+            && publisher.prefixes.iter().all(|p| !p.is_empty()
+                && p.len() <= 64
+                && p.bytes()
+                    .all(|b| b.is_ascii_lowercase() || b.is_ascii_digit() || b == b'-')),
+        "发布者必须拥有明确 slug 前缀"
+    );
+    Ok(publisher)
+}
+fn directory_size(path: &Path) -> Result<u64> {
+    let mut total = 0u64;
+    for entry in std::fs::read_dir(path)? {
+        let entry = entry?;
+        let meta = entry.file_type()?;
+        ensure!(!meta.is_symlink(), "接收仓库不得包含符号链接");
+        total = total.saturating_add(if meta.is_dir() {
+            directory_size(&entry.path())?
+        } else {
+            entry.metadata()?.len()
+        });
+        ensure!(
+            total <= 256 * 1024 * 1024,
+            "接收仓库达到 256 MiB 配额，请管理员维护"
+        );
+    }
+    Ok(total)
+}
+
+pub async fn gate(identity: &str) -> Result<()> {
+    let config_path = PathBuf::from(
+        std::env::var("CHUBLOG_SSH_CONFIG").unwrap_or_else(|_| "/auth/publishers.json".into()),
+    );
+    let cfg = config(&config_path)?;
+    authorized(&cfg, identity)?;
+    let original = std::env::var("SSH_ORIGINAL_COMMAND").unwrap_or_default();
+    ensure!(
+        matches!(
+            original.as_str(),
+            "git-receive-pack 'content.git'" | "git-upload-pack 'content.git'"
+        ),
+        "仅允许对 content.git 执行 Git 推送或读取"
+    );
+    let receiving = original.starts_with("git-receive-pack");
+    directory_size(&cfg.repository)?;
+    let lock = std::fs::OpenOptions::new()
+        .create(true)
+        .truncate(false)
+        .write(true)
+        .open(cfg.repository.join("ssh.lock"))?;
+    fs2::FileExt::try_lock_exclusive(&lock).context("另一位发布者正在访问仓库，请稍后重试")?;
+    let executable = if receiving {
+        "git-receive-pack"
+    } else {
+        "git-upload-pack"
+    };
+    let mut child = Command::new(executable)
+        .arg(&cfg.repository)
+        .env_clear()
+        .env("PATH", "/usr/bin:/bin")
+        .env("HOME", "/nonexistent")
+        .env("GIT_CONFIG_NOSYSTEM", "1")
+        .env("GIT_CONFIG_GLOBAL", "/dev/null")
+        .env("CHUBLOG_SSH_CONFIG", &config_path)
+        .env("CHUBLOG_PUBLISHER", identity)
+        .env("GIT_CONFIG_COUNT", "5")
+        .env("GIT_CONFIG_KEY_0", "receive.maxInputSize")
+        .env("GIT_CONFIG_VALUE_0", "8388608")
+        .env("GIT_CONFIG_KEY_1", "receive.fsckObjects")
+        .env("GIT_CONFIG_VALUE_1", "true")
+        .env("GIT_CONFIG_KEY_2", "transfer.fsckObjects")
+        .env("GIT_CONFIG_VALUE_2", "true")
+        .env("GIT_CONFIG_KEY_3", "gc.auto")
+        .env("GIT_CONFIG_VALUE_3", "0")
+        .env("GIT_CONFIG_KEY_4", "core.hooksPath")
+        .env("GIT_CONFIG_VALUE_4", "/hooks")
+        .stdin(Stdio::inherit())
+        .stdout(Stdio::inherit())
+        .stderr(Stdio::inherit())
+        .kill_on_drop(true)
+        .spawn()
+        .context("启动受限 Git 服务失败")?;
+    let status = match tokio::time::timeout(Duration::from_secs(90), child.wait()).await {
+        Ok(status) => status?,
+        Err(_) => {
+            child.kill().await?;
+            bail!("SSH Git 会话超过 90 秒限制");
+        }
+    };
+    ensure!(status.success(), "Git 访问失败");
+    drop(lock);
+    Ok(())
+}
+
+pub async fn validate_change(
+    repo: &Path,
+    previous: &str,
+    next: &str,
+    publisher: &Grant,
+) -> Result<Snapshot> {
+    ensure!(
+        next.len() == 40
+            && next.bytes().all(|b| b.is_ascii_hexdigit())
+            && next != "0000000000000000000000000000000000000000",
+        "禁止删除主分支或无效提交"
+    );
+    let initial = previous == "0000000000000000000000000000000000000000";
+    let parents =
+        String::from_utf8(content::git(repo, &["show", "-s", "--format=%P", next], None).await?)?;
+    ensure!(
+        parents.trim() == if initial { "" } else { previous },
+        "每次只允许推送一个直接继承主分支的提交，首次必须为根提交；不允许合并或强推"
+    );
+    let snapshot = content::scan_at(repo, next).await?;
+    // Authorize raw Git paths: normalization must not hide edits to another author's bytes.
+    let changes = if initial {
+        content::git(repo, &["ls-tree", "--name-only", "-rz", next], None).await?
+    } else {
+        content::git(
+            repo,
+            &[
+                "diff-tree",
+                "--no-commit-id",
+                "--name-only",
+                "--no-renames",
+                "-r",
+                "-z",
+                previous,
+                next,
+            ],
+            None,
+        )
+        .await?
+    };
+    for path in changes.split(|b| *b == 0).filter(|p| !p.is_empty()) {
+        let path = std::str::from_utf8(path)?;
+        let parts: Vec<_> = path.split('/').collect();
+        ensure!(parts.len() == 3 && parts[0] == "posts", "修改路径无效");
+        let key = content::slug(parts[1])?;
+        ensure!(
+            publisher.prefixes.iter().any(|p| key.starts_with(p)),
+            "无权修改文章 {key}"
+        );
+    }
+    Ok(snapshot)
+}
+
+pub async fn pre_receive() -> Result<()> {
+    let config_path =
+        PathBuf::from(std::env::var("CHUBLOG_SSH_CONFIG").context("缺少受控 SSH 配置")?);
+    let cfg = config(&config_path)?;
+    let identity = std::env::var("CHUBLOG_PUBLISHER").context("拒绝未经 SSH 网关的推送")?;
+    let publisher = authorized(&cfg, &identity)?;
+    let mut input = String::new();
+    tokio::io::stdin()
+        .take(1025)
+        .read_to_string(&mut input)
+        .await?;
+    ensure!(input.len() <= 1024, "引用更新过多");
+    let lines: Vec<_> = input.lines().collect();
+    ensure!(lines.len() == 1, "每次只能更新主分支，禁止标签及其他引用");
+    let fields: Vec<_> = lines[0].split_whitespace().collect();
+    ensure!(
+        fields.len() == 3 && fields[2] == "refs/heads/main",
+        "仅允许 refs/heads/main"
+    );
+    ensure!(
+        fields[0].len() == 40 && fields[0].bytes().all(|b| b.is_ascii_hexdigit()),
+        "旧提交无效"
+    );
+    validate_change(&cfg.repository, fields[0], fields[1], publisher).await?;
+    let latest = config(&config_path)?;
+    let current = authorized(&latest, &identity)?;
+    ensure!(
+        current.prefixes == publisher.prefixes && current.ssh_key == publisher.ssh_key,
+        "推送期间授权已变更，请重新连接"
+    );
+    eprintln!(
+        "ChuBlog: identity={identity} validated commit={}",
+        fields[1]
+    );
+    Ok(())
+}
+
+// Fetch into API-owned storage: the SSH account cannot alter published refs or snapshots.
+pub async fn import(repo: &Path, source: &Path, current: &Snapshot) -> Result<Snapshot> {
+    content::git(
+        repo,
+        &[
+            "fetch",
+            "--no-tags",
+            "--no-recurse-submodules",
+            "--",
+            source.to_str().context("接收路径无效")?,
+            "refs/heads/main",
+        ],
+        None,
+    )
+    .await?;
+    let commit = String::from_utf8(content::git(repo, &["rev-parse", "FETCH_HEAD"], None).await?)?;
+    let commit = commit.trim();
+    if commit == current.commit {
+        return Ok(current.clone());
+    }
+    let snapshot = content::scan_at(repo, commit).await?;
+    content::git(
+        repo,
+        &["update-ref", "refs/heads/main", commit, &current.commit],
+        None,
+    )
+    .await?;
+    Ok(snapshot)
+}
+
+pub fn authorized_keys() -> Result<()> {
+    let path =
+        std::env::var("CHUBLOG_SSH_CONFIG").unwrap_or_else(|_| "/auth/publishers.json".into());
+    let cfg = config(Path::new(&path))?;
+    for (identity, grant) in &cfg.publishers {
+        if authorized(&cfg, identity).is_ok()
+            && let Some(key) = &grant.ssh_key
+        {
+            let key = crate::accounts::public_key(key)?;
+            println!("restrict,command=\"/usr/local/bin/chublog-api ssh-gate {identity}\" {key}");
+        }
+    }
+    Ok(())
+}

apps/api/src/tests.rs

@@ -0,0 +1,666 @@
+use super::*;
+use accounts::{Grant, Role};
+use axum::http::Request;
+use std::collections::BTreeMap;
+use tower::ServiceExt;
+
+fn markdown(key: &str, status: &str, body: &str) -> String {
+    format!(
+        "---\ntitle: Test\nslug: {key}\ndate: '2026-10-15'\nupdated: '2026-10-15'\nstatus: {status}\ntags: [Rust]\ndescription: Test article\n---\n\n{body}\n"
+    )
+}
+fn grant(prefix: &str) -> Grant {
+    Grant {
+        enabled: true,
+        role: Role::Publisher,
+        prefixes: vec![prefix.into()],
+        ssh_key: None,
+    }
+}
+async fn commit(
+    repo: &std::path::Path,
+    parent: Option<&str>,
+    files: &[(&str, &str, &str)],
+) -> String {
+    content::git(repo, &["read-tree", "--empty"], None)
+        .await
+        .unwrap();
+    for (path, mode, body) in files {
+        let object = String::from_utf8(
+            content::git(
+                repo,
+                &["hash-object", "-w", "--stdin"],
+                Some(body.as_bytes()),
+            )
+            .await
+            .unwrap(),
+        )
+        .unwrap();
+        content::git(
+            repo,
+            &[
+                "update-index",
+                "--add",
+                "--cacheinfo",
+                mode,
+                object.trim(),
+                path,
+            ],
+            None,
+        )
+        .await
+        .unwrap();
+    }
+    let tree = String::from_utf8(content::git(repo, &["write-tree"], None).await.unwrap()).unwrap();
+    let mut args = vec!["commit-tree", tree.trim(), "-m", "Test"];
+    if let Some(parent) = parent {
+        args.extend(["-p", parent]);
+    }
+    String::from_utf8(content::git(repo, &args, None).await.unwrap())
+        .unwrap()
+        .trim()
+        .into()
+}
+#[test]
+fn rejects_active_content_and_unsafe_metadata_but_keeps_inert_code() {
+    for body in [
+        "<script>alert(1)</script>",
+        "<img src=x onerror=alert(1)>",
+        "[x](javascript:alert%281%29)",
+        "[x](jav&#x61;script:alert%281%29)",
+        "![x](https://evil.test/x.png)",
+        "![x](../secret.png)",
+        "a\u{202e}exe",
+        "[x](//evil.test)",
+        "[x](file:///etc/passwd)",
+    ] {
+        assert!(
+            content::parse(markdown("alice-test", "published", body), vec![]).is_err(),
+            "accepted {body}"
+        );
+    }
+    assert!(content::parse(markdown("../escape", "published", "Hello"), vec![]).is_err());
+    assert!(
+        content::parse(
+            markdown(
+                "alice-test",
+                "published",
+                &"x".repeat(content::MAX_MARKDOWN)
+            ),
+            vec![]
+        )
+        .is_err()
+    );
+    assert!(
+        content::parse(
+            markdown(
+                "alice-test",
+                "published",
+                "```html\n<script>alert(1)</script>\n```\n[valid](https://example.com)"
+            ),
+            vec![]
+        )
+        .is_ok()
+    );
+    assert!(
+        content::decode_asset(&content::Asset {
+            name: "hidden.svg".into(),
+            data: "PHN2Zz4=".into()
+        })
+        .is_err()
+    );
+    assert!(
+        content::decode_asset(&content::Asset {
+            name: "fake.png".into(),
+            data: "PHNjcmlwdD4=".into()
+        })
+        .is_err()
+    );
+}
+#[tokio::test]
+async fn git_checks_namespace_history_and_file_modes_before_publication() {
+    let dir = tempfile::tempdir().unwrap();
+    let repo = content::init(dir.path()).await.unwrap();
+    let zero = "0000000000000000000000000000000000000000";
+    let first = commit(
+        &repo,
+        None,
+        &[(
+            "posts/alice-first/index.md",
+            "100644",
+            &markdown("alice-first", "published", "Hello"),
+        )],
+    )
+    .await;
+    let snapshot = ssh::validate_change(&repo, zero, &first, &grant("alice-"))
+        .await
+        .unwrap();
+    assert_eq!(snapshot.posts.len(), 1);
+    assert!(
+        ssh::validate_change(&repo, zero, &first, &grant("bob-"))
+            .await
+            .is_err()
+    );
+    let crlf = commit(
+        &repo,
+        Some(&first),
+        &[(
+            "posts/alice-first/index.md",
+            "100644",
+            &markdown("alice-first", "published", "Hello").replace('\n', "\r\n"),
+        )],
+    )
+    .await;
+    assert!(
+        ssh::validate_change(&repo, &first, &crlf, &grant("bob-"))
+            .await
+            .is_err(),
+        "normalization must not bypass path authorization"
+    );
+    let second = commit(
+        &repo,
+        Some(&first),
+        &[(
+            "posts/alice-first/index.md",
+            "100644",
+            &markdown("alice-first", "draft", "Private"),
+        )],
+    )
+    .await;
+    ssh::validate_change(&repo, &first, &second, &grant("alice-"))
+        .await
+        .unwrap();
+    let third = commit(
+        &repo,
+        Some(&second),
+        &[(
+            "posts/alice-first/index.md",
+            "100644",
+            &markdown("alice-first", "published", "Skipped commit"),
+        )],
+    )
+    .await;
+    assert!(
+        ssh::validate_change(&repo, &first, &third, &grant("alice-"))
+            .await
+            .is_err()
+    );
+    let link = commit(
+        &repo,
+        Some(&first),
+        &[("posts/alice-first/index.md", "120000", "/etc/passwd")],
+    )
+    .await;
+    assert!(
+        ssh::validate_change(&repo, &first, &link, &grant("alice-"))
+            .await
+            .is_err()
+    );
+    let executable = commit(
+        &repo,
+        Some(&first),
+        &[(
+            "posts/alice-first/index.md",
+            "100755",
+            &markdown("alice-first", "published", "Hello"),
+        )],
+    )
+    .await;
+    assert!(
+        ssh::validate_change(&repo, &first, &executable, &grant("alice-"))
+            .await
+            .is_err()
+    );
+    let hidden = commit(
+        &repo,
+        Some(&first),
+        &[(".github/workflows/run.yml", "100644", "bad")],
+    )
+    .await;
+    assert!(
+        ssh::validate_change(&repo, &first, &hidden, &grant("alice-"))
+            .await
+            .is_err()
+    );
+    assert!(
+        ssh::validate_change(&repo, &first, zero, &grant("alice-"))
+            .await
+            .is_err()
+    );
+    content::persist(dir.path(), &content::scan_at(&repo, &second).await.unwrap())
+        .await
+        .unwrap();
+    let public: Snapshot = serde_json::from_slice(
+        &tokio::fs::read(dir.path().join("published.json"))
+            .await
+            .unwrap(),
+    )
+    .unwrap();
+    assert!(public.posts.is_empty(), "draft leaked into public snapshot");
+}
+#[test]
+fn ssh_keys_cannot_inject_options_or_commands() {
+    let mut bytes = vec![0, 0, 0, 11];
+    bytes.extend(b"ssh-ed25519");
+    bytes.extend([0, 0, 0, 32]);
+    bytes.extend([42; 32]);
+    let key = format!(
+        "ssh-ed25519 {} comment",
+        base64::engine::general_purpose::STANDARD.encode(bytes)
+    );
+    assert!(accounts::public_key(&key).is_ok());
+    assert!(accounts::public_key(&format!("command=\"sh\" {key}")).is_err());
+    assert!(accounts::public_key(&format!("{key}\nssh-rsa AAA")).is_err());
+    assert!(accounts::public_key("ssh-ed25519 AAAA").is_err());
+}
+fn rsa_key(bits: usize, exponent: &[u8]) -> String {
+    let mut modulus = vec![0xff; bits.div_ceil(8)];
+    modulus[0] >>= (8 - bits % 8) % 8;
+    if modulus[0] & 0x80 != 0 {
+        modulus.insert(0, 0);
+    }
+    let mut bytes = Vec::new();
+    for field in [b"ssh-rsa".as_slice(), exponent, modulus.as_slice()] {
+        bytes.extend((field.len() as u32).to_be_bytes());
+        bytes.extend(field);
+    }
+    format!(
+        "ssh-rsa {}",
+        base64::engine::general_purpose::STANDARD.encode(bytes)
+    )
+}
+#[test]
+fn rsa_keys_enforce_strength_encoding_and_safe_canonical_form() {
+    for bits in [2048, 3072, 4096, 8192] {
+        let key = rsa_key(bits, &[1, 0, 1]);
+        assert_eq!(
+            accounts::public_key(&format!("{key} user comment")).unwrap(),
+            key
+        );
+    }
+    for key in [
+        rsa_key(1024, &[1, 0, 1]),
+        rsa_key(2047, &[1, 0, 1]),
+        rsa_key(8193, &[1, 0, 1]),
+        rsa_key(2048, &[2]),
+        rsa_key(2048, &[1]),
+        rsa_key(2048, &[0x80]),
+        rsa_key(2048, &[1, 0, 0, 0, 1]),
+    ] {
+        assert!(accounts::public_key(&key).is_err());
+    }
+    let key = rsa_key(2048, &[1, 0, 1]);
+    assert!(accounts::public_key(&key.replace("ssh-rsa", "ssh-ed25519")).is_err());
+    assert!(accounts::public_key(&format!("command=\"sh\" {key}")).is_err());
+    let encoded = key.split_whitespace().nth(1).unwrap();
+    let mut bytes = base64::engine::general_purpose::STANDARD
+        .decode(encoded)
+        .unwrap();
+    bytes.push(0);
+    assert!(
+        accounts::public_key(&format!(
+            "ssh-rsa {}",
+            base64::engine::general_purpose::STANDARD.encode(bytes)
+        ))
+        .is_err()
+    );
+}
+async fn app(dir: &std::path::Path) -> Arc<App> {
+    let config = dir.join("publishers.json");
+    let hash = accounts::hash_password("Administrator-test-123".into())
+        .await
+        .unwrap();
+    accounts::atomic(
+        &dir.join("users.json"),
+        &serde_json::to_vec(&json!({"admin": {"hash": hash}})).unwrap(),
+        0o600,
+    )
+    .await
+    .unwrap();
+    let grants = ssh::Config {
+        repository: dir.join("ingress.git"),
+        publishers: BTreeMap::from([(
+            "admin".into(),
+            Grant {
+                enabled: true,
+                role: Role::Admin,
+                prefixes: vec![],
+                ssh_key: None,
+            },
+        )]),
+    };
+    accounts::atomic(&config, &serde_json::to_vec(&grants).unwrap(), 0o644)
+        .await
+        .unwrap();
+    let accounts = accounts::load(dir, &config, grants.repository)
+        .await
+        .unwrap();
+    let published = content::parse(markdown("alice-public", "published", "Hello"), vec![]).unwrap();
+    let draft = content::parse(markdown("alice-secret", "draft", "Secret"), vec![]).unwrap();
+    Arc::new(App {
+        data: dir.into(),
+        ssh_config: config,
+        origin: "http://localhost:4321".into(),
+        secure: false,
+        registration: true,
+        accounts: Mutex::new(accounts),
+        hash_slots: Arc::new(Semaphore::new(2)),
+        snapshot: RwLock::new(Snapshot {
+            commit: "test".into(),
+            posts: BTreeMap::from([
+                ("alice-public".into(), published),
+                ("alice-secret".into(), draft),
+            ]),
+        }),
+        indexed: RwLock::new(None),
+        views: AtomicU64::new(0),
+    })
+}
+async fn request(
+    app: Arc<App>,
+    method: &str,
+    path: &str,
+    body: Value,
+    cookie: Option<&str>,
+    csrf: Option<&str>,
+) -> (StatusCode, HeaderMap, Value) {
+    let mut builder = Request::builder()
+        .method(method)
+        .uri(path)
+        .header("content-type", "application/json")
+        .header("origin", "http://localhost:4321");
+    if let Some(cookie) = cookie {
+        builder = builder.header("cookie", cookie);
+    }
+    if let Some(csrf) = csrf {
+        builder = builder.header("x-csrf-token", csrf);
+    }
+    let response = router(app)
+        .oneshot(builder.body(Body::from(body.to_string())).unwrap())
+        .await
+        .unwrap();
+    let status = response.status();
+    let headers = response.headers().clone();
+    let bytes = axum::body::to_bytes(response.into_body(), 1024 * 1024)
+        .await
+        .unwrap();
+    (
+        status,
+        headers,
+        serde_json::from_slice(&bytes).unwrap_or(Value::Null),
+    )
+}
+#[tokio::test]
+async fn registration_login_grants_revocation_and_private_content_boundaries() {
+    let dir = tempfile::tempdir().unwrap();
+    let app = app(dir.path()).await;
+    let (status, _, _) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/register",
+        json!({"username":"alice", "password":"Alice-test-password-123", "role":"admin"}),
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::UNPROCESSABLE_ENTITY);
+    let (status, _, value) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/register",
+        json!({"username":"alice", "password":"Alice-test-password-123"}),
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::OK);
+    assert_eq!(value["role"], "reader");
+    let (_, headers, value) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/login",
+        json!({"username":"alice", "password":"Alice-test-password-123"}),
+        None,
+        None,
+    )
+    .await;
+    let alice_cookie = headers[header::SET_COOKIE]
+        .to_str()
+        .unwrap()
+        .split(';')
+        .next()
+        .unwrap()
+        .to_owned();
+    let alice_csrf = value["csrf"].as_str().unwrap().to_owned();
+    let (status, _, _) = request(
+        app.clone(),
+        "GET",
+        "/api/admin/users",
+        Value::Null,
+        Some(&alice_cookie),
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::FORBIDDEN);
+    let (_, headers, value) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/login",
+        json!({"username":"admin", "password":"Administrator-test-123"}),
+        None,
+        None,
+    )
+    .await;
+    let admin_cookie = headers[header::SET_COOKIE]
+        .to_str()
+        .unwrap()
+        .split(';')
+        .next()
+        .unwrap()
+        .to_owned();
+    let admin_csrf = value["csrf"].as_str().unwrap().to_owned();
+    let input = json!({"enabled":true,"role":"publisher","prefixes":["alice-"]});
+    let (status, _, _) = request(
+        app.clone(),
+        "PATCH",
+        "/api/admin/users/alice",
+        input.clone(),
+        Some(&admin_cookie),
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::FORBIDDEN);
+    let (status, _, _) = request(
+        app.clone(),
+        "PATCH",
+        "/api/admin/users/alice",
+        input,
+        Some(&admin_cookie),
+        Some(&admin_csrf),
+    )
+    .await;
+    assert_eq!(status, StatusCode::OK);
+    assert_eq!(
+        app.accounts.lock().await.grants.publishers["alice"].role,
+        Role::Publisher
+    );
+    let disk = tokio::fs::read(dir.path().join("users.json"))
+        .await
+        .unwrap();
+    assert!(
+        !String::from_utf8(disk)
+            .unwrap()
+            .contains("Alice-test-password-123")
+    );
+    let (status, _, _) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/logout",
+        json!({}),
+        Some(&alice_cookie),
+        Some(&alice_csrf),
+    )
+    .await;
+    assert_eq!(
+        status,
+        StatusCode::UNAUTHORIZED,
+        "grant change must invalidate existing sessions"
+    );
+    let (status, _, _) = request(
+        app.clone(),
+        "PATCH",
+        "/api/admin/users/alice",
+        json!({"enabled":false,"role":"reader","prefixes":[]}),
+        Some(&admin_cookie),
+        Some(&admin_csrf),
+    )
+    .await;
+    assert_eq!(status, StatusCode::OK);
+    let (status, _, _) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/login",
+        json!({"username":"alice", "password":"Alice-test-password-123"}),
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::UNAUTHORIZED);
+    let (_, _, value) = request(app.clone(), "GET", "/api/posts", Value::Null, None, None).await;
+    assert_eq!(value["posts"].as_array().unwrap().len(), 1);
+    let (status, _, _) = request(
+        app.clone(),
+        "GET",
+        "/api/posts/alice-secret",
+        Value::Null,
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::NOT_FOUND);
+    let (_, _, value) = request(app.clone(), "GET", "/api/stats", Value::Null, None, None).await;
+    assert_eq!(value["published_posts"], 1);
+    let (status, _, _) = request(
+        app.clone(),
+        "POST",
+        "/api/admin/posts/publish",
+        json!({}),
+        Some(&admin_cookie),
+        Some(&admin_csrf),
+    )
+    .await;
+    assert_eq!(
+        status,
+        StatusCode::NOT_FOUND,
+        "online publishing must not exist"
+    );
+}
+
+#[tokio::test]
+async fn password_rotation_origin_and_request_limits() {
+    let dir = tempfile::tempdir().unwrap();
+    let app = app(dir.path()).await;
+    let response = router(app.clone())
+        .oneshot(
+            Request::builder()
+                .method("POST")
+                .uri("/api/auth/login")
+                .header("content-type", "application/json")
+                .body(Body::from(
+                    json!({"username":"admin","password":"Administrator-test-123"}).to_string(),
+                ))
+                .unwrap(),
+        )
+        .await
+        .unwrap();
+    assert_eq!(
+        response.status(),
+        StatusCode::FORBIDDEN,
+        "login must validate Origin"
+    );
+    let (_, headers, value) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/login",
+        json!({"username":"admin","password":"Administrator-test-123"}),
+        None,
+        None,
+    )
+    .await;
+    let cookie = headers[header::SET_COOKIE]
+        .to_str()
+        .unwrap()
+        .split(';')
+        .next()
+        .unwrap()
+        .to_owned();
+    let csrf = value["csrf"].as_str().unwrap();
+    let (status, _, _) = request(
+        app.clone(),
+        "PUT",
+        "/api/account/password",
+        json!({"old_password":"Incorrect-password", "new_password":"New-password-12345"}),
+        Some(&cookie),
+        Some(csrf),
+    )
+    .await;
+    assert_eq!(status, StatusCode::UNAUTHORIZED);
+    let (status, _, _) = request(
+        app.clone(),
+        "PUT",
+        "/api/account/password",
+        json!({"old_password":"Administrator-test-123", "new_password":"New-password-12345"}),
+        Some(&cookie),
+        Some(csrf),
+    )
+    .await;
+    assert_eq!(status, StatusCode::OK);
+    let (status, _, _) = request(
+        app.clone(),
+        "GET",
+        "/api/account",
+        Value::Null,
+        Some(&cookie),
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::UNAUTHORIZED);
+    let loaded = accounts::load(dir.path(), &app.ssh_config, dir.path().join("ingress.git"))
+        .await
+        .unwrap();
+    *app.accounts.lock().await = loaded;
+    let (status, _, _) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/login",
+        json!({"username":"admin", "password":"Administrator-test-123"}),
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::UNAUTHORIZED);
+    let (status, _, _) = request(
+        app.clone(),
+        "POST",
+        "/api/auth/login",
+        json!({"username":"admin", "password":"New-password-12345"}),
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(
+        status,
+        StatusCode::OK,
+        "password change must survive account reload"
+    );
+    let (status, _, _) = request(
+        app,
+        "POST",
+        "/api/auth/register",
+        json!({"username":"large", "password":"x".repeat(9000)}),
+        None,
+        None,
+    )
+    .await;
+    assert_eq!(status, StatusCode::PAYLOAD_TOO_LARGE);
+}

benchmark/benchmark4csql.cabal

@@ -1,25 +0,0 @@
-cabal-version: 2.4
-
-name:           benchmark4csql
-version:        1.0.0
-synopsis:       End-to-end ChuSQL benchmarks over TCP
-description:    Starts a chusql-server process and benchmarks authentication,
-                ping, catalog access, and queries through the newline-delimited
-                JSON TCP protocol. Uses the TCP client and shared protocol models;
-                query execution and storage remain in the server process.
-build-type:     Simple
-
-executable benchmark4csql
-    main-is:          Main.hs
-    hs-source-dirs:   src
-    build-tool-depends: chusql-server:chusql-server
-                      , chusql-bootstrap:csql-bootstrap
-    build-depends:    base >= 4.14 && < 5
-                    , chusql-core-model
-                    , chusql-interface
-                    , directory
-                    , filepath
-                    , process
-                    , text
-    default-language: Haskell2010
-    ghc-options:      -O2 -Wall

benchmark/src/Main.hs

@@ -1,645 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-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 (
-    Session,
-    authenticateSession,
-    catalog,
-    newSession,
-    runStatement,
-    switchDatabase,
- )
-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_, replicateM, unless, when, void)
-import Data.List (intercalate, sort)
-import ChuSQL.Core.Model (Value (..))
-import Data.Text (Text)
-import qualified Data.Text as T
-import GHC.Clock (getMonotonicTime)
-import System.Directory (
-    createDirectoryIfMissing,
-    findExecutable,
-    getTemporaryDirectory,
-    removeDirectoryRecursive,
-    removeFile,
- )
-import System.Environment (getArgs)
-import System.Exit (ExitCode (..), exitFailure)
-import System.FilePath ((</>))
-import System.Info (os)
-import System.IO (Handle, hGetLine, hSetBuffering, BufferMode (LineBuffering), stdout)
-import System.Process (
-    CreateProcess (std_err, std_out),
-    ProcessHandle,
-    StdStream (CreatePipe, NoStream),
-    createProcess,
-    proc,
-    readProcessWithExitCode,
-    terminateProcess,
-    waitForProcess,
- )
-import Text.Printf (printf)
-import Text.Read (readMaybe)
-
--- 全链路基准：客户端经 TCP 连 chusql-server，落盘到进程内 Rust 存储。
--- 每条语句都走完整链路：解析、语义检查、提交。
--- 对照项：ping 与 catalog。
-
--- | 一个基准世界：真 server 进程 + 一条 TCP 会话
-data Bench = Bench
-    { bProcess :: ProcessHandle
-    , bDataDir :: FilePath
-    , bClient :: Client
-    , bSession :: Session
-    , bPort :: Int
-    , bConfigPath :: FilePath
-    }
-
--- | 跑一条 SQL 文本（整条链路）
-runSql :: Bench -> String -> IO (Either Text QueryResult)
-runSql bench sql = do
-    result <- runStatement (bSession bench) (T.pack sql)
-    case result of
-        Left err -> ioError (userError (T.unpack err))
-        Right _ -> pure result
-
--- | 量一次墙上耗时并强制求出行数
-timedQuery :: Bench -> String -> IO (Double, Either Text Int)
-timedQuery bench sql = do
-    t0 <- getMonotonicTime
-    r <- runSql bench sql
-    n <- case r of
-        Left _ -> pure (-1)
-        Right result -> evaluate (qrRowCount result)
-    t1 <- getMonotonicTime
-    pure (t1 - t0, const (Right n) =<< r)
-
--- | 打印一行结果
-report :: String -> Either Text Int -> Double -> IO ()
-report label result dt = case result of
-    Left e -> printf "%-38s %10s   !! %s\n" label ("FAILED" :: String) (T.unpack e)
-    Right n -> printf "%-38s %8.1f ms %8d rows\n" label (dt * 1000) n
-
--- | 单独量一条可重复的 SQL（先预热）
-benchSql :: Bench -> String -> String -> IO (Either Text Int)
-benchSql bench label sql = do
-    _ <- runSql bench sql
-    (dt, r) <- timedQuery bench sql
-    report label r dt
-    pure r
-
--- | 只跑一次的语句（重跑会报错）
-benchSqlOnce :: Bench -> String -> String -> IO (Either Text Int)
-benchSqlOnce bench label sql = do
-    (dt, r) <- timedQuery bench sql
-    report label r dt
-    pure r
-
--- | 批量插入并报平均耗时
-batchInsert :: Bench -> String -> Int -> (Int -> String) -> IO (Either Text ())
-batchInsert bench label n mkSql = do
-    t0 <- getMonotonicTime
-    results <- mapM (runSql bench . mkSql) [1 .. n]
-    t1 <- getMonotonicTime
-    let total = t1 - t0
-        errs = lefts results
-    case errs of
-        [] -> do
-            printf
-                "%-38s %8.1f ms %7.3f ms/row\n"
-                label
-                (total * 1000)
-                (total * 1000 / fromIntegral n)
-            pure (Right ())
-        (e : _) -> do
-            printf "%-38s %10s   !! %s\n" label ("FAILED" :: String) (T.unpack e)
-            pure (Left e)
-
--- | 纯 TCP 往返：只过协议层，不过引擎与存储
-benchPing :: Bench -> Int -> IO ()
-benchPing bench times = do
-    _ <- clientPing (bClient bench)
-    t0 <- getMonotonicTime
-    results <- mapM (const (clientPing (bClient bench))) [1 .. times]
-    t1 <- getMonotonicTime
-    let total = t1 - t0
-        hits = length [() | Right _ <- results]
-    printf
-        "%-38s %8.1f ms %7.3f ms/op (pongs %d/%d)\n"
-        ("tcp round trip (ping, no engine)" :: String)
-        (total * 1000)
-        (total * 1000 / fromIntegral times)
-        hits
-        times
-    unless (hits == times) (ioError (userError "ping failed during benchmark"))
-
--- | 一次点查（走语句，等于把 id 索引那一支也量进去）
-benchLookup :: Bench -> Int -> Int -> IO ()
-benchLookup bench key times = do
-    let sql = printf "SELECT name FROM users WHERE id = %d" key
-    _ <- runSql bench sql
-    t0 <- getMonotonicTime
-    results <- mapM (const (runSql bench sql)) [1 .. times]
-    t1 <- getMonotonicTime
-    let total = t1 - t0
-        hits = length [() | Right result <- results, qrRowCount result > 0]
-    printf
-        "%-38s %8.1f ms %7.3f ms/op (hits %d/%d)\n"
-        ("point lookup by id (statement, over TCP)" :: String)
-        (total * 1000)
-        (total * 1000 / fromIntegral times)
-        hits
-        times
-    unless (hits == times) (ioError (userError "point lookup failed during benchmark"))
-
--- | 量 list_catalog（只取结构，不取行）
-benchCatalog :: Bench -> Int -> IO ()
-benchCatalog bench n = do
-    _ <- catalog (bSession bench)
-    t0 <- getMonotonicTime
-    results <- mapM (const (catalog (bSession bench))) [1 .. n]
-    t1 <- getMonotonicTime
-    let total = t1 - t0
-        hits = length [() | Right _ <- results]
-    printf
-        "%-38s %8.1f ms %7.3f ms/op (%d/%d ok)\n"
-        ("list_catalog (schema only, over TCP)" :: String)
-        (total * 1000)
-        (total * 1000 / fromIntegral n)
-        hits
-        n
-    unless (hits == n) (ioError (userError "catalog failed during benchmark"))
-
--- | 依次跑一批语句，返回 (耗时秒, 错误清单)
-runBatch :: Bench -> [String] -> IO (Double, [Text])
-runBatch bench sqls = do
-    t0 <- getMonotonicTime
-    results <- mapM (runSql bench) sqls
-    t1 <- getMonotonicTime
-    pure (t1 - t0, lefts results)
-
--- | 把 1..n 按 size 切成一段段
-chunked :: Int -> Int -> [[Int]]
-chunked size n = go [1 .. n]
-  where
-    -- | 递归切分
-    go [] = []
-    go xs = let (a, b) = splitAt size xs in a : go b
-
--- | 一条带多行的 INSERT（一条语句 N 行，只落一次盘）
-multiInsertSql :: [Int] -> String
-multiInsertSql ids =
-    "INSERT INTO batch_t (id, name, age) VALUES "
-        ++ intercalate ", " [printf "(%d, 'b%d', %d)" i i (i `mod` 100) | i <- ids]
-
--- | 打印一张表的统计
-printStats :: TableInfo -> IO ()
-printStats i =
-    printf
-        "  %-12s %6d rows  indexes=%s\n             stats=%s\n"
-        (tiTable i)
-        (tiRows i)
-        (if null (tiIndexes i) then "none" else unwords (tiIndexes i))
-        ( unwords
-            [ n ++ ":" ++ show d ++ (if c then "+ (lower bound)" else "")
-            | (n, d, c) <- tiStats i
-            ]
-        )
-
--- | 主场景
-runScenarios :: Bench -> Int -> Int -> IO ()
-runScenarios bench u o = do
-    putStrLn "\n[create tables]"
-    r1 <- benchSqlOnce bench "CREATE TABLE users" "CREATE TABLE users (id int, name str, age int)"
-    r2 <- benchSqlOnce bench "CREATE TABLE orders" "CREATE TABLE orders (id int, user_id int, product str)"
-    case (r1, r2) of
-        (Right _, Right _) -> pure ()
-        _ -> do
-            putStrLn "table creation failed; stopping here"
-            exitFailure
-
-    putStrLn "\n[write: 500 rows per durable INSERT commit]"
-    loadBatch bench "users" "id,name,age" u (\i -> printf "(%d,'user%d',%d)" i i (i `mod` 100))
-    loadBatch bench "orders" "id,user_id,product" o (\i -> printf "(%d,%d,'item%d')" i (1 + (i - 1) `mod` u) (i `mod` 50))
-    checkCount bench "users" u
-    checkCount bench "orders" o
-
-    putStrLn "\n[breakdown: protocol round trip vs one catalog call, both over TCP]"
-    benchPing bench 200
-    benchCatalog bench 200
-
-    putStrLn "\n[read/query: full statement, including parsing and semantic checks]"
-    _ <- benchSql bench "SELECT * FROM users" "SELECT * FROM users"
-    ageR <- benchSql bench "SELECT name FROM users WHERE age > 90" "SELECT name FROM users WHERE age > 90"
-
-    putStrLn "\n[read/query: join]"
-    joinR <-
-        benchSql
-            bench
-            "JOIN + WHERE (hash join)"
-            "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 90"
-
-    putStrLn "\n[point lookup]"
-    benchLookup bench (u `div` 2) 100
-    pressureScenarios bench u o
-
-    putStrLn "\n[batch insert: one statement with N rows, one durable commit]"
-    _ <- benchSqlOnce bench "CREATE TABLE batch_t" "CREATE TABLE batch_t (id int, name str, age int)"
-    let groups = chunked 100 u
-        perStmt = maximum (0 : map length groups)
-    (bt, batchErrs) <- runBatch bench (map multiInsertSql groups)
-    case batchErrs of
-        [] ->
-            printf
-                "%-38s %8.1f ms %7.3f ms/row (%d rows/stmt x %d statements)\n"
-                ("multi-row INSERT" :: String)
-                (bt * 1000)
-                (bt * 1000 / fromIntegral u)
-                (perStmt :: Int)
-                (length groups)
-        (e : _) -> printf "%-38s %10s   !! %s\n" ("multi-row INSERT" :: String) ("FAILED" :: String) (T.unpack e)
-
-    putStrLn "\n[row delete: cost tracks the scan plus one commit, not the row count]"
-    _ <- benchSqlOnce bench "DELETE FROM users WHERE id = k (1 row)" (printf "DELETE FROM users WHERE id = %d" (u `div` 2))
-    _ <- benchSqlOnce bench "DELETE FROM users (all)" "DELETE FROM users"
-
-    putStrLn "\n[secondary index: falls back to scan, then uses the index once built]"
-    _ <- benchSqlOnce bench "CREATE TABLE items" "CREATE TABLE items (id int, code int)"
-    let itemGroups = chunked 100 o
-        itemSql ids =
-            "INSERT INTO items (id, code) VALUES "
-                ++ intercalate ", " [printf "(%d, %d)" i (i * 7 + 1) | i <- ids]
-    (it, itemErrs) <- runBatch bench (map itemSql itemGroups)
-    case itemErrs of
-        [] -> pure ()
-        (e : _) -> printf "  !! %s\n" (T.unpack e)
-    printf "  (loaded %d rows into items: %.1f ms)\n" o (it * 1000)
-    let targetCode = (o `div` 2) * 7 + 1
-    _ <-
-        benchSql
-            bench
-            "SELECT ... WHERE code = k (no index)"
-            (printf "SELECT id FROM items WHERE code = %d" targetCode)
-    _ <- benchSqlOnce bench "CREATE INDEX ON items (code)" "CREATE INDEX ON items (code)"
-    _ <-
-        benchSql
-            bench
-            "SELECT ... WHERE code = k (via index)"
-            (printf "SELECT id FROM items WHERE code = %d" targetCode)
-
-    putStrLn "\n[catalog stats]"
-    cat <- catalog (bSession bench)
-    case cat of
-        Left e -> printf "  failed to read stats: %s\n" (T.unpack e)
-        Right infos -> mapM_ printStats infos
-
-    putStrLn "\n[checks]"
-    let expectAge = 9 * (u `div` 100) + max 0 (u `mod` 100 - 90)
-    printf
-        "age > 90 matched %s (expected %d rows from the data distribution)\n"
-        (either T.unpack show ageR)
-        expectAge
-    when (u == o) $
-        printf
-            "JOIN matched %s (one order per user, should equal the line above = %d)\n"
-            (either T.unpack show joinR)
-            expectAge
-    unless (u == o) $
-        putStrLn "(users and orders differ in size; no simple formula, printing only)"
-    loadedCheck <- runSql bench "SELECT id FROM batch_t"
-    printf
-        "multi-row INSERT loaded %s rows (expected %d)\n"
-        (either T.unpack (show . qrRowCount) loadedCheck)
-        u
-    printf "secondary index: code = %d should find id = %d\n" targetCode (o `div` 2)
-    checkCount bench "batch_t" u
-    putStrLn "BENCHMARK_OK all scenarios completed"
-
--- | 基准用的库名
-benchDatabase :: String
-benchDatabase = "bench"
-
--- | 服务端没有默认库：先开一个库，再把之后的语句都落进它
-prepareDatabase :: Session -> IO ()
-prepareDatabase session = do
-    created <- runStatement session ("CREATE DATABASE " <> T.pack benchDatabase)
-    case created of
-        Left e -> die ("cannot create the benchmark database: " ++ T.unpack e)
-        Right _ -> do
-            used <- switchDatabase session (T.pack benchDatabase)
-            case used of
-                Left e -> die ("cannot select the benchmark database: " ++ T.unpack e)
-                Right () -> pure ()
-  where
-    -- | 报错退出
-    die message = do
-        putStrLn message
-        exitFailure
-
--- | 按平台补上 .exe 后缀
-binaryName :: String -> String
-binaryName stem = if os == "mingw32" then stem ++ ".exe" else stem
-
--- | 在 PATH 里找 server 可执行文件
-locateServerExe :: IO FilePath
-locateServerExe = do
-    found <- findExecutable (binaryName "chusql-server")
-    case found of
-        Just path -> pure path
-        Nothing -> do
-            putStrLn "chusql-server was not found on PATH: run `stack build` first"
-            exitFailure
-
--- | 在 PATH 里找引导程序（server 需要先引导）
-locateBootstrapExe :: IO FilePath
-locateBootstrapExe = do
-    found <- findExecutable (binaryName "csql-bootstrap")
-    case found of
-        Just path -> pure path
-        Nothing -> do
-            putStrLn "csql-bootstrap was not found on PATH: run `stack build` first"
-            exitFailure
-
--- | 从 server 输出里读出监听端口
-readListeningPort :: Handle -> IO Int
-readListeningPort handle = do
-    line <- hGetLine handle
-    case portFromBanner line of
-        Just port -> pure port
-        Nothing -> readListeningPort handle
-
--- | 取一行里最后一串数字
-portFromBanner :: String -> Maybe Int
-portFromBanner line
-    | not ("listening:" `isInfixOf` line) = Nothing
-    | otherwise = case span isDigit (dropWhile (not . isDigit) (reverse line)) of
-        ([], _) -> Nothing
-        (digits, _) -> Just (read (reverse digits))
-
--- | 判断子串是否出现
-isInfixOf :: String -> String -> Bool
-isInfixOf needle haystack = any (prefix needle) (tails haystack)
-  where
-    -- | 前缀匹配
-    prefix [] _ = True
-    prefix _ [] = False
-    prefix (x : xs) (y : ys) = x == y && prefix xs ys
-    -- | 所有后缀
-    tails [] = [[]]
-    tails s@(_ : rest) = s : tails rest
-
--- | 判断是不是数字字符
-isDigit :: Char -> Bool
-isDigit ch = ch >= '0' && ch <= '9'
-
--- | 把 server 的 stdout 抽干，免得管道塞满
-drainHandle :: Handle -> IO ()
-drainHandle handle = do
-    result <- try (hGetLine handle) :: IO (Either IOException String)
-    case result of
-        Left _ -> pure ()
-        Right _ -> drainHandle handle
-
--- | 起 server、连上去、登录、开库
-startBench :: IO Bench
-startBench = do
-    bin <- locateServerExe
-    tmp <- getTemporaryDirectory
-    stamp <- getMonotonicTime
-    let name = "benchmark4csql-" ++ show (round (stamp * 1e6) :: Int)
-        dataDir = tmp </> name
-        configPath = tmp </> (name ++ ".toml")
-        -- TOML 的普通字符串会吃反斜杠，路径统一用正斜杠
-        slashed = map (\c -> if c == '\\' then '/' else c) dataDir
-    createDirectoryIfMissing True dataDir
-    writeFile configPath (benchConfigText slashed)
-    printf "config   : %s\n" configPath
-    printf "data dir : %s\n" dataDir
-    bootstrap <- locateBootstrapExe
-    (bootCode, bootOut, bootErr) <- readProcessWithExitCode bootstrap ["--config", configPath, "--passwordless", "--user", "admin"] ""
-    case bootCode of
-        ExitSuccess -> printf "bootstrap: system catalog ready\n"
-        _ -> do
-            putStrLn ("the bootstrap program failed (exit " ++ show bootCode ++ "): " ++ bootOut ++ bootErr)
-            exitFailure
-    (_, Just out, _, process) <-
-        createProcess (proc bin ["--config", configPath, "--user", "admin"]){std_out = CreatePipe, std_err = NoStream}
-    port <- readListeningPort out
-    _ <- forkIO (drainHandle out)
-    printf "server   : pid launched, tcp port %d\n" port
-    linked <- connectClient "127.0.0.1" port
-    case linked of
-        Left err -> do
-            putStrLn ("cannot connect to the server: " ++ T.unpack err)
-            stopProcess process
-            exitFailure
-        Right client -> do
-            session <- newSession client
-            auth <- authenticateSession session (T.pack "admin") (T.pack "")
-            case auth of
-                Left err -> do
-                    putStrLn ("cannot sign in: " ++ T.unpack err)
-                    closeClient client
-                    stopProcess process
-                    exitFailure
-                Right () -> do
-                    prepareDatabase session
-                    pure (Bench process dataDir client session port configPath)
-
--- | 基准用的配置：随机端口、临时数据目录
-benchConfigText :: String -> String
-benchConfigText dataDir =
-    unlines
-        [ "[server]"
-        , "port = 0"
-        , ""
-        , "[storage]"
-        , "data_dir = \"" ++ dataDir ++ "\""
-        , ""
-        , "[log]"
-        , "level = \"error\""
-        ]
-
--- | 收摊：关会话、停 server、清数据目录
-stopBench :: Bench -> IO ()
-stopBench bench = do
-    putStrLn "\n[teardown] closing the TCP session, stopping the server, removing the data dir"
-    closeClient (bClient bench)
-    stopProcess (bProcess bench)
-    removeDirectoryRecursive (bDataDir bench)
-    removeFile (bConfigPath bench)
-
--- | 杀掉 server 进程
-stopProcess :: ProcessHandle -> IO ()
-stopProcess process = do
-    terminateProcess process
-    _ <- waitForProcess process
-    pure ()
-
--- | 主入口
-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"])
-    sizes <- mapM positiveSize values
-    (u, o) <- case sizes of
-        [usersSize, ordersSize] -> pure (usersSize, ordersSize)
-        _ -> ioError (userError "expected two benchmark sizes")
-    printf "full-chain benchmark: TCP client --> chusql-server --> in-process Rust storage\n"
-    printf "dataset  : users = %d rows, orders = %d rows\n" u o
-    printf "timing   : wall clock (monotonic); every statement runs the full chain over TCP\n"
-    printf "note     : the client no longer links the engine or the storage library\n"
-    bracket
-        (do
-            t1 <- getMonotonicTime
-            bench <- startBench
-            t2 <- getMonotonicTime
-            printf "\n[startup] server up, storage ready, signed in: %.2f s\n" (t2 - t1)
-            threadDelay 25000
-            pure bench
-        )
-        stopBench
-        (\bench -> runScenarios bench u o)
-
--- | 校验压力规模是至少一百的整数
-positiveSize :: String -> IO Int
-positiveSize raw = case readMaybe raw of
-    Just size | size >= 100 -> pure size
-    _ -> ioError (userError "benchmark row counts must be integers >= 100")
-
--- | 批量加载并报告每秒写入行数
-loadBatch :: Bench -> String -> String -> Int -> (Int -> String) -> IO ()
-loadBatch bench table columns count row = do
-    (milliseconds, ()) <- measure $ forM_ (chunked 500 count) $ \ids -> do
-        _ <- runSql bench ("INSERT INTO " ++ table ++ " (" ++ columns ++ ") VALUES " ++ intercalate "," (map row ids))
-        pure ()
-    printf "LOAD %-16s rows=%d total_ms=%.3f rows_s=%.2f\n" table count milliseconds (fromIntegral count * 1000 / milliseconds)
-
--- | 校验完整数据加载数量
-checkCount :: Bench -> String -> Int -> IO ()
-checkCount bench table expected = do
-    result <- runSql bench ("SELECT COUNT(*) FROM " ++ table)
-    case result of
-        Right rows | qrRows rows == [[VInt expected]] -> pure ()
-        _ -> ioError (userError ("count mismatch in " ++ table ++ ": " ++ show result))
-
--- | 用单调时钟测量动作耗时
-measure :: IO a -> IO (Double, a)
-measure action = do
-    start <- getMonotonicTime
-    result <- action >>= evaluate
-    end <- getMonotonicTime
-    pure ((end - start) * 1000, result)
-
--- | 打印均值分位数和请求吞吐量
-latencies :: String -> Int -> [Double] -> IO ()
-latencies label rows times = do
-    let ordered = sort times
-        count = length times
-        total = sum times
-        -- | 按最近秩取分位数
-        percentile fraction = ordered !! (ceiling (fraction * fromIntegral count) - 1)
-    printf "CASE %-24s n=%d rows=%d mean_ms=%.3f p50_ms=%.3f p95_ms=%.3f max_ms=%.3f ops_s=%.2f\n" label count rows (total / fromIntegral count) (percentile (0.5 :: Double)) (percentile (0.95 :: Double)) (last ordered) (fromIntegral count * 1000 / total)
-
--- | 预热后反复测量并校验结果行数
-sampleQuery :: Bench -> String -> String -> Int -> IO ()
-sampleQuery bench label statement expected = do
-    -- | 执行一次并校验结果数量
-    let action = do
-            result <- runSql bench statement
-            case result of
-                Right rows | qrRowCount rows == expected -> pure ()
-                _ -> ioError (userError (label ++ ": result mismatch " ++ show result))
-    _ <- action
-    times <- replicateM 7 (fst <$> measure action)
-    latencies label expected times
-
--- | 运行索引聚合连接事务与并发压力
-pressureScenarios :: Bench -> Int -> Int -> IO ()
-pressureScenarios bench u o = do
-    putStrLn "\n[pressure: one warmup, seven measured samples per read case]"
-    let selected = length [() | i <- [1 .. o], (1 + (i - 1) `mod` u) `mod` 100 > 90]
-        point = printf "SELECT id FROM users WHERE name = 'user%d'" (u `div` 2)
-    sampleQuery bench "scan_users" "SELECT * FROM users" u
-    sampleQuery bench "scan_orders" "SELECT * FROM orders" o
-    sampleQuery bench "id_point" (printf "SELECT id FROM users WHERE id = %d" (u `div` 2)) 1
-    sampleQuery bench "name_scan" point 1
-    _ <- benchSqlOnce bench "CREATE INDEX users(name)" "CREATE INDEX ON users (name)"
-    sampleQuery bench "name_index" point 1
-    sampleQuery bench "id_range100" "SELECT id FROM users WHERE id >= 1 AND id <= 100" 100
-    sampleQuery bench "sort_top100" "SELECT name FROM users ORDER BY age DESC LIMIT 100" 100
-    sampleQuery bench "group100" "SELECT age, COUNT(*) FROM users GROUP BY age" 100
-    sampleQuery bench "filtered_join" "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 90" selected
-    sampleQuery bench "derived_join" "SELECT d.name FROM (SELECT id,name FROM users WHERE age > 90) d JOIN orders o ON d.id = o.user_id" selected
-    sampleQuery bench "cte_group" "WITH ages AS (SELECT age FROM users) SELECT age, COUNT(*) FROM ages GROUP BY age" 100
-    sampleQuery bench "scalar_subquery" "SELECT name, (SELECT COUNT(*) FROM orders) FROM users LIMIT 100" 100
-    sampleQuery bench "correlated_exists20" "SELECT u.name FROM (SELECT id,name FROM users WHERE id <= 20) u WHERE EXISTS (SELECT id FROM orders o WHERE o.user_id = u.id)" 20
-    _ <- runSql bench "CREATE TABLE wide (id int, payload str)"
-    loadBatch bench "wide" "id,payload" (min 5000 u) (\i -> printf "(%d,'%s')" i (replicate 512 'x'))
-    checkCount bench "wide" (min 5000 u)
-    sampleQuery bench "scan_wide512B" "SELECT * FROM wide" (min 5000 u)
-    mapM_ (concurrentLookup bench) [1, 4, 8]
-    _ <- 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
-        (beginMs, _) <- measure (runSql bench "BEGIN")
-        (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))
-        (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
-    _ <- benchSqlOnce bench "UPDATE writes (400 rows)" "UPDATE writes SET age = age + 1"
-    _ <- runSql bench "BEGIN"
-    _ <- benchSqlOnce bench "transaction UPDATE (400 rows)" "UPDATE writes SET age = 0"
-    _ <- benchSqlOnce bench "ROLLBACK 400 changed rows" "ROLLBACK"
-    restored <- runSql bench "SELECT age FROM writes WHERE id = 1"
-    unless (fmap qrRows restored == Right [[VInt 2]]) (ioError (userError "rollback value mismatch"))
-    _ <- benchSqlOnce bench "DELETE writes (200 rows)" "DELETE FROM writes WHERE id > 200"
-    checkCount bench "writes" 200
-    putStrLn "PRESSURE_OK all result checks passed"
-
--- | 用多条独立会话同步开始点查
-concurrentLookup :: Bench -> Int -> IO ()
-concurrentLookup bench workers = do
-    completions <- replicateM
-                     workers
-                     (do start <- newEmptyMVar
-                         done <- newEmptyMVar
-                         client <- connectClient "127.0.0.1" (bPort bench)
-                                     >>= either (ioError . userError . T.unpack) pure
-                         session <- newSession client
-                         authenticateSession session "admin" ""
-                           >>= either (ioError . userError . T.unpack) pure
-                         switchDatabase session "bench"
-                           >>= either (ioError . userError . T.unpack) pure
-                         _ <- forkFinally
-                                (takeMVar start
-                                   >>
-                                     bracket
-                                       (pure client) closeClient
-                                       (\ _
-                                          -> replicateM
-                                               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
-    times <- concat <$> mapM (either throwIO pure) results
-    latencies ("concurrent" ++ show workers ++ "_point") 1 times
-    printf "CONCURRENT workers=%d ops=%d wall_ms=%.3f aggregate_ops_s=%.2f\n" workers (workers * 100) milliseconds (fromIntegral (workers * 100) * 1000 / milliseconds)

benchmark/stack.yaml

@@ -1,12 +0,0 @@
-resolver: lts-24.59
-
-extra-lib-dirs:
-    - ../chusql-core/storage/target/release
-
-packages:
-    - .
-    - ../chusql-core/engine
-    - ../chusql-core/model
-    - ../chusql-interface
-    - ../chusql-server
-    - ../chusql-bootstrap

benchmark/stack.yaml.lock

@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/topics/lock_files
-
-packages: []
-snapshots:
-- completed:
-    sha256: 0f728e30e843d7f00460ad56858b995a3b227fca683659c7df9f2fc3988a3ce1
-    size: 732465
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/59.yaml
-  original: lts-24.59

chusql-bootstrap/app/Main.hs

@@ -1,167 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main (main) where
-
-import Data.Maybe (fromMaybe)
-import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
-import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
-import ChuSQL.Core.Engine.Storage.FFI (maintainStorage)
-import ChuSQL.Interface.Auth (hashPassword)
-import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName)
-import ChuSQL.Interface.TOML (resolveConfigPath)
-import qualified Data.Aeson as A
-import qualified Data.ByteString.Lazy.Char8 as BL
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import Control.Exception (finally)
-import System.Environment (getArgs)
-import System.Exit (exitFailure)
-import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
-
--- 引导程序：初始化系统库、管理员身份与内置类型目录。
-
-data Options = Options
-    { optConfig :: Maybe FilePath
-    , optUser :: Maybe String
-    , optPasswordStdin :: Bool
-    , optPasswordless :: Bool
-    , optHelp :: Bool
-    , optMode :: Maybe String
-    }
-
--- | 全部选项都取默认值
-emptyOptions :: Options
-emptyOptions =
-    Options
-        { optConfig = Nothing
-        , optUser = Nothing
-        , optPasswordStdin = False
-        , optPasswordless = False
-        , optHelp = False
-        , optMode = Nothing
-        }
-
--- | 解析参数
-parseArgs :: [String] -> Either String Options
-parseArgs = go emptyOptions
-  where
-    -- | 逐条消费参数列表
-    go opts [] = Right opts
-    go opts (command : rest)
-        | command `elem` ["repair", "recover", "recovery", "reset"] = case optMode opts of
-            Nothing -> go opts{optMode = Just (if command == "recovery" then "recover" else command)} rest
-            Just _ -> Left "only one maintenance command is allowed"
-    go opts ("--help" : rest) = go opts{optHelp = True} rest
-    go opts ("-h" : rest) = go opts{optHelp = True} rest
-    go opts ("--config" : v : rest) = go opts{optConfig = Just v} rest
-    go opts ("--user" : v : rest) = go opts{optUser = Just v} rest
-    go opts ("--password-stdin" : rest) = go opts{optPasswordStdin = True} rest
-    go opts ("--passwordless" : rest) = go opts{optPasswordless = True} rest
-    go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)
-
--- | 打印用法说明
-usage :: IO ()
-usage = do
-    putStrLn "usage: csql-bootstrap [repair|recover|recovery|reset] [options]"
-    putStrLn "  repair    repair structures; abort if data recovery or initialization is needed"
-    putStrLn "  recover   replay WAL and recover system metadata; recovery is an alias"
-    putStrLn "  reset     replace system identities and grants with initial defaults"
-    putStrLn "Stop all database processes first. Maintenance preserves the old system directory."
-    putStrLn ""
-    putStrLn "config: settings.toml sits at a fixed place (Windows: %APPDATA%\\ChuSQL\\settings.toml;"
-    putStrLn "        other: $XDG_CONFIG_HOME/ChuSQL/settings.toml), the same file the server reads"
-    putStrLn ""
-    putStrLn "  --config FILE          read that config file instead"
-    putStrLn "  --user NAME            administrator name          (default root)"
-    putStrLn "  --password-stdin       read the administrator password from one line of stdin"
-    putStrLn "  --passwordless         leave the administrator without a password"
-    putStrLn ""
-    putStrLn "what it does: initializes the system database, an enabled login superuser and"
-    putStrLn "  the preinstalled builtin type directory, then exits. Existing passwords and"
-    putStrLn "  matching type definitions are preserved; conflicting definitions fail."
-
--- | 入口
-main :: IO ()
-main = do
-    hSetBuffering stdout LineBuffering
-    args <- getArgs
-    case parseArgs args of
-        Left err -> do
-            putStrLn ("bad arguments: " ++ err)
-            usage
-            exitFailure
-        Right opts
-            | optHelp opts -> usage
-            | otherwise -> run opts
-
--- | 读取配置和口令并完成安装引导
-run :: Options -> IO ()
-run opts | Just mode <- optMode opts = runMaintenance opts mode
-run opts = do
-    configPath <- resolveConfigPath (optConfig opts)
-    base <- loadWebConfigAt configPath
-    let name = maybe (rootUserName base) T.pack (optUser opts)
-    chosen <- readPassword opts
-    case chosen of
-        Left err -> do
-            putStrLn ("!! " ++ err)
-            usage
-            exitFailure
-        Right plain -> do
-            encoded <- if T.null plain then pure "" else hashPassword plain
-            putStrLn "================== ChuSQL Bootstrap ================="
-            putStrLn ("config file:   " ++ configPath)
-            putStrLn ("administrator: " ++ T.unpack name)
-            putStrLn
-                ( if T.null encoded
-                    then "password:      none yet (sign in with an empty one, then set it)"
-                    else "password:      set (stored hashed in the system table)"
-                )
-            opened <- localStorageLink (Just configPath)
-            case opened of
-                Left err -> failWith ("cannot open the storage library: " ++ err)
-                Right link -> do
-                    setStorageLink link
-                    result <- runBootstrap send name encoded `finally` closeConnection
-                    case result of
-                        Left err -> failWith ("bootstrap failed: " ++ err)
-                        Right count -> do
-                            putStrLn "system catalog: ready"
-                            putStrLn "administrator identity: LOGIN SUPERUSER ENABLED"
-                            putStrLn ("preinstalled types: ready (" ++ show count ++ " definitions)")
-
--- | 在离线维护入口执行所选策略
-runMaintenance :: Options -> String -> IO ()
-runMaintenance opts mode = do
-    path <- resolveConfigPath (optConfig opts)
-    chosen <- if mode == "reset" || optPasswordStdin opts || optPasswordless opts then readPassword opts else pure (Right "")
-    case chosen of
-        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..= 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
-                Right value -> BL.putStrLn (BL.fromStrict value)
-
--- | 通过存储链路发送引导请求
-send :: A.Value -> IO (Either String A.Value)
-send request = do
-    reply <- sendRawRequest (BL.toStrict (A.encode request))
-    pure (reply >>= A.eitherDecodeStrict)
-
--- | 读口令：stdin 一行，空行等于不设口令
-readPassword :: Options -> IO (Either String Text)
-readPassword opts
-    | optPasswordless opts = pure (Right "")
-    | optPasswordStdin opts = do Right . T.dropWhileEnd (\ c -> c == '\r' || c == '\n')
-                                   <$> TIO.getLine
-    | otherwise = pure (Left "pass --password-stdin or --passwordless")
-
--- | 打印错误并退出 1
-failWith :: String -> IO a
-failWith message = do
-    putStrLn ("!! " ++ message)
-    exitFailure

chusql-bootstrap/chusql-bootstrap.cabal

@@ -1,43 +0,0 @@
-cabal-version: 2.4
-
-name:           chusql-bootstrap
-version:        1.0.0
-synopsis:       ChuSQL system catalog initialization and offline maintenance
-description:    Initializes the system catalog, administrator identity, and builtin
-                type registry during installation, preserving existing passwords
-                and validating type definitions. Provides offline structure repair,
-                WAL recovery, and system catalog reset commands.
-build-type:     Simple
-
-library
-    hs-source-dirs: src
-    exposed-modules: ChuSQL.Bootstrap
-    build-depends: base >= 4.14 && < 5, aeson, chusql-core-model, text
-    default-language: Haskell2010
-    ghc-options: -Wall
-
-executable csql-bootstrap
-    hs-source-dirs:   app
-    main-is:          Main.hs
-    build-depends:    base >= 4.14 && < 5
-                    , aeson
-                    , bytestring
-                    , chusql-core-engine
-                    , chusql-interface
-                    , chusql-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
-    hs-source-dirs: test
-    main-is: Spec.hs
-    build-depends: base >= 4.14 && < 5, aeson, bytestring, chusql-bootstrap,
-                   chusql-core-engine, chusql-core-model, directory, filepath, hspec, text
-    default-language: Haskell2010
-    ghc-options: -Wall

chusql-bootstrap/src/ChuSQL/Bootstrap.hs

@@ -1,77 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Bootstrap (preinstalledTypes, runBootstrap) where
-
-import ChuSQL.Core.Model (ColumnType (..), typeName)
-import ChuSQL.Core.Protocol (Account (..))
-import qualified Data.Aeson as A
-import qualified Data.Aeson.KeyMap as KM
-import Data.Foldable (toList)
-import Data.Text (Text)
-import qualified Data.Text as T
-
--- 引导系统身份与预装类型，校验已有定义并保留口令。
-
--- | 现有内置类型及其默认参数
-preinstalledTypes :: [A.Value]
-preinstalledTypes = map definition
-    [ ("int", CInt, False), ("integer", CInt, False)
-    , ("bigint", CBigInt, False), ("smallint", CSmallInt, False)
-    , ("varchar", CStr, True), ("char", CChar 1, True)
-    , ("text", CStr, False), ("str", CStr, False)
-    , ("boolean", CBool, False), ("bool", CBool, False)
-    , ("float", CFloat, False), ("real", CFloat, False), ("double", CDouble, False)
-    , ("decimal", CDecimal 10 0, True), ("numeric", CDecimal 10 0, True)
-    , ("date", CDate, False), ("timestamp", CTimestamp, False), ("blob", CBlob, False)
-    ]
-  where
-    -- | 编码类型的名称与基础表示
-    definition :: (Text, ColumnType, Bool) -> A.Value
-    definition (name, base, parameterized) = A.object
-        ["name" A..= name, "base_type" A..= typeName base, "parameterized" A..= parameterized]
-
--- | 依次引导身份、迁移目录并预装类型
-runBootstrap :: (A.Value -> IO (Either String A.Value)) -> Text -> Text -> IO (Either String Int)
-runBootstrap send name encoded = do
-    initialized <- send (A.object ["method" A..= ("bootstrap_system" :: Text), "user" A..= name, "password_hash" A..= encoded])
-    case expect "system" initialized >>= initializedCatalog of
-        Left err -> pure (Left err)
-        Right () -> do
-            migrated <- send (A.object ["method" A..= ("identity_initialize" :: Text), "administrator" A..= name])
-            case expect "accounts" migrated >>= administrator of
-                Left err -> pure (Left err)
-                Right () -> do
-                    installed <- send (A.object ["method" A..= ("bootstrap_types" :: Text), "types" A..= preinstalledTypes])
-                    pure (expect "rows" installed >>= installedTypes)
-  where
-    -- | 确认系统目录已初始化
-    initializedCatalog fields
-        | KM.lookup "initialized" fields == Just (A.Bool True) = Right ()
-        | otherwise = Left "system catalog is not initialized"
-    -- | 确认所选引导身份可以管理系统
-    administrator fields = case KM.lookup "accounts" fields of
-        Nothing -> Left "missing identity directory"
-        Just value -> case A.fromJSON value :: A.Result [Account] of
-            A.Error _ -> Left "invalid identity directory"
-            A.Success accounts
-                | any (\a -> accountUser a == T.toLower name && accountCanLogin a && accountEnabled a && accountIsSuperuser a) accounts -> Right ()
-                | otherwise -> Left "bootstrap identity is not an enabled login superuser; existing identities were preserved"
-    -- | 确认全部预装类型存在且定义一致
-    installedTypes fields = case KM.lookup "rows" fields of
-        Just (A.Array rows)
-            | all (\definition -> any (matches definition) (toList rows)) preinstalledTypes -> Right (length rows)
-            | otherwise -> Left "preinstalled type verification failed"
-        _ -> Left "missing preinstalled type directory"
-    -- | 比对类型定义并检查持久化编号
-    matches (A.Object definition) (A.Object saved) = all (\(key, value) -> KM.lookup key saved == Just value) (KM.toList definition)
-        && case KM.lookup "id" saved of Just (A.Number n) -> n > 0; _ -> False
-    matches _ _ = False
-
--- | 校验响应状态并返回明确错误
-expect :: Text -> Either String A.Value -> Either String (KM.KeyMap A.Value)
-expect _ (Left err) = Left err
-expect status (Right (A.Object fields))
-    | KM.lookup "status" fields == Just (A.String status) = Right fields
-    | Just (A.String err) <- KM.lookup "message" fields = Left (T.unpack err)
-    | otherwise = Left ("unexpected bootstrap response; expected " ++ T.unpack status)
-expect _ (Right _) = Left "invalid bootstrap response"

chusql-bootstrap/stack.yaml

@@ -1,10 +0,0 @@
-resolver: lts-24.59
-
-extra-lib-dirs:
-    - ../chusql-core/storage/target/release
-
-packages:
-    - .
-    - ../chusql-core/engine
-    - ../chusql-core/model
-    - ../chusql-interface

chusql-bootstrap/stack.yaml.lock

@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/topics/lock_files
-
-packages: []
-snapshots:
-- completed:
-    sha256: 0f728e30e843d7f00460ad56858b995a3b227fca683659c7df9f2fc3988a3ce1
-    size: 732465
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/59.yaml
-  original: lts-24.59

chusql-bootstrap/test/Spec.hs

@@ -1,135 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main (main) where
-
-import Data.Maybe (fromMaybe)
-import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
-import ChuSQL.Core.Protocol (Account (..))
-import ChuSQL.Core.Model (columnType, typeName)
-import ChuSQL.Core.Engine.Syntax.AST (Statement (CreateTable))
-import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
-import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
-import Control.Exception (finally)
-import qualified Data.Aeson as A
-import qualified Data.Aeson.KeyMap as KM
-import qualified Data.ByteString.Lazy as BL
-import Data.IORef (newIORef, readIORef, modifyIORef')
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Unique (hashUnique, newUnique)
-import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly)
-import System.FilePath ((</>))
-import Test.Hspec
-
--- 引导测试：身份属性、类型清单、错误停止与真实持久化。
-
--- | 执行引导模块测试
-main :: IO ()
-main = hspec $ do
-    describe "bootstrap plan" $ do
-        it "registers every builtin alias with its parser defaults" $ mapM_ checkDefinition preinstalledTypes
-        it "initializes identities before installing types" $ do
-            (send, requests) <- mock [Right ready, Right (identity True), Right installed]
-            runBootstrap send "root" "new-hash" `shouldReturn` Right 18
-            calls <- requests
-            map (field "method") calls `shouldBe` map A.String ["bootstrap_system", "identity_initialize", "bootstrap_types"]
-        mapM_ (\(title, replies, err) -> it title (expectBootstrapFailure replies err))
-            [ ("stops on storage errors", [Left "storage unavailable"], "storage unavailable")
-            , ("rejects an uninitialized system response", [Right (A.object ["status" A..= ("system" :: Text), "initialized" A..= False])], "system catalog is not initialized")
-            , ("preserves a demoted identity and stops before type installation", [Right ready, Right (identity False)], "bootstrap identity is not an enabled login superuser; existing identities were preserved")
-            , ("reports type definition conflicts explicitly", [Right ready, Right (identity True), Right (A.object ["status" A..= ("error" :: Text), "message" A..= ("type conflict" :: Text)])], "type conflict")
-            , ("refuses incomplete type registration", [Right ready, Right (identity True), Right (A.object ["status" A..= ("rows" :: Text), "rows" A..= ([] :: [A.Value])])], "preinstalled type verification failed")
-            ]
-    describe "bootstrap on real storage" $ do
-        it "creates root and eighteen types before any server starts" $ withStorage $ do
-            runBootstrap transport "root" "original-hash" `shouldReturn` Right 18
-            result <- transport (A.object ["method" A..= ("accounts_list" :: Text)])
-            case result of
-                Left err -> expectationFailure err
-                Right value -> case A.fromJSON (field "accounts" value) :: A.Result [Account] of
-                    A.Error err -> expectationFailure err
-                    A.Success [account] -> do
-                        accountUser account `shouldBe` "root"
-                        accountCanLogin account `shouldBe` True
-                        accountEnabled account `shouldBe` True
-                        accountIsSuperuser account `shouldBe` True
-                        accountHash account `shouldBe` "original-hash"
-                    A.Success _ -> expectationFailure "unexpected identities"
-        it "keeps the existing password and type definitions on rerun" $ withStorage $ do
-            runBootstrap transport "root" "original-hash" `shouldReturn` Right 18
-            first <- transport (A.object ["method" A..= ("accounts_list" :: Text)])
-            runBootstrap transport "root" "replacement-hash" `shouldReturn` Right 18
-            transport (A.object ["method" A..= ("accounts_list" :: Text)]) `shouldReturn` first
-
--- | 校验引导错误及停止请求的位置
-expectBootstrapFailure :: [Either String A.Value] -> String -> Expectation
-expectBootstrapFailure replies err = do
-    (send, requests) <- mock replies
-    runBootstrap send "root" "hash" `shouldReturn` Left err
-    fmap length requests `shouldReturn` length replies
-
--- | 校验预装定义与 SQL 默认类型一致
-checkDefinition :: A.Value -> IO ()
-checkDefinition value = case (field "name" value, field "base_type" value) of
-    (A.String name, A.String base) -> case parseStatement ("CREATE TABLE seeded (value " ++ T.unpack name ++ ")") of
-        Right (CreateTable _ [(_, column)]) -> T.pack (typeName (columnType column)) `shouldBe` base
-        other -> expectationFailure (show other)
-    _ -> expectationFailure "invalid builtin definition"
-
--- | 系统目录的成功响应
-ready :: A.Value
-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 False]]
-
--- | 已写入编号的类型响应
-installed :: A.Value
-installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= zipWith (curry numbered) [1 :: Int .. ] preinstalledTypes]
-  where
-    -- | 给预装定义添加持久化编号
-    numbered (n, A.Object fields) = A.Object (KM.insert "id" (A.toJSON n) fields)
-    numbered (_, value) = value
-
--- | 读取响应中的一个字段
-field :: A.Key -> A.Value -> A.Value
-field key (A.Object fields) = fromMaybe A.Null (KM.lookup key fields)
-field _ _ = A.Null
-
--- | 记录请求并返回指定响应
-mock :: [Either String A.Value] -> IO (A.Value -> IO (Either String A.Value), IO [A.Value])
-mock replies = do
-    calls <- newIORef []
-    queuedReplies <- newIORef replies
-    let
-        -- | 消费一条模拟响应
-        send request = do
-            modifyIORef' calls (++ [request])
-            remaining <- readIORef queuedReplies
-            case remaining of
-                [] -> pure (Left "unexpected request")
-                reply : rest -> modifyIORef' queuedReplies (const rest) >> pure reply
-    pure (send, readIORef calls)
-
--- | 通过动态库存储链路发送请求
-transport :: A.Value -> IO (Either String A.Value)
-transport request = do
-    reply <- sendRawRequest (BL.toStrict (A.encode request))
-    pure (reply >>= A.eitherDecodeStrict)
-
--- | 在独立临时目录运行真实引导
-withStorage :: IO () -> IO ()
-withStorage action = do
-    tmp <- getTemporaryDirectory
-    unique <- hashUnique <$> newUnique
-    let directory = tmp </> ("chusql-bootstrap-" ++ show unique)
-        config = directory </> "settings.toml"
-    createDirectoryIfMissing True directory
-    writeFile config ("[storage]\ndata_dir = \"" ++ map (\c -> if c == '\\' then '/' else c) directory ++ "\"\n")
-    opened <- localStorageLink (Just config)
-    case opened of
-        Left err -> removePathForcibly directory >> expectationFailure err
-        Right link -> do
-            setStorageLink link
-            action `finally` (closeConnection >> removePathForcibly directory)

chusql-cli/app/Main.hs

@@ -1,186 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-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, when)
-import Data.IORef (IORef, newIORef)
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Options.Applicative
-import Repl (reportError, runRepl, runStatementOnce)
-import System.Console.Haskeline (defaultSettings, getPassword, runInputT)
-import System.Directory (getHomeDirectory)
-import System.Exit (exitFailure)
-import System.FilePath ((</>))
-import System.IO (hFlush, hIsTerminalDevice, hPutStr, hSetEncoding, stderr, stdin, stdout, utf8)
-
--- chusql-cli：与 Web 管理端并列的前端，接到拥有存储的 server 上跑 SQL，账号与 Web 共用。
-
-data Options = Options
-    { optUser :: Maybe Text
-    , optDatabase :: Text
-    , optFormat :: OutputFormat
-    , optExecute :: Maybe Text
-    , optHistory :: Maybe FilePath
-    , optConfig :: Maybe FilePath
-    , optNormalize :: Maybe Text
-    , optDeclaration :: Maybe FilePath
-    , optSudo :: Bool
-    }
-
--- | 命令行参数解析器
-optionsParser :: Parser Options
-optionsParser =
-    Options
-        <$> optional (T.pack <$> strOption (long "user" <> short 'u' <> metavar "USER" <> help "Sign in as this account (default: root)"))
-        <*> ( T.pack
-                <$> strOption
-                    ( long "database"
-                        <> short 'd'
-                        <> metavar "DB"
-                        <> value ""
-                        <> help "Database to use (default: none, select one with USE)"
-                    )
-            )
-        <*> option
-            (eitherReader formatReader)
-            ( long "format"
-                <> short 'f'
-                <> metavar "FORMAT"
-                <> value FormatTable
-                <> showDefaultWith (T.unpack . formatName)
-                <> 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 "text" = Right FormatTable
-formatReader raw = maybe (Left "format must be table, text, json or csv") Right (parseFormat (T.pack raw))
-
--- | 命令行界面与帮助
-parserInfo :: ParserInfo Options
-parserInfo =
-    info
-        (optionsParser <**> helper)
-        ( fullDesc
-            <> progDesc "Run SQL against the ChuSQL storage engine"
-            <> header "csql - the ChuSQL command line client"
-        )
-
--- | 解析参数、登录 server 后进入会话
-main :: IO ()
-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 (if optSudo options then scSudoUser config else rootName) (optUser options)
-    credential <- if optSudo options then do
-        when (T.null userName)
-          $ reportError "sudo_auth_user is not configured" >> exitFailure
-        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 credential
-                `finally` closeClient client
-
--- | 连 server、登录，之后转入会话
-connect :: Options -> Client -> Text -> Text -> Maybe SudoCredential -> IO ()
-connect options client userName password credential = do
-    session <- newSession client
-    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
-
--- | 执行 -e 的单条语句，否则进交互循环
-runSession :: Options -> Session -> IO ()
-runSession options session = do
-    formatRef <- newIORef (optFormat options)
-    ready <- selectDatabase session (T.strip (optDatabase options))
-    if not ready
-        then exitFailure
-        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
-    Nothing -> do
-        historyFile <- resolveHistory (optHistory options)
-        runRepl session formatRef historyFile
-
--- | -d 指定了库才切，否则保持未选库
-selectDatabase :: Session -> Text -> IO Bool
-selectDatabase _ wanted | T.null wanted = pure True
-selectDatabase session wanted
-    | not (isPlainIdentifier wanted) = reportError ("not a plain database name: " <> wanted) >> pure False
-    | otherwise = do
-        switched <- switchDatabase session wanted
-        case switched of
-            Left message -> reportError message >> pure False
-            Right () -> pure True
-
--- | 交互式读取口令；直接回车表示空口令
-promptPassword :: Text -> IO Text
-promptPassword user = do
-    terminal <- hIsTerminalDevice stdin
-    if terminal
-        then do
-            entered <- runInputT defaultSettings (getPassword (Just '*') (T.unpack user <> "'s password: "))
-            pure (maybe "" T.pack entered)
-        else do
-            hPutStr stderr (T.unpack user <> "'s password: ")
-            hFlush stderr
-            readPasswordInput stdin
-
--- | 取历史文件路径，没给就用默认
-resolveHistory :: Maybe FilePath -> IO (Maybe FilePath)
-resolveHistory (Just path) = pure (Just path)
-resolveHistory Nothing = do
-    home <- getHomeDirectory
-    pure (Just (home </> ".chusql_history"))

chusql-cli/app/Repl.hs

@@ -1,197 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Repl
-    ( runRepl
-    , runStatementOnce
-    , reportError
-    ) where
-
-import ChuSQL.CLI.Normalization (runNormalizationOnce)
-import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
-import ChuSQL.CLI.History (historySettings, rememberStatement)
-import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
-import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
-import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
-import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
-import Control.Monad (forM_, when, unless)
-import Control.Monad.IO.Class (liftIO)
-import Data.IORef (IORef, readIORef, writeIORef)
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import System.Console.Haskeline
-import System.IO (hIsTerminalDevice, stderr, stdin)
-
--- 交互层：提示符、多行输入、历史、元命令与错误提示。
-
--- | 交互循环，没有历史文件就不落盘
-runRepl :: Session -> IORef OutputFormat -> Maybe FilePath -> IO ()
-runRepl session formatRef historyPath =
-    runInputT (historySettings historyPath) (loop session formatRef T.empty)
-
--- | 入口处直接报错（-e 与启动阶段用）
-reportError :: Text -> IO ()
-reportError message = do
-    TIO.hPutStrLn stderr ("chusql: error: " <> message)
-    forM_ (errorHint message) (\hint -> TIO.hPutStrLn stderr ("hint: " <> hint))
-
--- | 跑一条语句并按格式打印；成功与否当退出码
-runStatementOnce :: Session -> OutputFormat -> Text -> IO Bool
-runStatementOnce session format sql = do
-    result <- runStatement session sql
-    case result of
-        Left message -> reportError message >> pure False
-        Right answer -> TIO.putStrLn (renderResult format answer) >> pure True
-
--- | 读一行输入，分派到元命令或语句缓冲
-loop :: Session -> IORef OutputFormat -> Text -> InputT IO ()
-loop session formatRef buffer = do
-    prompt <- liftIO (promptFor session buffer)
-    entered <- getInputLine (T.unpack prompt)
-    case entered of
-        Nothing -> do
-            interactive <- liftIO (hIsTerminalDevice stdin)
-            when interactive (outputStrLn "")
-        Just raw -> do
-            let line = T.strip (T.pack raw)
-            if T.null line
-                then loop session formatRef buffer
-                else case (T.null buffer, parseMeta line) of
-                    (True, Just meta) -> do
-                        rememberStatement line
-                        again <- runMeta session formatRef meta
-                        when again (loop session formatRef T.empty)
-                    _ -> do
-                        let extended = if T.null buffer then line else buffer <> "\n" <> line
-                        remaining <- drain session formatRef extended
-                        loop session formatRef remaining
-
--- | 生成提示符；续行与非终端输入另有样式
-promptFor :: Session -> Text -> IO Text
-promptFor session buffer = do
-    interactive <- hIsTerminalDevice stdin
-    if not interactive
-        then pure ""
-        else
-            if not (T.null (T.strip buffer))
-                then pure "     -> "
-                else do
-                    current <- sessionDatabase session
-                    pure (if T.null current then "chusql> " else "chusql [" <> current <> "]> ")
-
--- | 把攒下来的内容里所有完整语句依次执行，返回没写完的残余
-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
-        unless (T.null statement) $ do
-            rememberStatement (statement <> ";")
-            runOne session formatRef statement
-        drain session formatRef rest
-
--- | 执行一条语句并打印结果
-runOne :: Session -> IORef OutputFormat -> Text -> InputT IO ()
-runOne session formatRef statement = do
-    result <- liftIO (runStatement session statement)
-    case result of
-        Left message -> liftIO (reportError message)
-        Right answer -> do
-            format <- liftIO (readIORef formatRef)
-            outputStrLn (T.unpack (renderResult format answer))
-
--- | 执行元命令，返回是否继续循环
-runMeta :: Session -> IORef OutputFormat -> Meta -> InputT IO Bool
-runMeta session formatRef meta = case meta of
-    MetaQuit -> pure False
-    MetaHelp -> outputStrLn (T.unpack metaHelp) >> pure True
-    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)
-        case switched of
-            Left message -> liftIO (reportError message)
-            Right () -> outputStrLn ("database is now " <> T.unpack name)
-        pure True
-    MetaSetFormat format -> do
-        liftIO (writeIORef formatRef format)
-        outputStrLn ("output format is now " <> T.unpack (formatName format))
-        pure True
-    MetaUnknown name -> outputStrLn ("unknown command: \\" <> T.unpack name <> " (try \\?)") >> pure True
-
--- | \l：库清单
-listDatabases :: Session -> InputT IO ()
-listDatabases session = do
-    answer <- liftIO (databases session)
-    case answer of
-        Left message -> liftIO (reportError message)
-        Right names -> outputStrLn (T.unpack (renderRows ["database"] (map (: []) names)))
-
--- | \dt：表清单（含 server 补的账号表）
-listTables :: Session -> InputT IO ()
-listTables session = do
-    answer <- liftIO (catalog session)
-    case answer of
-        Left message -> liftIO (reportError message)
-        Right tables -> outputStrLn (T.unpack (renderRows headers (map tableRow tables)))
-  where
-    headers = ["table", "columns", "rows", "indexes"]
-    -- | 把表信息排成一行
-    tableRow info =
-        [ T.pack (tiTable info)
-        , tshow (length (tiColumns info))
-        , tshow (tiRows info)
-        , if null (tiIndexes info) then "-" else T.intercalate ", " (map T.pack (tiIndexes info))
-        ]
-
--- | \d <table>：列结构
-describeTable :: Session -> Text -> InputT IO ()
-describeTable session name = do
-    answer <- liftIO (catalog session)
-    case answer of
-        Left message -> liftIO (reportError message)
-        Right tables ->
-            case filter (matches name) tables of
-                [] -> liftIO (reportError ("unknown table: " <> name))
-                (info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
-  where
-    headers = ["column", "type", "primary", "unique", "nullable", "auto"]
-    -- | 表名忽略大小写比较
-    matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
-    -- | 把列信息排成一行
-    columnRow column =
-        [ T.pack (scName column)
-        , T.pack (scType column)
-        , yesNo (scPrimaryKey column)
-        , yesNo (scUnique column)
-        , yesNo (scNullable column)
-        , yesNo (scAutoIncrement column)
-        ]
-    -- | 布尔值转成 yes/no
-    yesNo True = "yes"
-    yesNo False = "no"
-
--- | \dr：角色清单（授权对象与成员）
-listRoles :: Session -> InputT IO ()
-listRoles session = do
-    answer <- liftIO (roleViews session)
-    case answer of
-        Left message -> liftIO (reportError message)
-        Right roles -> outputStrLn (T.unpack (renderRows ["role", "grants", "members"] (map roleRow roles)))
-  where
-    -- | 把角色信息排成一行
-    roleRow view =
-        [ roleName view
-        , if null (roleGrants view) then "-" else T.intercalate ", " (map grantText (roleGrants view))
-        , if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view)
-        ]
-    -- | 拼一条授权说明
-    grantText grant = grantPrivilege grant <> " on " <> grantObject grant <> optionText grant
-    -- | 带转授权时补一段说明
-    optionText grant = if grantable grant then " with grant option" else ""
-
--- | 用 show 转成 Text
-tshow :: Show a => a -> Text
-tshow = T.pack . show

chusql-cli/chusql-cli.cabal

@@ -1,66 +0,0 @@
-cabal-version: 2.4
-
-name:           chusql-cli
-version:        1.0.0
-synopsis:       ChuSQL command-line client for the database server
-description:    Provides a command-line interface for SQL and database sessions
-                through the chusql-server TCP endpoint. Shares accounts and
-                permissions with the web interface while keeping query execution
-                and storage in the database server process.
-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
-    build-depends:    base >= 4.14 && < 5
-                    , aeson
-                    , bytestring
-                    , chusql-core-model
-                    , chusql-interface
-                    , haskeline
-                    , text
-    default-language: Haskell2010
-    ghc-options:      -Wall
-
-executable csql
-    main-is:          Main.hs
-    other-modules:    Repl
-    hs-source-dirs:   app
-    build-depends:    base
-                    , chusql-cli
-                    , chusql-core-model
-                    , chusql-interface
-                    , containers
-                    , directory
-                    , filepath
-                    , haskeline
-                    , optparse-applicative
-                    , text
-    default-language: Haskell2010
-    ghc-options:      -Wall
-    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
-    if os(linux)
-        ld-options: -Wl,-rpath,$ORIGIN
-    if os(osx)
-        ld-options: -Wl,-rpath,@loader_path
-
-test-suite chusql-cli-test
-    type:             exitcode-stdio-1.0
-    main-is:          Spec.hs
-    hs-source-dirs:   test
-    build-depends:    base
-                    , directory
-                    , aeson
-                    , bytestring
-                    , chusql-interface
-                    , chusql-cli
-                    , chusql-core-model
-                    , hspec
-                    , haskeline
-                    , text
-    default-language: Haskell2010
-    ghc-options:      -Wall

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

@@ -1,113 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.CLI.Format
-    ( OutputFormat (..)
-    , parseFormat
-    , formatName
-    , renderResult
-    , renderTable
-    , renderRows
-    , renderCsv
-    , renderJson
-    , displayValue
-    ) where
-
-import ChuSQL.Core.Model (Value (..))
-import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
-import ChuSQL.Core.Runtime (renderRuntimeValue)
-import qualified Data.Aeson as A
-import qualified Data.ByteString.Lazy as BL
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8)
-
--- 结果输出：表格、JSON、CSV 三种格式。
-
-data OutputFormat = FormatTable | FormatJson | FormatCsv
-    deriving (Eq, Show)
-
--- | 格式的对外名字
-formatName :: OutputFormat -> Text
-formatName FormatTable = "table"
-formatName FormatJson = "json"
-formatName FormatCsv = "csv"
-
--- | 认一个格式名
-parseFormat :: Text -> Maybe OutputFormat
-parseFormat raw = case T.toLower (T.strip raw) of
-    "table" -> Just FormatTable
-    "json" -> Just FormatJson
-    "csv" -> Just FormatCsv
-    _ -> Nothing
-
--- | 按格式渲染查询结果
-renderResult :: OutputFormat -> QueryResult -> Text
-renderResult FormatTable = renderTable
-renderResult FormatJson = renderJson
-renderResult FormatCsv = renderCsv
-
--- | 紧凑 JSON，方便管道里再用
-renderJson :: QueryResult -> Text
-renderJson = decodeUtf8 . BL.toStrict . A.encode . queryResultJson
-
--- | 渲染成 CSV
-renderCsv :: QueryResult -> Text
-renderCsv result = T.unlines (header : map rowLine (qrRows result))
-  where
-    header = T.intercalate "," (map csvField (qrColumns result))
-    -- | 拼一行 CSV
-    rowLine row = T.intercalate "," (map (csvField . csvCell) row)
-
--- | CSV 里的空值就是空字段
-csvCell :: Value -> Text
-csvCell VNull = ""
-csvCell value = displayValue value
-
--- | 按 RFC 4180 给需要的字段加引号
-csvField :: Text -> Text
-csvField field
-    | T.any (`elem` (",\"\n\r" :: String)) field = "\"" <> T.replace "\"" "\"\"" field <> "\""
-    | otherwise = field
-
--- | 渲染成等宽表格
-renderTable :: QueryResult -> Text
-renderTable result
-    | null (qrColumns result) = "OK"
-    | otherwise = renderRows (qrColumns result) (map (map displayValue) (qrRows result))
-
--- | 画一张等宽表，列太宽就截断
-renderRows :: [Text] -> [[Text]] -> Text
-renderRows columns rawRows = T.unlines (border : headerLine : border : body ++ [border, summary])
-  where
-    widths = [columnWidth index | index <- [0 .. length columns - 1]]
-    -- | 一列的显示宽度，有上限
-    columnWidth index =
-        min maxColumnWidth (maximum (T.length (columns !! index) : [T.length (cellAt row index) | row <- rawRows]))
-    maxColumnWidth = 64
-    -- | 取某行某列，缺的当空
-    cellAt row index = if index < length row then row !! index else ""
-    -- | 拼一行带竖线的表行
-    cellLine cells = "| " <> T.intercalate " | " (zipWith pad widths (cells ++ repeat "")) <> " |"
-    headerLine = cellLine columns
-    body = map cellLine rawRows
-    border = "+" <> T.intercalate "+" ["-" <> T.replicate (width + 2) "-" | width <- widths] <> "+"
-    summary = "(" <> T.pack (show (length rawRows)) <> " row" <> (if length rawRows == 1 then "" else "s") <> ")"
-
--- | 补到指定宽度，超出的按 ... 截断
-pad :: Int -> Text -> Text
-pad width text = clipped <> T.replicate (width - T.length clipped) " "
-  where
-    clipped
-        | T.length text <= width = text
-        | width <= 3 = T.take width text
-        | otherwise = T.take (width - 3) text <> "..."
-
--- | 把值转成可显示的文本
-displayValue :: Value -> Text
-displayValue VNull = "NULL"
-displayValue (VInt n) = T.pack (show n)
-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/History.hs

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

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

@@ -1,75 +0,0 @@
-{-# 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/Password.hs

@@ -1,14 +0,0 @@
-module ChuSQL.CLI.Password (readPasswordInput) where
-
-import Data.Text (Text)
-import qualified Data.Text.IO as T
-import System.IO (Handle, hIsEOF, hSetNewlineMode, universalNewlineMode)
-
--- 管道口令输入：识别 LF 与 CRLF 行尾，保留口令内容。
-
--- | 从句柄读取一行口令
-readPasswordInput :: Handle -> IO Text
-readPasswordInput handle = do
-    hSetNewlineMode handle universalNewlineMode
-    empty <- hIsEOF handle
-    if empty then pure mempty else T.hGetLine handle

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

@@ -1,131 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.CLI.Script
-    ( Meta (..)
-    , parseMeta
-    , takeStatement
-    , statementComplete
-    , stripTerminator
-    , errorHint
-    , metaHelp
-    ) where
-
-import Data.Maybe (isJust)
-import ChuSQL.CLI.Normalization (normalizationArguments)
-import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
-import Data.Char (isSpace)
-import Data.Text (Text)
-import qualified Data.Text as T
-
--- 交互层的纯逻辑：元命令、多行语句切分、错误提示。
-
-data Meta
-    = MetaQuit
-    | MetaHelp
-    | MetaDatabases
-    | MetaTables
-    | MetaDescribe Text
-    | MetaNormalize Text FilePath Bool
-    | MetaRoles
-    | MetaConnect Text
-    | MetaSetFormat OutputFormat
-    | MetaUnknown Text
-    deriving (Eq, Show)
-
--- | 反斜杠开头的行是元命令，其余交给 SQL
-parseMeta :: Text -> Maybe Meta
-parseMeta raw = do
-    body <- T.stripPrefix "\\" (T.strip raw)
-    let (command, rest) = T.break isSpace body
-        argument = T.strip rest
-    pure $ case T.toLower command of
-        "q" -> MetaQuit
-        "quit" -> MetaQuit
-        "exit" -> MetaQuit
-        "?" -> MetaHelp
-        "h" -> MetaHelp
-        "help" -> MetaHelp
-        "l" -> MetaDatabases
-        "list" -> MetaDatabases
-        "dt" -> MetaTables
-        "tables" -> MetaTables
-        "d" | T.null argument -> MetaTables
-            | 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
-        "f" -> selectFormat argument
-        "format" -> selectFormat argument
-        other -> MetaUnknown other
-  where
-    -- | 拼出切库命令
-    connectTo argument
-        | T.null argument = MetaUnknown "c"
-        | otherwise = MetaConnect argument
-    -- | 解析格式参数
-    selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
-
--- | 取出第一条语句，忽略引号与注释里的分号
-takeStatement :: Text -> Maybe (Text, Text)
-takeStatement = go ScanNormal [] . T.unpack
-  where
-    -- | 逐字符扫描语句边界
-    go _ _ [] = Nothing
-    go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
-    go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest
-    go ScanNormal acc ('/' : '*' : rest) = go ScanBlockComment ('*' : '/' : acc) rest
-    go ScanNormal acc ('\'' : rest) = go ScanString ('\'' : acc) rest
-    go ScanNormal acc (ch : rest) = go ScanNormal (ch : acc) rest
-    go ScanString acc ('\'' : '\'' : rest) = go ScanString ('\'' : '\'' : acc) rest
-    go ScanString acc ('\'' : rest) = go ScanNormal ('\'' : acc) rest
-    go ScanString acc (ch : rest) = go ScanString (ch : acc) rest
-    go ScanLineComment acc ('\n' : rest) = go ScanNormal ('\n' : acc) rest
-    go ScanLineComment acc (ch : rest) = go ScanLineComment (ch : acc) rest
-    go ScanBlockComment acc ('*' : '/' : rest) = go ScanNormal ('/' : '*' : acc) rest
-    go ScanBlockComment acc (ch : rest) = go ScanBlockComment (ch : acc) rest
-
-data ScanState = ScanNormal | ScanString | ScanLineComment | ScanBlockComment
-
--- | 攒下来的内容里有没有一条以分号结束的语句
-statementComplete :: Text -> Bool
-statementComplete = isJust . takeStatement
-
--- | 去掉结尾的空白与分号（-e 直接执行时用）
-stripTerminator :: Text -> Text
-stripTerminator raw = T.stripEnd (T.dropWhileEnd (== ';') (T.stripEnd raw))
-
--- | 常见错误给一句怎么查
-errorHint :: Text -> Maybe Text
-errorHint message
-    | "unknown table" `T.isInfixOf` lowered = Just "run \\dt to list the tables of the current database"
-    | "unknown column" `T.isInfixOf` lowered = Just "run \\d <table> to see the columns of a table"
-    | "unknown database" `T.isInfixOf` lowered = Just "run \\l to list the databases"
-    | "syntax" `T.isInfixOf` lowered = Just "one statement at a time, and every statement ends with a semicolon"
-    | "invalid user name or password" `T.isInfixOf` lowered = Just "check --user and the password; an empty password works only while the account has none"
-    | "sign in first" `T.isInfixOf` lowered = Just "the session expired, restart the CLI"
-    | "too many failed sign-in attempts" `T.isInfixOf` lowered = Just "wait a few minutes before trying again"
-    | otherwise = Nothing
-  where
-    lowered = T.toLower message
-
--- | \? 的帮助文本
-metaHelp :: Text
-metaHelp =
-    T.unlines
-        [ "SQL statements end with a semicolon; a statement may span several lines."
-        , ""
-        , "  \\q, \\quit          leave the CLI"
-        , "  \\?, \\h, \\help       show this help"
-        , "  \\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])
-        , ""
-        , "At the chusql> prompt the arrow keys walk the SQL history."
-        ]

chusql-cli/stack.yaml

@@ -1,13 +0,0 @@
-resolver: lts-24.59
-
-extra-lib-dirs:
-    - ../chusql-core/storage/target/release
-
-packages:
-    - .
-    - ../chusql-core/engine
-    - ../chusql-server
-    - ../chusql-web
-    - ../chusql-bootstrap
-    - ../chusql-core/model
-    - ../chusql-interface

chusql-cli/stack.yaml.lock

@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/topics/lock_files
-
-packages: []
-snapshots:
-- completed:
-    sha256: 0f728e30e843d7f00460ad56858b995a3b227fca683659c7df9f2fc3988a3ce1
-    size: 732465
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/59.yaml
-  original: lts-24.59

chusql-cli/test/Spec.hs

@@ -1,216 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main (main) where
-
-import ChuSQL.CLI.Normalization
-import ChuSQL.Interface.Normalization
-import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable, displayValue)
-import ChuSQL.CLI.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
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-import Control.Exception (bracket, finally)
-import Control.Monad.IO.Class (liftIO)
-import System.Directory (getTemporaryDirectory, removeFile)
-import System.IO (Handle, SeekMode (AbsoluteSeek), hClose, hPutStr, hSeek, hSetNewlineMode, noNewlineTranslation, openTempFile)
-import Test.Hspec
-import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
-import System.Console.Haskeline.History (historyLines)
-
--- chusql-cli 测试：输出格式、语句缓冲、元命令与口令输入。
-
--- | 测试入口
-main :: IO ()
-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
-    historySpec
-
--- | 历史过滤与持久化的用例
-historySpec :: Spec
-historySpec = describe "CLI: SQL history" $ do
-    it "does not automatically record unfinished input lines" $
-        withPasswordInput "CREATE USER alice IDENTIFIED BY\n'secret'\n" (\handle -> do
-            entries <- runInputTBehavior (useFileHandle handle) (historySettings Nothing) $ do
-                getInputLine "" >>= liftExpectation "CREATE USER alice IDENTIFIED BY"
-                getInputLine "" >>= liftExpectation "'secret'"
-                historyLines <$> getHistory
-            entries `shouldBe` [])
-    it "keeps ordinary statements and excludes multiline or mixed-case passwords" $ do
-        entries <- runInputT (historySettings Nothing) $ do
-            rememberStatement "SELECT 1;"
-            rememberStatement "CREATE USER alice\nWITH PaSsWoRd\n'secret';"
-            rememberStatement "ALTER USER alice PASSWORD 'new-secret';"
-            rememberStatement "CREATE USER alice\nIdEnTiFiEd /* credential */ BY\n'secret';"
-            rememberStatement "ALTER ROLE analyst IDENTIFIED BY 'new-secret';"
-            rememberStatement "SELECT 'password';"
-            rememberStatement "   "
-            historyLines <$> getHistory
-        entries `shouldBe` ["SELECT 1;"]
-    it "persists only safe statements from a batch" $ do
-        directory <- getTemporaryDirectory
-        bracket (openTempFile directory "csql-history-test")
-            (\(path, _) -> removeFile path)
-            (\(path, handle) -> do
-                hClose handle
-                runInputT (historySettings (Just path)) $
-                    rememberBatch "SELECT 1; CREATE USER alice IDENTIFIED BY 'secret'; SELECT 2;"
-                entries <- runInputT (historySettings (Just path)) (historyLines <$> getHistory)
-                entries `shouldBe` ["SELECT 2;", "SELECT 1;"])
-  where
-    -- | 核对实际读取的输入行
-    liftExpectation expected actual = liftIO (actual `shouldBe` Just expected)
-    -- | 按完整语句筛选批量输入
-    rememberBatch input = case takeStatement input of
-        Nothing -> pure ()
-        Just (statement, rest) -> do
-            rememberStatement (statement <> ";")
-            rememberBatch rest
-
--- | 在临时句柄中写入口令输入
-withPasswordInput :: String -> (Handle -> IO a) -> IO a
-withPasswordInput input action = do
-    directory <- getTemporaryDirectory
-    bracket (openTempFile directory "csql-password-test")
-        (\(path, handle) -> hClose handle `finally` removeFile path)
-        (\(_, handle) -> do
-            hSetNewlineMode handle noNewlineTranslation
-            hPutStr handle input
-            hSeek handle AbsoluteSeek 0
-            action handle)
-
--- | 管道口令的行尾与内容用例
-passwordSpec :: Spec
-passwordSpec = describe "CLI: password input" $ do
-    it "reads LF, CRLF and unterminated passwords identically" $ do
-        mapM_ (\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
-            ["secret\n", "secret\r\n", "secret"]
-    it "preserves password spaces and internal carriage returns" $
-        withPasswordInput " a\rb \r\n" (\handle -> readPasswordInput handle `shouldReturn` " a\rb ")
-    it "accepts an empty password and consumes only one line" $
-        withPasswordInput "\r\nsecond\n" (\handle -> do
-            readPasswordInput handle `shouldReturn` ""
-            readPasswordInput handle `shouldReturn` "second"
-            readPasswordInput handle `shouldReturn` "")
-
--- | 输出格式的用例
-formatSpec :: Spec
-formatSpec = describe "CLI: output formats" $ do
-    it "renders a boxed table and marks NULL" $
-        renderTable sampleResult
-            `shouldBe` T.unlines
-                [ "+-----+--------+"
-                , "| id | name  |"
-                , "+-----+--------+"
-                , "| 1  | Alice |"
-                , "| 2  | NULL  |"
-                , "+-----+--------+"
-                , "(2 rows)"
-                ]
-    it "renders CSV with RFC 4180 quoting and empty NULL fields" $
-        renderCsv
-            QueryResult
-                { qrColumns = ["id", "name"]
-                , qrRows = [[VInt 1, VStr "a,b"], [VNull, VStr "say \"hi\""]]
-                , qrRowCount = 2
-                , qrTruncated = False
-                , qrDatabase = Nothing
-                }
-            `shouldBe` "id,name\n1,\"a,b\"\n,\"say \"\"hi\"\"\"\n"
-    it "renders JSON that parses back to the same result" $
-        (decode (BL.fromStrict (encodeUtf8 (renderJson sampleResult))) :: Maybe A.Value)
-            `shouldBe` Just (queryResultJson sampleResult)
-    it "accepts table/json/csv in any case and rejects anything else" $ do
-        parseFormat "TABLE" `shouldBe` Just FormatTable
-        parseFormat " json " `shouldBe` Just FormatJson
-        parseFormat "csv" `shouldBe` Just FormatCsv
-        parseFormat "xml" `shouldBe` Nothing
-
--- | 语句缓冲与元命令的用例
-scriptSpec :: Spec
-scriptSpec = do
-    describe "CLI: statement buffering" $ do
-        it "a statement is complete only at an unquoted semicolon" $ do
-            statementComplete "SELECT 1;" `shouldBe` True
-            statementComplete "SELECT 1" `shouldBe` False
-            statementComplete "SELECT ';'" `shouldBe` False
-            statementComplete "SELECT 'a''b'" `shouldBe` False
-            statementComplete "SELECT 1 -- ;" `shouldBe` False
-            statementComplete "SELECT /* ; */ 1" `shouldBe` False
-            statementComplete "SELECT /* ; */ 1;" `shouldBe` True
-        it "splits the first statement off and keeps the rest" $
-            takeStatement "SELECT 1; SELECT 2;"
-                `shouldBe` Just ("SELECT 1", " SELECT 2;")
-        it "drops the terminator before sending SQL to the server" $ do
-            stripTerminator "SELECT 1 ; " `shouldBe` "SELECT 1"
-            stripTerminator "SELECT 1" `shouldBe` "SELECT 1"
-        it "suggests how to look around after a common error" $ do
-            errorHint "unknown table: nope" `shouldBe` Just "run \\dt to list the tables of the current database"
-            errorHint "unknown column: nope" `shouldBe` Just "run \\d <table> to see the columns of a table"
-            errorHint "something else" `shouldBe` Nothing
-    describe "CLI: meta commands" $ do
-        it "parses the backslash commands" $ do
-            parseMeta "\\q" `shouldBe` Just MetaQuit
-            parseMeta "\\?" `shouldBe` Just MetaHelp
-            parseMeta "\\l" `shouldBe` Just MetaDatabases
-            parseMeta "\\dt" `shouldBe` Just MetaTables
-            parseMeta "\\d" `shouldBe` Just MetaTables
-            parseMeta "\\d users" `shouldBe` Just (MetaDescribe "users")
-            parseMeta "\\dr" `shouldBe` Just MetaRoles
-            parseMeta "\\roles" `shouldBe` Just MetaRoles
-            parseMeta "\\c sales" `shouldBe` Just (MetaConnect "sales")
-            parseMeta "\\format CSV" `shouldBe` Just (MetaSetFormat FormatCsv)
-        it "leaves ordinary SQL alone" $ do
-            parseMeta "SELECT 1" `shouldBe` Nothing
-            parseMeta "\\nope" `shouldBe` Just (MetaUnknown "nope")
-            parseMeta "\\f xml" `shouldBe` Just (MetaUnknown "format")
-
-sampleResult :: QueryResult
-sampleResult =
-    QueryResult
-        { qrColumns = ["id", "name"]
-        , qrRows = [[VInt 1, VStr "Alice"], [VInt 2, VNull]]
-        , qrRowCount = 2
-        , 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

@@ -1,78 +0,0 @@
-cabal-version: 2.4
-
-name:           chusql-core-engine
-version:        1.0.0
-synopsis:       ChuSQL SQL parsing, query planning, and execution engine
-description:    Provides SQL tokenization, syntax and semantic analysis, query
-                planning and optimization, expression evaluation, and relational
-                algebra execution, with in-memory and persistent storage support.
-build-type:     Simple
-
-library
-    hs-source-dirs:   src
-    exposed-modules:  ChuSQL.Core.Engine.Algebra.Cost
-                      ChuSQL.Core.Engine.Algebra.Eval
-                      ChuSQL.Core.Engine.Algebra.Expr
-                      ChuSQL.Core.Engine.Algebra.JoinOrder
-                      ChuSQL.Core.Engine.Algebra.Op
-                      ChuSQL.Core.Engine.Algebra.Optimize
-                      ChuSQL.Core.Engine.Algebra.Planner
-                      ChuSQL.Core.Engine.Algebra.Sort
-                      ChuSQL.Core.Engine.Builtin
-                      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
-                      ChuSQL.Core.Engine.Storage.IPC
-                      ChuSQL.Core.Engine.Storage.Memory
-                      ChuSQL.Core.Engine.Syntax.AST
-                      ChuSQL.Core.Engine.Syntax.Parser
-    build-depends:    base >= 4.14 && < 5
-                    , aeson
-                    , bytestring
-                    , hashable
-                    , chusql-core-model
-                    , megaparsec
-                    , parser-combinators
-                    , scientific
-                    , text
-                    , transformers
-                    , unordered-containers
-                    , vector
-    extra-libraries:  chusql_core_storage
-    -- 运行期找 libchusql_core_storage.so：$ORIGIN 让二进制与动态库同目录即可
-    if os(linux)
-        ld-options: -Wl,-rpath,$ORIGIN
-    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
-                    , chusql-core-model
-                    , directory
-                    , filepath
-                    , hashable
-                    , hspec
-                    , bytestring
-                    , aeson
-    default-language: Haskell2010
-    ghc-options:      -Wall -threaded

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

@@ -1,528 +0,0 @@
-module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf, BoundWrite, bindWrite, executeWriteM) where
-
-import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM)
-import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
-import ChuSQL.Core.Engine.Runtime.Query (bindQuery, executeQueryM)
-import ChuSQL.Core.Engine.Runtime.Relation (bindWriteColumns, orderRow)
-import ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, typeDependencies, validateDependencies)
-import ChuSQL.Core.Engine.Semantic (prepare, prepareCheckExpression)
-import ChuSQL.Core.Engine.Storage (MonadStorage (..))
-import ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage))
-import ChuSQL.Core.Engine.Syntax.AST
-import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
-import ChuSQL.Core.Model
-import Data.HashSet qualified as HS
-import Data.HashMap.Strict qualified as HM
-import Data.Maybe (mapMaybe)
-
--- 引擎入口：检查语义、按语句分发执行，另有内存实现与泛型版本。
-
--- | 跑一条语句（内存实现）
-runStatement :: Database -> Statement -> Either String (Database, [Row])
-runStatement db q = do
-    (result, db') <- runMemoryStorage (runStatementM q) db
-    rows <- result
-    Right (db', rows)
-
--- | 只要结果行
-rowsOf :: Either String (Database, [Row]) -> Either String [Row]
-rowsOf = fmap snd
-
--- | 泛型入口：先检查再执行
-runStatementM :: (MonadStorage m) => Statement -> m (Either String [Row])
-runStatementM (CreateDatabase name) = fmap (fmap (const [])) (createDatabase name)
-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
-    result <- schema
-    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
-                Left err -> pure (Left err)
-                Right bound -> executeWriteM bound
-
--- | 保存已有表写入的 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 [])
-executeWriteActionM catalog (UpdateAction target (UpdatePlan columns assignments condition checks constraints)) = do
-    current <- scan target
-    case current >>= mapM (orderRow columns) of
-        Left err -> pure (Left err)
-        Right rows -> do
-            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) -> case mapM rowId doomed of
-                    Right ids -> do
-                        result <- deleteKeys target ids
-                        pure (result >> Right [])
-                    Left _ -> do
-                        result <- replaceAll target kept
-                        pure (result >> Right [])
-  where
-    -- | 取整数主键，否则使用原有整表删除路径
-    rowId row = case lookup "id" row of
-        Just (VInt key) -> Right key
-        _ -> Left "row has no integer id"
-executeWriteActionM catalog (StructureAction statement) = runStatementUncheckedM catalog statement
-
--- | 绑定并执行查询语句
-runQueryM :: MonadStorage m => Database -> Statement -> m (Either String [Row])
-runQueryM db q = case bindQuery db q of
-    Left e -> pure (Left e)
-    Right bound -> executeQueryM bound
-
--- | 分发语句，查询由 BoundQuery 绑定
-runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
-runStatementUncheckedM db q@SelectDistinct{} = runQueryM db q
-runStatementUncheckedM db q@Select{} = runQueryM db q
-runStatementUncheckedM _ Insert{} = pure (Left "INSERT requires a bound write plan")
-runStatementUncheckedM _ Update{} = pure (Left "UPDATE requires a bound write plan")
-runStatementUncheckedM _ Delete{} = pure (Left "DELETE requires a bound write plan")
-runStatementUncheckedM _ (CreateTable name cols) = do
-    result <- createTable name cols
-    pure (result >> Right [])
-runStatementUncheckedM _ (CreateDomain name base) = do
-    result <- createTable (domainTableName name) [("base", plainColumn base)]
-    pure (result >> Right [])
-runStatementUncheckedM _ (DropDomain name) = do
-    result <- dropTable (domainTableName name)
-    pure (result >> Right [])
-runStatementUncheckedM db ShowDomains =
-    pure
-        ( 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 [])
-runStatementUncheckedM _ (CreateIndex tbl col) = do
-    result <- createIndex tbl col
-    pure (result >> Right [])
-runStatementUncheckedM _ (DropIndex tbl col) = do
-    result <- dropIndex tbl col
-    pure (result >> Right [])
-runStatementUncheckedM _ (DropColumn tbl col) = do
-    result <- dropColumn tbl col
-    pure (result >> Right [])
-runStatementUncheckedM db (AddColumn tbl def) =
-    alterTable db tbl (\table -> addColumnTo def (tableCols table) (tableRows table))
-runStatementUncheckedM db (RenameColumn tbl old new) =
-    alterTable db tbl (\table -> renameColumnIn old new (tableCols table) (tableRows table))
-runStatementUncheckedM db (AlterColumnType tbl col ty) =
-    alterTable db tbl (\table -> retypeColumn col ty (tableCols table) (tableRows table))
-runStatementUncheckedM db (AlterColumnDefault tbl col def) =
-    alterTable db tbl (\table -> setColumnDefault col def (tableCols table) (tableRows table))
-runStatementUncheckedM db (AlterColumnNull tbl col nullable) =
-    alterTable db tbl (\table -> setColumnNullable col nullable (tableCols table) (tableRows table))
-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")
-runStatementUncheckedM _ q@CreateDatabase{} = runStatementM q
-runStatementUncheckedM _ q@DropDatabase{} = runStatementM q
-runStatementUncheckedM _ q@UseDatabase{} = runStatementM q
-runStatementUncheckedM _ ShowDatabases = runStatementM ShowDatabases
-runStatementUncheckedM _ BeginTransaction = pure (Left "BEGIN is executed by the session")
-runStatementUncheckedM _ CommitTransaction = pure (Left "COMMIT is executed by the session")
-runStatementUncheckedM _ RollbackTransaction = pure (Left "ROLLBACK is executed by the session")
-runStatementUncheckedM _ Savepoint{} = pure (Left "SAVEPOINT is executed by the session")
-runStatementUncheckedM _ RollbackToSavepoint{} = pure (Left "ROLLBACK TO is executed by the session")
-runStatementUncheckedM _ ReleaseSavepoint{} = pure (Left "RELEASE is executed by the session")
-
--- | 只有需要读全表才能判断约束时才扫表
-existingRows :: (MonadStorage m) => String -> InsertPlan -> m (Either String [Row])
-existingRows tbl (InsertPlan _ _ auto _ (ConstraintPlan _ _ unique))
-    | Just _ <- auto = scan tbl
-    | not (null unique) = scan tbl
-    | otherwise = pure (Right [])
-
--- | 插一行：补齐缺列、给自增值、收类型、查约束
-buildRows :: InsertPlan -> [Row] -> [[Expr]] -> Either String [Row]
-buildRows (InsertPlan layout width auto checks constraints) current rows = do
-    values <- mapM (mapM (`evalExpr` [])) rows
-    if any (\vals -> length vals /= width) values
-        then Left "column count does not match value count"
-        else go (autoStart auto current) values []
-  where
-    -- \| 逐行构造，最后统一查一遍约束
-    go _ [] acc = do
-        let built = reverse acc
-        mapM_ (runChecks checks) built
-        enforceConstraints constraints current built
-        Right built
-    go counter (vals : rest) acc = do
-        (row, counter') <- buildRow layout auto counter vals
-        go counter' rest (row : acc)
-
--- | 保存输出列定义及可选 VALUES 槽位
-data BoundInsertColumn = BoundInsertColumn String Column (Maybe Int)
-
--- | 把已校验的目标清单绑定为输入槽位
-bindInsertTargets :: [(String, Column)] -> [String] -> [BoundInsertColumn]
-bindInsertTargets columns targets =
-    [BoundInsertColumn name column (lookup name positions) | (name, column) <- columns]
-  where
-    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 (BoundInsertColumn name col position : rest) c acc = do
-        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 supplied c
-        | Just (autoName, _) <- auto
-        , name == autoName
-        , maybe True (== VNull) supplied =
-            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
-        | Just (autoName, _) <- auto
-        , name == autoName =
-            max (c + 1) (valueInt v + 1)
-        | otherwise = c
-
--- | 取自增值，不是整数就当 0
-valueInt :: Value -> Int
-valueInt (VInt n) = n
-valueInt _ = 0
-
--- | 自增列（至多一个）
-autoColumn :: Table -> Maybe (String, Column)
-autoColumn table = case [(n, c) | (n, c) <- tableCols table, columnAutoIncrement c] of
-    (entry : _) -> Just entry
-    [] -> Nothing
-
--- | 下一个自增值
-autoStart :: Maybe (String, Column) -> [Row] -> Int
-autoStart Nothing _ = 1
-autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup name r]] of
-    [] -> 1
-    ns -> maximum ns + 1
-
--- | 一次解析出来的 CHECK 条件
-data CheckPlan = CheckPlan [String] [(String, Expr)]
-
--- | 按 schema 解析并绑定表上全部 CHECK
-checkPlan :: Table -> Either String CheckPlan
-checkPlan table = CheckPlan (map fst (tableCols table)) <$> mapM parse (mapMaybe checked (tableCols table))
-  where
-    -- \| 只挑出带 CHECK 文本的列
-    checked (name, col) = (,) name <$> columnCheck col
-    -- \| 解析一列的 CHECK 文本
-    parse (name, text) = case parseExpression text of
-        Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
-        Right e -> do
-            bound <- prepareCheckExpression (tableCols table) e
-            Right (name, bound)
-
--- | 执行解析好的 CHECK 条件
-runChecks :: CheckPlan -> Row -> Either String ()
-runChecks (CheckPlan columns plan) row = do
-    ordered <- orderRow columns row
-    mapM_ (check ordered) plan
-  where
-    -- \| 跑一条 CHECK
-    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")
-
--- | 只取第一行（报错提示用）
-firstLine :: String -> String
-firstLine = takeWhile (/= '\n')
-
--- | 保存非空及唯一键的固定列槽位
-data ConstraintPlan = ConstraintPlan [String] [(String, Expr)] [(String, Expr)]
-
--- | 按 schema 一次绑定行集约束目标
-constraintPlan :: [(String, Column)] -> ConstraintPlan
-constraintPlan columns = ConstraintPlan (map fst columns) required unique
-  where
-    slots = [(name, column, ColumnSlot slot name) | (slot, (name, column)) <- zip [0 ..] columns]
-    required = [(name, reference) | (name, column, reference) <- slots, not (columnNullable column)]
-    unique = [(name, reference) | (name, column, reference) <- slots, columnUnique column || columnPrimaryKey column]
-
--- | 检查新行非空及合并旧行后的唯一性
-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, Expr)] -> [Row] -> Either String ()
-enforceUnique targets rows = mapM_ check targets
-  where
-    -- \| 查这一列有没有重复值
-    check (name, reference) = mapM (evalExpr reference) rows >>= go name HS.empty
-    -- \| 逐个值比过去
-    go _ _ [] = Right ()
-    -- \| 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 -> CheckPlan -> Maybe Expr -> [BoundAssignment] -> Row -> m (Either String Row)
-updateRowM db plan cond asgns row = do
-    keep <- case cond of
-        Nothing -> pure (Right True)
-        Just e -> evalCondForRowM db e row
-    case keep of
-        Left err -> pure (Left err)
-        Right False -> pure (Right row)
-        Right True -> do
-            row' <- applyUpdatesM db asgns row
-            pure (row' >>= \r -> runChecks plan r >> Right r)
-
--- | 保存赋值目标槽位、列定义和右侧表达式
-data BoundAssignment = BoundAssignment Int String Column Expr
-
--- | 按 schema 一次绑定全部赋值目标
-bindUpdateTargets :: [(String, Column)] -> [(String, Expr)] -> Either String [BoundAssignment]
-bindUpdateTargets columns = mapM bindTarget
-  where
-    -- | 只接受唯一目标并保留列定义
-    bindTarget (name, expression) = case [(slot, column) | (slot, (key, column)) <- zip [0 ..] columns, key == name] of
-        [(slot, column)] -> Right (BoundAssignment slot name column expression)
-        [] -> Left ("UPDATE: unknown target column: " ++ name)
-        _ -> 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
-            Nothing -> pure (Right True)
-            Just e -> evalCondForRowM db e r
-        case hit of
-            Left err -> pure (Left err)
-            Right h -> go (if h then r : doomed else doomed) (if h then kept else r : kept) rs
-
--- | 表结构变更的统一入口：扫全表，改完整体回写
-alterTable ::
-    (MonadStorage m) =>
-    Database ->
-    String ->
-    (Table -> Either String ([(String, Column)], [Row])) ->
-    m (Either String [Row])
-alterTable db tbl change = case lookupTable db tbl of
-    Left e -> pure (Left e)
-    Right table -> do
-        rowsResult <- scan tbl
-        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)
-                Right (cols, newRows) -> do
-                    result <- replaceSchema tbl cols newRows
-                    pure (result >> Right [])
-  where
-    -- \| 改完再统一查一遍约束
-    checkAltered (cols, rows) = do
-        let table = Table tbl cols rows Nothing Nothing Nothing
-        plan <- checkPlan table
-        mapM_ (runChecks plan) rows
-        enforceConstraints (constraintPlan cols) [] rows
-        Right (cols, rows)
-
--- | ADD COLUMN：老行补默认值或 NULL
-addColumnTo :: (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
-addColumnTo (name, col) cols rows
-    | name `elem` map fst cols = Left ("ADD COLUMN: column already exists: " ++ name)
-    | otherwise = do
-        values <- fill
-        Right (cols ++ [(name, col)], [r ++ [(name, v)] | (r, v) <- zip rows values])
-  where
-    fill
-        | columnAutoIncrement col = mapM (coerceValue (columnType col) . VInt) [1 .. length rows]
-        | Just d <- columnDefault col = mapM (\_ -> coerceValue (columnType col) d) rows
-        | columnNullable col = mapM (\_ -> coerceValue (columnType col) VNull) rows
-        | null rows = Right []
-        | otherwise = Left ("ADD COLUMN: column " ++ name ++ " is NOT NULL and has no default")
-
--- | RENAME COLUMN：列定义与每一行的键一起改
-renameColumnIn :: String -> String -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
-renameColumnIn old new cols rows
-    | old `notElem` map fst cols = Left ("RENAME COLUMN: unknown column: " ++ old)
-    | new `elem` map fst cols = Left ("RENAME COLUMN: column already exists: " ++ new)
-    | otherwise = Right (renameKeys cols, map renameKeys rows)
-  where
-    renameKeys = map (\(k, v) -> if k == old then (new, v) else (k, v))
-
--- | ALTER COLUMN TYPE：老值收进新类型
-retypeColumn :: String -> ColumnType -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
-retypeColumn col ty cols rows
-    | col `notElem` map fst cols = Left ("ALTER COLUMN: unknown column: " ++ col)
-    | otherwise = do
-        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
-            v' <- coerceValue ty v
-            Right (map (\(k, x) -> if k == col then (k, v') else (k, x)) row)
-
--- | ALTER COLUMN SET/DROP DEFAULT
-setColumnDefault :: String -> Maybe Value -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
-setColumnDefault col def cols rows
-    | col `notElem` map fst cols = Left ("ALTER COLUMN: unknown column: " ++ col)
-    | otherwise = Right (map (\entry@(n, c) -> if n == col then (n, c{columnDefault = def}) else entry) cols, rows)
-
--- | ALTER COLUMN SET/DROP NOT NULL
-setColumnNullable :: String -> Bool -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
-setColumnNullable col nullable cols rows
-    | col `notElem` map fst cols = Left ("ALTER COLUMN: unknown column: " ++ col)
-    | otherwise = Right (map (\entry@(n, c) -> if n == col then (n, c{columnNullable = nullable}) else entry) cols, rows)

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

@@ -1,67 +0,0 @@
-module ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf, probeCost, pointRows, rangeRows, selectivityOf, indexCheaper) where
-
-import Data.Maybe (fromMaybe)
-import ChuSQL.Core.Model
-
--- 统计与成本估算：行数、不同值数、列直方图与索引探路页数。
-
--- | 表统计，拿不到就是 Nothing
-tableMetaOf :: Database -> String -> Maybe TableMeta
-tableMetaOf db t = lookup t db >>= tableMeta
-
--- | 索引探路的页数：B+Tree 高度
-probeCost :: Int -> Int
-probeCost rows = max 1 (ceiling (logBase 2 (fromIntegral (max 2 rows) :: Double)))
-
--- | 等值点查的估算命中行数：行数除以该列不同值数
-pointRows :: TableMeta -> String -> Int
-pointRows m col = case [d | (c, d, _) <- metaDistinct m, c == col, d > 1] of
-    (d : _) -> max 1 (rows `div` d)
-    [] -> rows
-  where
-    rows = max 0 (metaRowCount m)
-
--- | 范围扫描的估算命中行数：有直方图按桶算，没有按四分之一
-rangeRows :: TableMeta -> String -> Maybe (Value, Bool) -> Maybe (Value, Bool) -> Int
-rangeRows m col lo hi = case histogramFor m col of
-    Just h -> estimateRows h lo hi
-    Nothing -> max 0 (metaRowCount m) `div` 4
-
--- | 直方图估算区间命中行数：按桶算交集占比
-estimateRows :: Histogram -> Maybe (Value, Bool) -> Maybe (Value, Bool) -> Int
-estimateRows h lo hi = max 0 (min total (round (sum (zipWith overlap [0 ..] (histBuckets h)))))
-  where
-    total = sum (histBuckets h)
-    width = if histHigh h > histLow h then (histHigh h - histLow h) / fromIntegral (length (histBuckets h)) else 0
-    lower = fromMaybe (- (1 / 0)) (boundOf lo)
-    upper = fromMaybe (1 / 0) (boundOf hi)
-    -- | 第 i 个桶与区间重叠的行数
-    overlap :: Int -> Int -> Double
-    overlap i count
-        | width <= 0 = if lower <= histLow h && histLow h <= upper then fromIntegral count else 0
-        | otherwise = fromIntegral count * hit / width
-      where
-        start = histLow h + width * fromIntegral i
-        hit = max 0 (min (start + width) upper - max start lower)
-
--- | 区间选择率：直方图命中的比例；没有直方图给 Nothing
-selectivityOf :: TableMeta -> String -> Maybe (Value, Bool) -> Maybe (Value, Bool) -> Maybe Double
-selectivityOf m col lo hi = case histogramFor m col of
-    Nothing -> Nothing
-    Just h
-        | total <= 0 -> Nothing
-        | otherwise -> Just (fromIntegral (estimateRows h lo hi) / fromIntegral total)
-      where
-        total = sum (histBuckets h)
-
--- | 边界值转成参与估值的小数；非数值给 Nothing
-boundOf :: Maybe (Value, Bool) -> Maybe Double
-boundOf (Just (VInt n, _)) = Just (fromIntegral n)
-boundOf (Just (VFloat d, _)) = Just d
-boundOf _ = Nothing
-
--- | 有索引且探路加命中比全表扫便宜
-indexCheaper :: TableMeta -> String -> Int -> Bool
-indexCheaper m col est = col `elem` metaIndexes m && probeCost rows + est < rows
-  where
-    rows = max 0 (metaRowCount m)

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

@@ -1,700 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
-
-import ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf)
-import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, hasSubquery, quantifiedCompare, subquerySlotsIn, subqueryColumns)
-import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
-import ChuSQL.Core.Engine.Algebra.Op
-import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Core.Engine.Algebra.Sort (sortRows, sortBoundRows)
-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
-project cs row = [(c, v) | c <- cs, Just v <- [lookup c row]]
-
--- | 给列名加别名前缀
-addPrefix :: Maybe String -> Row -> Row
-addPrefix mAlias = map (\(k, v) -> (qualify mAlias k, v))
-
--- | 给一批行加别名前缀
-prefixRows :: Maybe String -> [Row] -> [Row]
-prefixRows mAlias = map (addPrefix mAlias)
-
--- | 值 → 字面量
-valueLiteral :: Value -> Expr
-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
-
--- | 点查退化成扫描时用的条件
-lookupCondition :: Maybe String -> String -> Value -> Expr
-lookupCondition mAlias col k = Eq (Col (qualify mAlias col)) (valueLiteral k)
-
--- | 范围扫描退化成扫描时用的条件（闭端写成 > 或 = 的并）
-rangeCondition :: Maybe String -> String -> Maybe (Value, Bool) -> Maybe (Value, Bool) -> Expr
-rangeCondition mAlias col lo hi = case (lo, hi) of
-    (Just l, Just h) -> And (bound Gt l) (bound Lt h)
-    (Just l, Nothing) -> bound Gt l
-    (Nothing, Just h) -> bound Lt h
-    (Nothing, Nothing) -> LitBool True
-  where
-    c = Col (qualify mAlias col)
-    -- | 一个端点的比较，闭端再加上等号
-    bound rel (v, inclusive)
-        | inclusive = Or (rel c (valueLiteral v)) (Eq c (valueLiteral v))
-        | otherwise = rel c (valueLiteral v)
-
--- | 一批行的列名（空批给空清单）
-rowsCols :: [Row] -> [String]
-rowsCols (r : _) = map fst r
-rowsCols [] = []
-
--- | 参与等值匹配的键：NULL 不参与，整值浮点归一
-joinKey :: Value -> Maybe Value
-joinKey VNull = Nothing
-joinKey v = Just (canonicalValue v)
-
--- | 取一行的连接键
-joinKeyOf :: String -> Row -> Maybe Value
-joinKeyOf c row = lookup c row >>= joinKey
-
--- | 等值连接的两侧列名
-data EquiKeys = EquiKeys
-    { ekLeft :: String
-    , ekRight :: String
-    }
-
--- | 认出 a = b 这种两列等值条件，并且能分清谁在左谁在右
-equiKeys :: [String] -> [String] -> Expr -> Maybe EquiKeys
-equiKeys lcols rcols (Eq left right)
-    | Just a <- columnName left, Just b <- columnName right
-    , a /= b, a `elem` lcols, b `elem` rcols = Just (EquiKeys a b)
-    | Just a <- columnName left, Just b <- columnName right
-    , a /= b, b `elem` lcols, a `elem` rcols = Just (EquiKeys b a)
-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) =>
-    Database ->
-    Row ->
-    JoinKind ->
-    [String] ->
-    Expr ->
-    [Row] ->
-    [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))
-        Nothing -> filterPairsM db outer kind ncols cond lrows rrows
-  where
-    -- 右表为空时行上没有列名，用算子推导出来的列名补 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 _ _ = []
-unmatched LeftJoin l cols = [l ++ [(c, VNull) | c <- cols]]
-
--- | 哈希连接，输出顺序同嵌套循环
-hashJoin :: JoinKind -> EquiKeys -> [String] -> [Row] -> [Row] -> [Row]
-hashJoin kind ks ncols lrows rrows = concatMap probe lrows
-  where
-    buckets = HM.fromListWith (flip (++)) [(v, [r]) | r <- rrows, Just v <- [joinKeyOf (ekRight ks) r]]
-    -- | 拿左行的键去桶里找
-    probe l =
-        let miss = case kind of
-                InnerJoin -> []
-                LeftJoin -> [l ++ nullRow]
-         in case joinKeyOf (ekLeft ks) l of
-                Nothing -> miss
-                Just v -> case HM.lookupDefault [] v buckets of
-                    [] -> miss
-                    rs -> [l ++ r | r <- rs]
-    nullRow = [(c, VNull) | c <- ncols]
-
--- | 把两边的行按条件配对（边配边筛，不先建整张积表）
-filterPairsM ::
-    (MonadStorage m) =>
-    Database ->
-    Row ->
-    JoinKind ->
-    [String] ->
-    Expr ->
-    [Row] ->
-    [Row] ->
-    Execution m (Either String [Row])
-filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
-  where
-    refs = subquerySlotsIn cond
-    -- | 逐左行配对，左连接没配上就补 NULL
-    go [] acc _ = pure (Right (reverse acc))
-    go (l : ls) acc cache = do
-        hits <- keep l rrows [] cache
-        case hits of
-            Left e -> pure (Left e)
-            Right (hs, nextCache) -> do
-                let hs' = case (kind, hs) of
-                        (LeftJoin, []) -> [l ++ nullRow]
-                        _ -> hs
-                go ls (reverse hs' ++ acc) nextCache
-    -- | 拿一行右行去比条件
-    keep _ [] acc cache = pure (Right (reverse acc, cache))
-    keep l (r : rs) acc cache = do
-        let env = l ++ r ++ outer
-        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
-                case resolved of
-                    Left e -> pure (Left e)
-                    Right expression -> case evalCondForRow expression env of
-                        Left e -> pure (Left e)
-                        Right matches -> keep l rs (if matches then (l ++ r) : acc else acc) (HM.insert key expression cache)
-    nullRow = [(c, VNull) | c <- ncols]
-
--- | 索引连接：右表是裸 Scan 时逐左行点查
-probeIndexJoin ::
-    (MonadStorage m) =>
-    Database ->
-    Row ->
-    JoinKind ->
-    Maybe String ->
-    String ->
-    EquiKeys ->
-    [String] ->
-    Expr ->
-    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 <- 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
-                    case orderedRows rcols (prefixRows mAlias rows) of
-                        Left err -> pure (Left err)
-                        Right ordered -> fmap (fmap Just) (joinRowsIn db outer kind rcols cond [l] ordered)
-
--- | 列与键都不是浮点时才敢用索引
-indexSafe :: Database -> String -> String -> Value -> Bool
-indexSafe db t col k = case lookupTable db t of
-    Left _ -> False
-    Right tbl -> case lookup col (tableCols tbl) of
-        Nothing -> False
-        Just c -> not (floatType (columnType c)) && not (floatValue k)
-
--- | 是不是浮点列类型
-floatType :: ColumnType -> Bool
-floatType CFloat = True
-floatType CDouble = True
-floatType (CDecimal _ _) = True
-floatType (CDomain _ base) = floatType base
-floatType _ = False
-
--- | 是不是浮点值
-floatValue :: Value -> Bool
-floatValue (VFloat _) = True
-floatValue _ = False
-
--- | 分组键的值
-groupKey :: Row -> [Expr] -> Row -> Either String [Value]
-groupKey outer keys row = mapM (\key -> evalExpr key (row ++ outer)) keys
-
--- | 按分组键把行分组，保留分组首次出现的顺序
-groupRows :: Row -> [Expr] -> [Row] -> Either String [([Value], [Row])]
-groupRows outer keys rows = go rows (HM.empty, [])
-  where
-    -- | 逐行塞进对应分组，并记住分组首次出现的顺序
-    go [] (acc, order) = Right [(k, reverse (HM.lookupDefault [] k acc)) | k <- reverse order]
-    go (r : rs) (acc, order) = do
-        k <- groupKey outer keys r
-        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 = mapM (evalExpr e . (++ outer))
-
--- | 一个聚合算子在一组行上的结果，统一走内置函数权威
-evalAgg :: Row -> Expr -> [Row] -> Either String Value
-evalAgg outer agg rows = case builtinOfExpr agg of
-    Nothing -> Left unsupportedAggregate
-    Just builtin -> do
-        vs <- maybe (Right []) (\e -> valuesOf outer e rows) (aggregateArg agg)
-        invokeBuiltin builtin (length rows) vs
-
--- | 一组的输出行：分组列 + 各聚合值
-oneGroup :: Row -> [String] -> [(String, Expr)] -> ([Value], [Row]) -> Either String Row
-oneGroup outer keys aggs (keyValues, rows) = do
-    values <- mapM (\(_, e) -> evalAgg outer e rows) aggs
-    Right (zip keys keyValues ++ zip (map fst aggs) values)
-
--- | 分组求值：没有分组列时，即使没有行也要出一行
-evalAggregate :: Row -> [(String, Expr)] -> [(String, Expr)] -> [Row] -> Either String [Row]
-evalAggregate outer keys aggs rows = do
-    groups <- groupRows outer (map snd keys) rows
-    let top = if null keys && null groups then [([], [])] else groups
-    mapM (oneGroup outer (map fst keys) aggs) top
-
--- | 绑定键：子查询引用的外层列在这一行上的取值
-bindingKey :: [Expr] -> Row -> Either String String
-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
-bindingValue column env = case lookup column env of
-    Just value -> Just value
-    Nothing | '.' `elem` column -> lookup (reverse (takeWhile (/= '.') (reverse column))) [(key, value) | (key, value) <- env, '.' `notElem` key]
-    Nothing -> Nothing
-
--- | 每个绑定留第一行当样本，去掉重复绑定
-bindingSamples :: [Expr] -> Row -> [Row] -> Either String [(String, Row)]
-bindingSamples refs outer rows = go rows HM.empty []
-  where
-    -- | 逐行按绑定键去重
-    go [] _ acc = Right (reverse acc)
-    go (r : rs) seen acc = do
-        let env = r ++ outer
-        k <- bindingKey refs env
-        case HM.lookup k seen of
-            Just _ -> go rs seen acc
-            Nothing -> go rs (HM.insert k () seen) ((k, env) : acc)
-
--- | 每个绑定只换一次子查询，得到绑定到表达式的表
-bindingsTableM ::
-    (MonadStorage m) =>
-    Database ->
-    Row ->
-    [Expr] ->
-    [Row] ->
-    Execution m (Either String (HM.HashMap String [Expr]))
-bindingsTableM db outer exprs rows = case bindingSamples refs outer rows of
-    Left err -> pure (Left err)
-    Right samples -> do
-        built <- mapM swap samples
-        pure (fmap HM.fromList (sequence built))
-  where
-    refs = nub (concatMap subquerySlotsIn exprs)
-    -- | 一个绑定样本上把子查询全换成字面量
-    swap (key, env) = do
-        es <- mapM (\e -> substSubqueries db e env) exprs
-        pure (fmap (key,) (sequence es))
-
--- | 取这一行绑定换好的表达式；没有这个绑定就是内部错误
-boundExprs :: [Expr] -> Row -> HM.HashMap String [Expr] -> Either String [Expr]
-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 :: [Expr] -> Row -> HM.HashMap String [Expr] -> Either String Expr
-boundExpr refs env table = do
-    expressions <- boundExprs refs env table
-    case expressions of
-        [x] -> Right x
-        _ -> Left "subquery binding is missing"
-
--- | 单子过滤：条件本身是单子求值的
-filterRowsM :: (Monad m) => (Row -> m (Either String Bool)) -> [Row] -> m (Either String [Row])
-filterRowsM p = go []
-  where
-    -- | 逐行留下通过条件的
-    go acc [] = pure (Right (reverse acc))
-    go acc (r : rs) = do
-        keep <- p r
-        case keep of
-            Left e -> pure (Left e)
-            Right True -> go (r : acc) rs
-            Right False -> go acc rs
-
--- | 按投影顺序逐项求值（可以带子查询）
-computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> Execution m (Either String Row)
-computeM db outer items row = go items []
-  where
-    -- | 逐项求值并攒成一行
-    go [] acc = pure (Right (reverse acc))
-    go ((label, e) : rest) acc = do
-        v <- evalExprIn db e (row ++ outer)
-        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 = 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 = 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)
-
--- | 子查询结果里唯一那一列的值
-rowValue :: Row -> Either String Value
-rowValue [(_, v)] = Right v
-rowValue _ = Left "subquery must return exactly one column"
-
--- | 标量子查询：0 行给 NULL，多行报错
-scalarResult :: Either String [Row] -> Either String Expr
-scalarResult rows = do
-    rs <- rows
-    case rs of
-        [] -> Right LitNull
-        [r] -> valueLiteral <$> rowValue r
-        _ -> Left "scalar subquery returned more than one row"
-
--- | 把子查询求值成字面量；子查询的错直接往上传
-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
-        rows <- runSubqueryRows db sq env
-        pure (do
-            a' <- lhs
-            rs <- rows
-            vs <- mapM rowValue rs
-            Right (InList a' (map valueLiteral vs) negated))
-    ExistsSub sq negated -> do
-        rows <- runSubqueryRows db sq env
-        pure (fmap (\rs -> LitBool (if negated then null rs else not (null rs))) rows)
-    QuantCmp op a sq q -> do
-        lhs <- substSubqueries db a env
-        rows <- runSubqueryRows db sq env
-        pure (do
-            a' <- lhs
-            rs <- rows
-            vs <- mapM rowValue rs
-            Right (quantifiedCompare op a' (map valueLiteral vs) q))
-    InList a es negated -> do
-        lhs <- substSubqueries db a env
-        es' <- mapM (\x -> substSubqueries db x env) es
-        pure (do
-            a' <- lhs
-            items <- sequence es'
-            Right (InList a' items negated))
-    Add a b -> bin Add a b
-    Sub a b -> bin Sub a b
-    Mul a b -> bin Mul a b
-    Div a b -> bin Div a b
-    Neg a -> un Neg a
-    Gt a b -> bin Gt a b
-    Lt a b -> bin Lt a b
-    Eq a b -> bin Eq a b
-    GtE a b -> bin GtE a b
-    LtE a b -> bin LtE a b
-    NotEq a b -> bin NotEq a b
-    And a b -> bin And a b
-    Or a b -> bin Or a b
-    IsNull a -> un IsNull a
-    IsNotNull a -> un IsNotNull a
-    CountOf a -> un CountOf a
-    SumOf a -> un SumOf a
-    AvgOf a -> un AvgOf a
-    MinOf a -> un MinOf a
-    MaxOf a -> un MaxOf a
-    _ -> pure (Right e)
-  where
-    -- | 递归处理两个子表达式
-    bin ctor a b = do
-        ra <- substSubqueries db a env
-        case ra of
-            Left err -> pure (Left err)
-            Right a' -> do
-                rb <- substSubqueries db b env
-                pure (ctor a' <$> rb)
-    -- | 递归处理一个子表达式
-    un ctor a = do
-        ra <- substSubqueries db a env
-        pure (ctor <$> ra)
-
--- | 跑子查询：翻译成算子树再求值，外层行做相关子查询的绑定
-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 (subqueryColumns sq) of
-        Left err -> pure (Left err)
-        Right bindings -> case bindRelOpColumns db (map fst (bindings ++ outer)) (optimize db op) of
-            Left err -> pure (Left err)
-            Right bound -> materialize (show ("subquery", subqueryStatement sq, bindings, fallback))
-                (evalRelOpIn db (bindings ++ outer) bound)
-  where
-    -- | 原始调用未证明依赖完整，保留整个外层行
-    fallback = case sq of
-        Subquery{} -> Just outer
-        BoundSubquery{} -> Nothing
-    -- | 给外层物理列补回已解析的限定名
-    bind (column, expression) = (,) column <$> bindingReferenceValue expression outer
-
--- | 单子求值：Scan/点查/范围查都问存储
-evalRelOpM :: (MonadStorage m) => Database -> RelOp -> m (Either String [Row])
-evalRelOpM db op = evalStateT (evalRelOpIn db [] op) HM.empty
-
--- | 纯求值（内存存储，子查询走同一条路径）
-evalRelOp :: Database -> RelOp -> Either String [Row]
-evalRelOp db op = do
-    (result, _) <- runMemoryStorage (evalRelOpM db op) db
-    result
-
--- | 带外层行的执行器
-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
-    case rows of
-        Left e -> pure (Left e)
-        Right rs
-            | not (any (hasSubquery . snd) items) -> do
-                computed <- mapM (computeM db outer items) rs
-                pure (sequence computed)
-            | otherwise -> do
-                table <- bindingsTableM db outer (map snd items) rs
-                pure (table >>= \t -> traverse (computeBound t) rs)
-  where
-    refs = nub (concatMap (subquerySlotsIn . snd) items)
-    -- | 用这一行绑定换好的表达式算出一行
-    computeBound table r = do
-        es <- boundExprs refs (r ++ outer) table
-        mapM (\(label, e) -> (,) label <$> evalExpr e (r ++ outer)) (zip (map fst items) es)
-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 (res >>= orderedRows (relOpCols db (Scan mAlias tbl cols)) . prefixRows mAlias)
-evalRelOpIn db outer (Lookup mAlias tbl col k) = do
-    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 (orderedRows (relOpCols db (Lookup mAlias tbl col k)) (prefixRows mAlias rows))
-evalRelOpIn db outer (Range mAlias tbl col lo hi) = do
-    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 (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 -> evalCondIn db e (r ++ outer)) rs
-            | otherwise -> do
-                table <- bindingsTableM db outer [e] rs
-                pure (table >>= \t -> filterM (keepBound t) rs)
-  where
-    refs = nub (subquerySlotsIn e)
-    -- | 用这一行绑定换好的条件判定
-    keepBound table r = do
-        e' <- boundExpr refs (r ++ outer) table
-        evalCondForRow e' (r ++ outer)
-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 <- 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
-        Left e -> pure (Left e)
-        Right ls -> do
-            let nested = do
-                    rres <- evalRelOpIn db outer r
-                    case rres of
-                        Left e -> pure (Left e)
-                        Right rs -> joinRowsIn db outer kind (relOpCols db r) c ls rs
-            case (r, equiKeys (relOpCols db l) (relOpCols db r) c) of
-                (Scan mAlias t _, Just ks) -> do
-                    probed <- mapM (probeIndexJoin db outer kind mAlias t ks (relOpCols db r) c) ls
-                    case sequence probed of
-                        Left e -> pure (Left e)
-                        Right ms -> case sequence ms of
-                            Just rows -> pure (Right (concat rows))
-                            Nothing -> nested
-                _ -> nested
-
--- | 扫描后按条件过滤（点查/范围查退化成扫描时用）
-scanFiltered ::
-    (MonadStorage m) =>
-    Database ->
-    Row ->
-    Maybe String ->
-    String ->
-    Expr ->
-    Execution m (Either String [Row])
-scanFiltered db outer mAlias tbl cond = do
-    res <- scanTable db tbl Nothing
-    pure $ do
-        rows <- res >>= orderedRows (relOpCols db (Scan mAlias tbl Nothing)) . prefixRows mAlias
-        filterM (evalCondForRow cond . (++ outer)) rows
-
--- | 行数到阈值才值得并行分片
-parallelRowThreshold :: Int
-parallelRowThreshold = 1000
-
--- | 表够大且存储支持并行时按分片扫，否则顺序扫
-scanTable :: (MonadStorage m) => Database -> String -> Maybe [String] -> Execution m (Either String [Row])
-scanTable db tbl cols = do
-    width <- lift parallelShards
-    if width > 1 && rows >= parallelRowThreshold
-        then lift (scanShards width 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,317 +0,0 @@
-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。
-
--- | 在一行上求出表达式的值
-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)
-evalExpr (LitStr s) _ = Right (VStr s)
-evalExpr (LitBool b) _ = Right (VBool b)
-evalExpr (LitDate s) _ = Right (VStr s)
-evalExpr (LitTimestamp s) _ = Right (VStr s)
-evalExpr (LitBlob s) _ = Right (VStr s)
-evalExpr (Add a b) row = liftOperator OpAdd a b row
-evalExpr (Sub a b) row = liftOperator OpSub a b row
-evalExpr (Mul a b) row = liftOperator OpMul a b row
-evalExpr (Div a b) row = liftOperator OpDiv a b row
-evalExpr (Neg a) row = do
-    v <- evalExpr a row
-    executeOperator OpNeg [v]
-evalExpr (Gt a b) row = liftOperator OpGt a b row
-evalExpr (Lt a b) row = liftOperator OpLt a b row
-evalExpr (Eq a b) row = liftOperator OpEq a b row
-evalExpr (GtE a b) row = liftOperator OpGtE a b row
-evalExpr (LtE a b) row = liftOperator OpLtE a b row
-evalExpr (NotEq a b) row = liftOperator OpNe a b row
-evalExpr (And a b) row = liftOperator OpAnd a b row
-evalExpr (Or a b) row = liftOperator OpOr a b row
-evalExpr (IsNull a) row = do
-    v <- evalExpr a row
-    Right (VBool (v == VNull))
-evalExpr (IsNotNull a) row = do
-    v <- evalExpr a row
-    Right (VBool (v /= VNull))
-evalExpr (InList a es negated) row = do
-    v <- evalExpr a row
-    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 (ExistsSub _ _) _ = Left subqueryNeedsDatabase
-evalExpr (QuantCmp {}) _ = Left subqueryNeedsDatabase
-evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
-
--- | 子查询要连上存储才能跑
-subqueryNeedsDatabase :: String
-subqueryNeedsDatabase = "subquery needs a database to run"
-
--- | 量词比较摊成 AND / OR 链
-quantifiedCompare :: CompareOp -> Expr -> [Expr] -> Quantifier -> Expr
-quantifiedCompare op lhs vs q = case vs of
-    [] -> LitBool (q == AllQ)
-    _ -> foldr1 (if q == AllQ then And else Or) (map (compareNode op lhs) vs)
-
--- | 表达式用到了哪些列
-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
-colsInExpr (Div a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Neg a) = colsInExpr a
-colsInExpr (Gt a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Lt a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Eq a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (GtE a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (LtE a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (NotEq a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (And a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (Or a b) = colsInExpr a ++ colsInExpr b
-colsInExpr (IsNull a) = colsInExpr a
-colsInExpr (IsNotNull a) = colsInExpr a
-colsInExpr (CountOf a) = colsInExpr a
-colsInExpr (SumOf a) = colsInExpr a
-colsInExpr (AvgOf a) = colsInExpr a
-colsInExpr (MinOf a) = colsInExpr a
-colsInExpr (MaxOf a) = colsInExpr a
-colsInExpr (ScalarSub sq) = subqueryRefs sq
-colsInExpr (InSub a sq _) = colsInExpr a ++ subqueryRefs sq
-colsInExpr (InList a es _) = colsInExpr a ++ concatMap colsInExpr es
-colsInExpr (ExistsSub sq _) = subqueryRefs sq
-colsInExpr (QuantCmp _ a sq _) = colsInExpr a ++ subqueryRefs sq
-colsInExpr _ = []
-
--- | 表达式里子查询引用的外层列
-subqueryRefsIn :: Expr -> [String]
-subqueryRefsIn = subqueryReferences subqueryRefs
-
--- | 提取子查询依赖的父布局表达式
-subquerySlotsIn :: Expr -> [Expr]
-subquerySlotsIn = subqueryReferences (map snd . subqueryColumns)
-
--- | 取得原始或已绑定的外部列
-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 -> collect a
-    Gt a b -> both a b
-    Lt a b -> both a b
-    Eq a b -> both a b
-    GtE a b -> both a b
-    LtE a b -> both a b
-    NotEq a b -> both a b
-    And a b -> both a b
-    Or a b -> both a b
-    IsNull a -> collect a
-    IsNotNull a -> collect a
-    CountOf a -> collect a
-    SumOf a -> collect a
-    AvgOf a -> collect a
-    MinOf a -> collect a
-    MaxOf a -> collect a
-    _ -> []
-  where
-    -- | 递归收集当前提取器的引用
-    collect = subqueryReferences references
-    -- | 两个子表达式的外层列拼起来
-    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
-    Sub a b -> both a b
-    Mul a b -> both a b
-    Gt a b -> both a b
-    Lt a b -> both a b
-    Eq a b -> both a b
-    GtE a b -> both a b
-    LtE a b -> both a b
-    NotEq a b -> both a b
-    And a b -> both a b
-    Or a b -> both a b
-    QuantCmp _ a _ _ -> hasDivision a
-    _ -> False
-  where
-    -- | 两个子表达式里任意一个有除法
-    both a b = hasDivision a || hasDivision b
-
--- | 表达式里有没有子查询
-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
-    InList a es _ -> any hasSubquery (a : es)
-    ExistsSub _ _ -> True
-    QuantCmp {} -> True
-    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 -> hasSubquery a
-    Gt a b -> both a b
-    Lt a b -> both a b
-    Eq a b -> both a b
-    GtE a b -> both a b
-    LtE a b -> both a b
-    NotEq a b -> both a b
-    And a b -> both a b
-    Or a b -> both a b
-    IsNull a -> hasSubquery a
-    IsNotNull a -> hasSubquery a
-    CountOf a -> hasSubquery a
-    SumOf a -> hasSubquery a
-    AvgOf a -> hasSubquery a
-    MinOf a -> hasSubquery a
-    MaxOf a -> hasSubquery a
-    _ -> False
-  where
-    -- | 两个子表达式里任意一个有
-    both a b = hasSubquery a || hasSubquery b
-
--- | 表达式里出现的聚合调用（按出现顺序）
-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]
-    a@(AvgOf _) -> [a]
-    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
-    Div a b -> both a b
-    Neg a -> aggregatesIn a
-    Gt a b -> both a b
-    Lt a b -> both a b
-    Eq a b -> both a b
-    GtE a b -> both a b
-    LtE a b -> both a b
-    NotEq a b -> both a b
-    And a b -> both a b
-    Or a b -> both a b
-    IsNull a -> aggregatesIn a
-    IsNotNull a -> aggregatesIn a
-    _ -> []
-  where
-    -- | 两个子表达式的聚合拼起来
-    both a b = aggregatesIn a ++ aggregatesIn b
-
--- | 表达式里有没有聚合调用
-hasAggregate :: Expr -> Bool
-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
-    Div a b -> both a b
-    Neg a -> bareColumns a
-    Gt a b -> both a b
-    Lt a b -> both a b
-    Eq a b -> both a b
-    GtE a b -> both a b
-    LtE a b -> both a b
-    NotEq a b -> both a b
-    And a b -> both a b
-    Or a b -> both a b
-    IsNull a -> bareColumns a
-    IsNotNull a -> bareColumns a
-    ScalarSub sq -> subqueryRefs sq
-    InSub a sq _ -> bareColumns a ++ subqueryRefs sq
-    InList a es _ -> bareColumns a ++ concatMap bareColumns es
-    ExistsSub sq _ -> subqueryRefs sq
-    QuantCmp _ a sq _ -> bareColumns a ++ subqueryRefs sq
-    _ -> []
-  where
-    -- | 两个子表达式的裸列拼起来
-    both a b = bareColumns a ++ bareColumns b
-
--- | 判断条件真假：只有 TRUE 通过，NULL 当作不通过
-evalCondForRow :: Expr -> Row -> Either String Bool
-evalCondForRow e row = do
-    v <- evalExpr e row
-    case v of
-        VBool b -> Right b
-        VNull -> Right False
-        _ -> Left "type error: WHERE condition must be a boolean"
-
--- | 二元运算节点统一走运算符权威
-liftOperator :: Operator -> Expr -> Expr -> Row -> Either String Value
-liftOperator op a b row = do
-    x <- evalExpr a row
-    y <- evalExpr b row
-    executeOperator op [x, y]

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

@@ -1,220 +0,0 @@
-module ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins) where
-
-import Data.Maybe (fromMaybe)
-import ChuSQL.Core.Engine.Algebra.Cost (pointRows, rangeRows, selectivityOf, tableMetaOf)
-import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, hasDivision, hasSubquery)
-import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
-import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
-import ChuSQL.Core.Model
-import Data.List (partition)
-
--- 内连接链顺序优化：按统计估算中间结果，只在行序不可观察处重排。
-
--- | 重排入口：顶层行序可观察
-reorderJoins :: Database -> RelOp -> RelOp
-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)
-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)
-    , length leaves > 1
-    , Just order <- cheaperOrder db leaves conds =
-        rebuildChain db (map (pass db free) order) conds
-    | otherwise = Join kind (pass db free l) (pass db free r) c
-pass _ _ op = op
-
--- | 把内连接链拆成叶子与条件，遇到外连接就放弃
-innerChain :: RelOp -> Maybe ([RelOp], [Expr])
-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 op = Just ([op], [])
-
--- | 叶子算子的估算行数，拿不到统计就是 Nothing
-leafRows :: Database -> RelOp -> Maybe Int
-leafRows db op = case op of
-    Scan _ t _ -> rowCountOf db t
-    Lookup _ t c _ -> pointRows <$> tableMetaOf db t <*> pure c
-    Range _ t c lo hi -> (\m -> rangeRows m c lo hi) <$> tableMetaOf db t
-    Filter p x | not (hasDivision p || hasSubquery p) -> scaleRows db p x <$> leafRows db x
-    Project _ x -> leafRows db x
-    Compute items x | all (\(_, e) -> not (hasDivision e || hasSubquery e)) items -> leafRows db x
-    Sort _ x -> leafRows db x
-    Limit n x -> min (max 0 n) <$> leafRows db x
-    Derived _ x -> leafRows db x
-    Unit -> Just 1
-    _ -> Nothing
-
--- | 表统计里的行数
-rowCountOf :: Database -> String -> Maybe Int
-rowCountOf db t = metaRowCount <$> tableMetaOf db t
-
--- | 行数估算：等值看不同值数，区间看直方图，其余四分之一
-scaleRows :: Database -> Expr -> RelOp -> Int -> Int
-scaleRows db p x rows = case p of
-    Eq (Col k) _ -> case distinctOf db x k of
-        Just d | d > 1 -> max 1 (rows `div` d)
-        _ -> quarter
-    Gt (Col k) (LitInt v) -> pick k (Just (VInt v, False)) Nothing
-    Gt (Col k) (LitStr v) -> pick k (Just (VStr v, False)) Nothing
-    GtE (Col k) (LitInt v) -> pick k (Just (VInt v, True)) Nothing
-    GtE (Col k) (LitStr v) -> pick k (Just (VStr v, True)) Nothing
-    Lt (Col k) (LitInt v) -> pick k Nothing (Just (VInt v, False))
-    Lt (Col k) (LitStr v) -> pick k Nothing (Just (VStr v, False))
-    LtE (Col k) (LitInt v) -> pick k Nothing (Just (VInt v, True))
-    LtE (Col k) (LitStr v) -> pick k Nothing (Just (VStr v, True))
-    Gt _ _ -> quarter
-    Lt _ _ -> quarter
-    GtE _ _ -> quarter
-    LtE _ _ -> quarter
-    NotEq _ _ -> quarter
-    QuantCmp {} -> quarter
-    And a b -> max 1 (min (scaleRows db a x rows) (scaleRows db b x rows))
-    _ -> quarter
-  where
-    quarter = max 1 (rows `div` 4)
-    pick k lo hi = case leafSource x of
-        Just (alias, t)
-            | Just m <- tableMetaOf db t
-            , Just s <- selectivityOf m (unqualify alias k) lo hi -> max 1 (round (fromIntegral rows * s))
-        _ -> quarter
-
--- | 叶子对应的别名与表名
-leafSource :: RelOp -> Maybe (Maybe String, String)
-leafSource (Scan a t _) = Just (a, t)
-leafSource (Lookup a t _ _) = Just (a, t)
-leafSource (Range a t _ _ _) = Just (a, t)
-leafSource (Filter _ x) = leafSource x
-leafSource (Project _ x) = leafSource x
-leafSource _ = Nothing
-
--- | 某列在叶子统计里的不同值数
-distinctOf :: Database -> RelOp -> String -> Maybe Int
-distinctOf db leaf col = do (alias, t) <- leafSource leaf
-                            m <- tableMetaOf db t
-                            lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
-
--- | 若干叶子里某列最大的不同值数
-distinctOn :: Database -> [RelOp] -> String -> Maybe Int
-distinctOn db leaves col = case [d | leaf <- leaves, Just d <- [distinctOf db leaf col]] of
-    [] -> Nothing
-    ds -> Just (maximum ds)
-
--- | 两侧等值键里较大的不同值数
-keyDistinct :: Database -> [RelOp] -> RelOp -> [Expr] -> Maybe Int
-keyDistinct db have x conds = case [v | Eq (Col a) (Col b) <- conds, Just v <- [pair a b]] of
-    (v : _) -> Just v
-    [] -> Nothing
-  where
-    haveCols = concatMap (relOpCols db) have
-    xCols = relOpCols db x
-    -- | 这一对列是不是两侧之间的等值键
-    pair a b
-        | a `elem` haveCols, b `elem` xCols = bigger (distinctOn db have a) (distinctOf db x b)
-        | b `elem` haveCols, a `elem` xCols = bigger (distinctOn db have b) (distinctOf db x a)
-        | otherwise = Nothing
-    -- | 两个可选统计取大的那个
-    bigger (Just a) (Just b) = Just (max a b)
-    bigger (Just a) Nothing = Just a
-    bigger Nothing (Just b) = Just b
-    bigger Nothing Nothing = Nothing
-
--- | 一次连接之后的大致行数
-stepRows :: Database -> [RelOp] -> Int -> RelOp -> [Expr] -> Int
-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 = fromMaybe 1 (leafRows db x)
-
--- | 一批叶子按给定顺序连接，累加每一步的中间结果
-chainCost :: Database -> [RelOp] -> [Expr] -> Int
-chainCost db (l : ls) conds = go [l] (fromMaybe 1 (leafRows db l)) ls
-  where
-    -- | 逐步接上后面的叶子
-    go _ _ [] = 0
-    go have acc (x : xs) =
-        let card = stepRows db have acc x conds
-         in card + go (have ++ [x]) card xs
-chainCost _ [] _ = 0
-
--- | 贪心扩展一个顺序：每次挑中间结果最小的下一张
-growOrder :: Database -> [RelOp] -> [Expr] -> [Int] -> [Int] -> [Int]
-growOrder db leaves conds have rest = case rest of
-    [] -> have
-    _ ->
-        let next = pick rest
-         in growOrder db leaves conds (have ++ [next]) (filter (/= next) rest)
-  where
-    -- | 候选里成本最低的那个，同价取序号小的
-    pick (i : is) = foldl cheaper i is
-    pick [] = 0
-    cheaper i j = if costOf j < costOf i then j else i
-    -- | 这个前缀的估算成本
-    costOf i = chainCost db [leaves !! k | k <- have ++ [i]] conds
-
--- | 每个起点贪心一遍，取最便宜的顺序
-bestOrder :: Database -> [RelOp] -> [Expr] -> [RelOp]
-bestOrder db leaves conds = pick (map start [0 .. n - 1])
-  where
-    n = length leaves
-    -- | 从第 i 张表开始的贪心顺序
-    start i = [leaves !! k | k <- growOrder db leaves conds [i] (filter (/= i) [0 .. n - 1])]
-    -- | 成本最低的那个
-    pick (o : os) = foldl cheaper o os
-    pick [] = []
-    cheaper o o' = if cost o' < cost o then o' else o
-    -- | 一个顺序的估算成本
-    cost o = chainCost db o conds
-
--- | 统计齐全、没有除法且确实更省时给出新顺序
-cheaperOrder :: Database -> [RelOp] -> [Expr] -> Maybe [RelOp]
-cheaperOrder db leaves conds
-    | any hasDivision conds = Nothing
-    | any unknown leaves = Nothing
-    | bestCost < textCost = Just best
-    | otherwise = Nothing
-  where
-    -- | 这个叶子是不是拿不到统计
-    unknown x = case leafRows db x of
-        Just _ -> False
-        Nothing -> True
-    best = bestOrder db leaves conds
-    bestCost = chainCost db best conds
-    textCost = chainCost db leaves conds
-
--- | 按新顺序重建左深链，条件挂到两侧都齐的那一步
-rebuildChain :: Database -> [RelOp] -> [Expr] -> RelOp
-rebuildChain db (l : ls) conds = go (relOpCols db l) l ls conds
-  where
-    -- | 逐个接上后面的叶子
-    go _ acc [] rest = applyConds rest acc
-    go have acc (x : xs) rest =
-        let have' = have ++ relOpCols db x
-            (now, later) = partition (\c -> colsInExpr c `subsetOf` have') rest
-         in go have' (Join InnerJoin acc x (conjOf now)) xs later
-    -- | 若干条件用 AND 串起来
-    conjOf [] = LitBool True
-    conjOf (c : cs) = foldl And c cs
-rebuildChain _ [] _ = Unit
-
--- | 挂不上去的条件套成 Filter
-applyConds :: [Expr] -> RelOp -> RelOp
-applyConds cs op = foldr Filter op cs
-
--- | 条件的列是不是都在可用列里
-subsetOf :: [String] -> [String] -> Bool
-subsetOf need have = all (`elem` have) need

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

@@ -1,94 +0,0 @@
-module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols, renderPlan) where
-
-import ChuSQL.Core.Model
-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
-    | Range (Maybe String) String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
-    | Filter Expr 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)
-
--- | 算子会产出哪些列
-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
-        Nothing -> []
-        Just t -> map (prefix ++) (colNames t)
-  where
-    prefix = maybe "" (++ ".") mAlias
-relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl Nothing)
-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)
-
--- | 连接的显示名
-kindLabel :: JoinKind -> String
-kindLabel InnerJoin = "Join"
-kindLabel LeftJoin = "LeftJoin"
-
--- | 渲染成缩进文本
-renderPlan :: RelOp -> String
-renderPlan = go 0
-  where
-    -- | 按缩进渲染一个算子
-    go ind op = case op of
-        Scan a t cols -> pad ++ "Scan " ++ show a ++ " " ++ show t ++ maybe "" ((" columns=" ++) . show) cols
-        Lookup _ t c k -> pad ++ "Lookup " ++ show t ++ "." ++ show c ++ " = " ++ show k
-        Range _ t c lo hi -> pad ++ "Range " ++ show t ++ "." ++ show c ++ " " ++ show lo ++ " .. " ++ show hi
-        Filter e x -> pad ++ "Filter " ++ show e ++ "\n" ++ go (ind + 1) x
-        Project c x -> pad ++ "Project " ++ show c ++ "\n" ++ go (ind + 1) x
-        Compute c x -> pad ++ "Compute " ++ show c ++ "\n" ++ go (ind + 1) x
-        Aggregate keys aggs x ->
-            pad
-                ++ "Aggregate keys="
-                ++ show keys
-                ++ " aggs="
-                ++ 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

@@ -1,321 +0,0 @@
-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 (..), SemiKind (..), relOpCols)
-import ChuSQL.Core.Engine.Algebra.Planner (translate)
-import ChuSQL.Core.Model
-import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Statement (..), FromClause (..), Subquery (..))
-import Data.List (nub)
-
--- 查询优化：谓词下推、投影下推、常量折叠、扫描方式与连接顺序选择。
-
--- | need 是否都在 have 里
-isSubsetOf :: [String] -> [String] -> Bool
-isSubsetOf _ ["*"] = True
-isSubsetOf need have = all (`elem` have) need
-
--- | 把 AND 链拆成清单
-splitConj :: Expr -> [Expr]
-splitConj (And a b) = splitConj a ++ splitConj b
-splitConj e = [e]
-
--- | 把条件清单用 AND 串起来
-combineConj :: [Expr] -> Maybe Expr
-combineConj [] = Nothing
-combineConj (e : es) = Just (foldl And e es)
-
--- | 条件按列归属分两边
-partitionPred :: [String] -> [Expr] -> ([Expr], [Expr])
-partitionPred have = foldr pick ([], [])
-  where
-    -- | 按列归属收到左边或右边
-    pick e (yes, no)
-        | colsInExpr e `isSubsetOf` have = (e : yes, no)
-        | otherwise = (yes, e : no)
-
--- | 依次套上若干 Filter
-applyFilters :: [Expr] -> RelOp -> RelOp
-applyFilters es op = foldl (flip Filter) op es
-
--- | Filter 压在内连接上时下推
-pushJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
-pushJoin db p l r c =
-    let preds = splitConj p
-        lCols = relOpCols db l
-        rCols = relOpCols db r
-        (lPs, rest1) = partitionPred lCols preds
-        (rPs, bothPs) = partitionPred rCols rest1
-        l' = applyFilters lPs l
-        r' = applyFilters rPs r
-        joined = Join InnerJoin l' r' c
-     in case combineConj bothPs of
-            Nothing -> joined
-            Just p' -> Filter p' joined
-
--- | Filter 压在左连接上时只下推纯左表的谓词
-pushLeftJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
-pushLeftJoin db p l r c =
-    let (lPs, rest) = partitionPred (relOpCols db l) (splitConj p)
-        joined = Join LeftJoin (applyFilters lPs l) r c
-     in case combineConj rest of
-            Nothing -> joined
-            Just p' -> Filter p' joined
-
--- | 合并两层 Filter 或挪到 Sort 下
-pushOne :: Database -> RelOp -> RelOp
-pushOne _ (Filter p (Filter q x))
-    | not (hasDivision p || hasDivision q) = Filter (And p q) x
-pushOne _ (Filter p (Sort spec x))
-    | not (hasDivision p) = Sort spec (Filter p x)
-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
-planHasDivision _ = False
-
--- | 是否要全部列
-needsAll :: [String] -> Bool
-needsAll = elem allColumns
-
--- | 叶子算子的投影下推
-pushProjectLeaf :: Database -> [String] -> RelOp -> RelOp
-pushProjectLeaf db need leaf
-    | needsAll need = leaf
-    | all (`elem` need) (relOpCols db leaf) = leaf
-    | otherwise = Project 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)
-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 =
-        let tot = need ++ colsInExpr c
-            lCols = relOpCols db l
-            rCols = relOpCols db r
-            lNeed = if needsAll lCols then ["*"] else [x | x <- tot, x `elem` lCols]
-            rNeed = if needsAll rCols then ["*"] else [x | x <- tot, x `elem` rCols]
-         in Join kind (pushProject db lNeed l) (pushProject db rNeed r) c
-pushProject db need leaf@(Scan a t _)
-    | needsAll need = leaf
-    | all (`elem` need) (relOpCols db leaf) = leaf
-    | otherwise = Scan a t (Just (nub [column | requested <- need, let column = physicalColumn requested, column `elem` available]))
-  where
-    available = map (unqualify a) (relOpCols db (Scan a t Nothing))
-    -- | 把扫描限定列换成存储物理列名
-    physicalColumn column = unqualify (Just (deriveQualifier a t)) (unqualify a column)
-pushProject db need (Derived a x)
-    | needsAll need || all (`elem` wanted) (relOpCols db x) = Derived a (pushProject db ["*"] x)
-    | otherwise = Derived a (Project wanted (pushProject db wanted x))
-  where
-    wanted = nub (map (unqualify a) need)
-pushProject db need leaf@(Lookup {}) = pushProjectLeaf db need leaf
-pushProject db need leaf@(Range {}) = pushProjectLeaf db need leaf
-
--- | 折一个表达式节点
-foldNode :: Expr -> Expr
-foldNode e
-    | null (colsInExpr e) = case evalExpr e [] of
-        Right VNull -> LitNull
-        Right (VInt n) -> LitInt n
-        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
-
--- | 自底向上折整棵表达式
-foldConstants :: Expr -> Expr
-foldConstants (Add a b) = foldNode (Add (foldConstants a) (foldConstants b))
-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))
-foldConstants (GtE a b) = foldNode (GtE (foldConstants a) (foldConstants b))
-foldConstants (LtE a b) = foldNode (LtE (foldConstants a) (foldConstants b))
-foldConstants (NotEq a b) = foldNode (NotEq (foldConstants a) (foldConstants b))
-foldConstants (QuantCmp op a sq q) = QuantCmp op (foldConstants a) sq q
-foldConstants (And a b) = foldNode (And (foldConstants a) (foldConstants b))
-foldConstants (Or a b) = foldNode (Or (foldConstants a) (foldConstants b))
-foldConstants e = e
-
--- | 点查值不值得改写；没有统计就按老规矩改
-worthLookup :: Database -> String -> String -> Bool
-worthLookup db t col = case tableMetaOf db t of
-    Nothing -> True
-    Just m -> indexCheaper m col (pointRows m col)
-
--- | 范围扫描值不值得改写；没有统计就按老规矩改
-worthRange :: Database -> String -> String -> Maybe (Value, Bool) -> Maybe (Value, Bool) -> Bool
-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))
-    | worthLookup db t (unqualify mAlias k) = Lookup mAlias t (unqualify mAlias k) (VStr v)
-rewriteNode db (Filter (And (Gt (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False))
-rewriteNode db (Filter (And (Gt (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False))
-rewriteNode db (Filter (Gt (Col k) (LitInt v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) (Just (VInt v, False)) Nothing =
-        Range mAlias t (unqualify mAlias k) (Just (VInt v, False)) Nothing
-rewriteNode db (Filter (Gt (Col k) (LitStr v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) (Just (VStr v, False)) Nothing =
-        Range mAlias t (unqualify mAlias k) (Just (VStr v, False)) Nothing
-rewriteNode db (Filter (Lt (Col k) (LitInt v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) Nothing (Just (VInt v, False)) =
-        Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, False))
-rewriteNode db (Filter (Lt (Col k) (LitStr v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) Nothing (Just (VStr v, False)) =
-        Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, False))
-rewriteNode db (Filter (And (GtE (Col k1) (LitInt lo)) (LtE (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VInt lo, True)) (Just (VInt hi, True)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VInt lo, True)) (Just (VInt hi, True))
-rewriteNode db (Filter (And (GtE (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VInt lo, True)) (Just (VInt hi, False)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VInt lo, True)) (Just (VInt hi, False))
-rewriteNode db (Filter (And (Gt (Col k1) (LitInt lo)) (LtE (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, True)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, True))
-rewriteNode db (Filter (And (GtE (Col k1) (LitStr lo)) (LtE (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VStr lo, True)) (Just (VStr hi, True)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VStr lo, True)) (Just (VStr hi, True))
-rewriteNode db (Filter (And (GtE (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VStr lo, True)) (Just (VStr hi, False)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VStr lo, True)) (Just (VStr hi, False))
-rewriteNode db (Filter (And (Gt (Col k1) (LitStr lo)) (LtE (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
-    | k1 == k2 && worthRange db t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, True)) =
-        Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, True))
-rewriteNode db (Filter (GtE (Col k) (LitInt v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) (Just (VInt v, True)) Nothing =
-        Range mAlias t (unqualify mAlias k) (Just (VInt v, True)) Nothing
-rewriteNode db (Filter (GtE (Col k) (LitStr v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) (Just (VStr v, True)) Nothing =
-        Range mAlias t (unqualify mAlias k) (Just (VStr v, True)) Nothing
-rewriteNode db (Filter (LtE (Col k) (LitInt v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) Nothing (Just (VInt v, True)) =
-        Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, True))
-rewriteNode db (Filter (LtE (Col k) (LitStr v)) (Scan mAlias t Nothing))
-    | worthRange db t (unqualify mAlias k) Nothing (Just (VStr v, True)) =
-        Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, True))
-rewriteNode db (Filter p (Join kind l r c))
-    | not (hasDivision p || planHasDivision (Join kind l r c)) =
-        case kind of
-            InnerJoin -> pushJoin db p l r c
-            LeftJoin -> pushLeftJoin db p l r c
-rewriteNode db (Filter p x) = case foldConstants p of
-    LitBool True -> x
-    p' -> pushOne db (Filter p' x)
-rewriteNode _ (Project ["*"] x) = x
-rewriteNode _ (Compute items x) = Compute [(label, foldConstants e) | (label, e) <- items] x
-rewriteNode db op = pushOne db op
-
--- | 自底向上遍历一次
-optimizeRelOp :: Database -> RelOp -> RelOp
-optimizeRelOp db = rewriteNode db . descend
-  where
-    -- | 先递归处理子算子
-    descend (Filter p x) = Filter p (optimizeRelOp db x)
-    descend (Project cols x) = Project cols (optimizeRelOp db x)
-    descend (Compute items x) = Compute items (optimizeRelOp db x)
-    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
-
--- | 反复跑到不动点
-optimizePredicates :: Database -> RelOp -> RelOp
-optimizePredicates db op =
-    let op' = optimizeRelOp db op
-     in if op' == op then op else optimizePredicates db op'
-
--- | 优化总入口
-optimize :: Database -> RelOp -> RelOp
-optimize db op = pushProject db ["*"] (reorderJoins db (optimizePredicates db op))

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

@@ -1,139 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-
-module ChuSQL.Core.Engine.Algebra.Planner (translate) where
-
-import ChuSQL.Core.Engine.Algebra.Expr (aggregatesIn, colsInExpr)
-import ChuSQL.Core.Engine.Algebra.Op
-import ChuSQL.Core.Engine.Syntax.AST
-import Data.List (nub)
-
--- 计划生成：把语句翻译成算子树。
-
--- | FROM 子句翻成关系算子
-fromToRelOp :: FromClause -> Either String RelOp
-fromToRelOp FromUnit = Right Unit
-fromToRelOp (FromTable mAlias tbl) = Right (Scan mAlias tbl Nothing)
-fromToRelOp (FromSubquery mAlias stmt) = Derived mAlias <$> translate stmt
-fromToRelOp (FromJoin kind left right cond) =
-    Join kind <$> fromToRelOp left <*> fromToRelOp right <*> pure cond
-
--- | 带上 WHERE 的来源
-source :: FromClause -> Maybe Expr -> Either String RelOp
-source fromC mWhere = do
-    op <- fromToRelOp fromC
-    Right (maybe op (`Filter` op) mWhere)
-
--- | 给用到的聚合起内部列名，同一个聚合只算一次
-nameAggs :: [(String, Expr)] -> [(String, Expr)]
-nameAggs items = go (1 :: Int) [] (concatMap (aggregatesIn . snd) items)
-  where
-    -- | 逐个聚合起名，重复的不再起名
-    go :: Int -> [(String, Expr)] -> [Expr] -> [(String, Expr)]
-    go _ acc [] = reverse acc
-    go n acc (e : es)
-        | any ((== e) . snd) acc = go n 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)
-        Div a b -> Div (go a) (go b)
-        Neg a -> Neg (go a)
-        Gt a b -> Gt (go a) (go b)
-        Lt a b -> Lt (go a) (go b)
-        Eq a b -> Eq (go a) (go b)
-        GtE a b -> GtE (go a) (go b)
-        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
-
--- | 排序 + 截断
-limited :: [(String, SortDir)] -> Maybe Int -> RelOp -> RelOp
-limited orderBy mLimit op = case mLimit of
-    Nothing -> sorted
-    Just n -> Limit n sorted
-  where
-    sorted = case orderBy of
-        [] -> op
-        spec -> Sort spec op
-
--- | 生成过滤、聚合、HAVING、排序和投影计划
-translate :: Statement -> Either String RelOp
-translate q = case q of
-    SelectDistinct inner -> do
-        ordering <- distinctOrdering inner
-        plan <- case inner of
-            s@Select{} -> translate s { selectOrderBy = [], selectLimit = Nothing }
-            _ -> Left "DISTINCT requires SELECT"
-        let labels = case inner of
-                Select { selectItems = items } -> map fst items
-                _ -> []
-        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
-        expressions <- mapM (orderExpression items . fst) orderBy
-        let aggs = nameAggs (items ++ [("having", expression) | expression <- maybe [] pure having]
-                ++ map ("order",) expressions)
-            aggregate = not (null groupBy && null aggs && null having)
-            grouped = if aggregate then Aggregate groupBy aggs plan0 else plan0
-            plan = maybe grouped (\condition -> Filter (rewriteAggs aggs condition) grouped) having
-            items' = [(label, rewriteAggs aggs expression) | (label, expression) <- items]
-            ordering = zip (map (rewriteAggs aggs) expressions) (map snd orderBy)
-            -- | 简单列排序保留可优化的名称算子
-            named (Col column, direction) = Just (column, direction)
-            named _ = Nothing
-            -- | 保持普通投影在 LIMIT 之后求值
-            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)] -> [(Expr, SortDir)] -> Maybe Int -> RelOp -> RelOp
-orderedProjection items orderBy mLimit plan =
-    Compute items (limited ordering mLimit (Compute (carried ++ keys) plan))
-  where
-    keys = [("$order" ++ show n, expression) | (n, (expression, _)) <- 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,55 +0,0 @@
-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)
-
--- 排序：按多列规格排出结果行，每列可升可降。
-
--- | 反转比较结果
-flipOrdering :: Ordering -> Ordering
-flipOrdering LT = GT
-flipOrdering GT = LT
-flipOrdering EQ = EQ
-
--- | 取出排序键（按 spec 顺序，每行只查一次）
-sortKey :: [(String, SortDir)] -> Row -> [Maybe Value]
-sortKey spec row = [lookup col row | (col, _) <- spec]
-
--- | 比较两个排序键
-compareKeys :: [SortDir] -> [Maybe Value] -> [Maybe Value] -> Ordering
-compareKeys [] _ _ = EQ
-compareKeys (dir : rest) (a : as) (b : bs) =
-    case (a, b) of
-        (Just v1, Just v2) ->
-            case compareValue v1 v2 of
-                EQ -> compareKeys rest as bs
-                o -> if dir == Desc then flipOrdering o else o
-        _ -> compareKeys rest as bs
-compareKeys _ _ _ = EQ
-
--- | 按排序规格排序若干行
-sortRows :: [(String, SortDir)] -> [Row] -> [Row]
-sortRows [] rows = rows
-sortRows spec rows = map snd (sortBy cmp (map decorate rows))
-  where
-    -- | 取键并带上原行
-    decorate row = (sortKey spec row, row)
-    -- | 比较两个带键的行
-    cmp (k1, _) (k2, _) = compareKeys (map snd spec) k1 k2
-
--- | 用绑定槽位取键并稳定排序
-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,315 +0,0 @@
-module ChuSQL.Core.Engine.Builtin (
-    Builtin (..),
-    builtinNames,
-    resolveBuiltin,
-    builtinName,
-    invokeBuiltin,
-    builtinOfExpr,
-    builtinNode,
-    aggregateArg,
-    unsupportedAggregate,
-    Operator (..),
-    operatorOfExpr,
-    operatorSymbol,
-    operatorOfCompare,
-    compareNode,
-    executeOperator,
-    threeValuedNot,
-    inValues,
-) where
-
-import ChuSQL.Core.Engine.Syntax.AST (CompareOp (..), Expr (..))
-import ChuSQL.Core.Model (Value (..), compareValue)
-import Control.Monad (foldM)
-import Data.Char (toLower)
-
--- 内置函数与运算符的唯一权威：名称解析和求值都只在这里实现一次。
-
--- | 内置聚合函数
-data Builtin = BCountAll | BCount | BSum | BAvg | BMin | BMax
-    deriving (Show, Eq, Enum, Bounded)
-
--- | 名字到内置函数的对照表，解析只认这张表
-builtinNames :: [(String, Builtin)]
-builtinNames =
-    [ ("count", BCount)
-    , ("sum", BSum)
-    , ("avg", BAvg)
-    , ("min", BMin)
-    , ("max", BMax)
-    ]
-
--- | 按名字解析内置函数，名字不分大小写
-resolveBuiltin :: String -> Maybe Builtin
-resolveBuiltin name = lookup (map toLower name) builtinNames
-
--- | 内置函数在 SQL 里的名字
-builtinName :: Builtin -> String
-builtinName BCountAll = "count"
-builtinName b = case [n | (n, x) <- builtinNames, x == b] of
-    (n : _) -> n
-    [] -> "count"
-
--- | 在一组上调用内置函数：给出行数与各行的参数值
-invokeBuiltin :: Builtin -> Int -> [Value] -> Either String Value
-invokeBuiltin BCountAll rows _ = Right (VInt rows)
-invokeBuiltin BCount _ vs = Right (VInt (length (nonNull vs)))
-invokeBuiltin BSum _ vs = case nonNull vs of
-    [] -> Right VNull
-    xs -> foldM addValue (VInt 0) xs
-invokeBuiltin BAvg _ vs = case nonNull vs of
-    [] -> Right VNull
-    xs -> do
-        total <- foldM addValue (VInt 0) xs
-        sumValue <- numberOf total
-        Right (VFloat (sumValue / fromIntegral (length xs)))
-invokeBuiltin BMin _ vs = extremeOf lower (nonNull vs)
-invokeBuiltin BMax _ vs = extremeOf higher (nonNull vs)
-
--- | 去掉 NULL
-nonNull :: [Value] -> [Value]
-nonNull = filter (/= VNull)
-
--- | 聚合节点对应的内置函数；其余节点给 Nothing
-builtinOfExpr :: Expr -> Maybe Builtin
-builtinOfExpr CountAll = Just BCountAll
-builtinOfExpr (CountOf _) = Just BCount
-builtinOfExpr (SumOf _) = Just BSum
-builtinOfExpr (AvgOf _) = Just BAvg
-builtinOfExpr (MinOf _) = Just BMin
-builtinOfExpr (MaxOf _) = Just BMax
-builtinOfExpr _ = Nothing
-
--- | 内置函数对应的 AST 节点
-builtinNode :: Builtin -> Expr -> Expr
-builtinNode BCountAll _ = CountAll
-builtinNode BCount e = CountOf e
-builtinNode BSum e = SumOf e
-builtinNode BAvg e = AvgOf e
-builtinNode BMin e = MinOf e
-builtinNode BMax e = MaxOf e
-
--- | 聚合调用的参数表达式，COUNT(*) 没有参数
-aggregateArg :: Expr -> Maybe Expr
-aggregateArg (CountOf x) = Just x
-aggregateArg (SumOf x) = Just x
-aggregateArg (AvgOf x) = Just x
-aggregateArg (MinOf x) = Just x
-aggregateArg (MaxOf x) = Just x
-aggregateArg _ = Nothing
-
--- | 只支持这几个聚合函数
-unsupportedAggregate :: String
-unsupportedAggregate = "only COUNT, SUM, AVG, MIN and MAX can be aggregated"
-
--- | 数值相加：整数配整数还是整数
-addValue :: Value -> Value -> Either String Value
-addValue (VInt a) (VInt b) = Right (VInt (a + b))
-addValue (VInt a) (VFloat b) = Right (VFloat (fromIntegral a + b))
-addValue (VFloat a) (VInt b) = Right (VFloat (a + fromIntegral b))
-addValue (VFloat a) (VFloat b) = Right (VFloat (a + b))
-addValue _ _ = Left "type error: expected two numbers"
-
--- | 能当数用的值
-numberOf :: Value -> Either String Double
-numberOf (VInt n) = Right (fromIntegral n)
-numberOf (VFloat d) = Right d
-numberOf _ = Left "type error: expected a number"
-
--- | 一组值里的极值，空组给 NULL
-extremeOf :: (Value -> Value -> Value) -> [Value] -> Either String Value
-extremeOf _ [] = Right VNull
-extremeOf pick (x : xs) = Right (foldl pick x xs)
-
--- | 取更小的那个
-lower :: Value -> Value -> Value
-lower a b = if compareValue b a == LT then b else a
-
--- | 取更大的那个
-higher :: Value -> Value -> Value
-higher a b = if compareValue b a == GT then b else a
-
--- | 运算符：AST 里的每个运算节点对应一个
-data Operator
-    = OpAdd
-    | OpSub
-    | OpMul
-    | OpDiv
-    | OpNeg
-    | OpGt
-    | OpLt
-    | OpEq
-    | OpGtE
-    | OpLtE
-    | OpNe
-    | OpAnd
-    | OpOr
-    deriving (Show, Eq, Enum, Bounded)
-
--- | 运算符的 SQL 写法
-operatorSymbol :: Operator -> String
-operatorSymbol OpAdd = "+"
-operatorSymbol OpSub = "-"
-operatorSymbol OpMul = "*"
-operatorSymbol OpDiv = "/"
-operatorSymbol OpNeg = "-"
-operatorSymbol OpGt = ">"
-operatorSymbol OpLt = "<"
-operatorSymbol OpEq = "="
-operatorSymbol OpGtE = ">="
-operatorSymbol OpLtE = "<="
-operatorSymbol OpNe = "<>"
-operatorSymbol OpAnd = "AND"
-operatorSymbol OpOr = "OR"
-
--- | 运算节点对应的运算符；其余节点给 Nothing
-operatorOfExpr :: Expr -> Maybe Operator
-operatorOfExpr (Add _ _) = Just OpAdd
-operatorOfExpr (Sub _ _) = Just OpSub
-operatorOfExpr (Mul _ _) = Just OpMul
-operatorOfExpr (Div _ _) = Just OpDiv
-operatorOfExpr (Neg _) = Just OpNeg
-operatorOfExpr (Gt _ _) = Just OpGt
-operatorOfExpr (Lt _ _) = Just OpLt
-operatorOfExpr (Eq _ _) = Just OpEq
-operatorOfExpr (GtE _ _) = Just OpGtE
-operatorOfExpr (LtE _ _) = Just OpLtE
-operatorOfExpr (NotEq _ _) = Just OpNe
-operatorOfExpr (And _ _) = Just OpAnd
-operatorOfExpr (Or _ _) = Just OpOr
-operatorOfExpr _ = Nothing
-
--- | 量词比较里的比较运算符
-operatorOfCompare :: CompareOp -> Operator
-operatorOfCompare CmpEq = OpEq
-operatorOfCompare CmpNe = OpNe
-operatorOfCompare CmpGt = OpGt
-operatorOfCompare CmpGtE = OpGtE
-operatorOfCompare CmpLt = OpLt
-operatorOfCompare CmpLtE = OpLtE
-
--- | 量词比较在字面量上的节点
-compareNode :: CompareOp -> Expr -> Expr -> Expr
-compareNode CmpEq = Eq
-compareNode CmpNe = NotEq
-compareNode CmpGt = Gt
-compareNode CmpGtE = GtE
-compareNode CmpLt = Lt
-compareNode CmpLtE = LtE
-
--- | 运算符求值：算错个数是内部错误
-executeOperator :: Operator -> [Value] -> Either String Value
-executeOperator op vs = case (op, vs) of
-    (OpNeg, [x]) -> evalNeg x
-    (OpGt, [x, y]) -> compareValues (== GT) x y
-    (OpLt, [x, y]) -> compareValues (< EQ) x y
-    (OpEq, [x, y]) -> compareValues (== EQ) x y
-    (OpGtE, [x, y]) -> compareValues (>= EQ) x y
-    (OpLtE, [x, y]) -> compareValues (<= EQ) x y
-    (OpNe, [x, y]) -> compareValues (/= EQ) x y
-    (OpAnd, [x, y]) -> andValues x y
-    (OpOr, [x, y]) -> orValues x y
-    (_, [x, y]) | Just a <- arithOf op -> evalArith a x y
-    _ -> Left ("internal error: wrong operand count for operator " ++ operatorSymbol op)
-
--- | 取负
-evalNeg :: Value -> Either String Value
-evalNeg VNull = Right VNull
-evalNeg (VInt n) = Right (VInt (negate n))
-evalNeg (VFloat d) = Right (VFloat (negate d))
-evalNeg _ = Left "type error: expected a number"
-
--- | 整数算术与浮点算术成对出现
-data Arith = Arith
-    { arithInt :: Int -> Int -> Either String Int
-    , arithFloat :: Double -> Double -> Either String Double
-    }
-
--- | 二元算术运算符对应的实现
-arithOf :: Operator -> Maybe Arith
-arithOf OpAdd = Just (Arith (\x y -> Right (x + y)) (\x y -> Right (x + y)))
-arithOf OpSub = Just (Arith (\x y -> Right (x - y)) (\x y -> Right (x - y)))
-arithOf OpMul = Just (Arith (\x y -> Right (x * y)) (\x y -> Right (x * y)))
-arithOf OpDiv = Just divArith
-arithOf _ = Nothing
-
--- | 一边是 NULL 就出 NULL，两边都是整数就出整数
-evalArith :: Arith -> Value -> Value -> Either String Value
-evalArith _ VNull _ = Right VNull
-evalArith _ _ VNull = Right VNull
-evalArith ops (VInt x) (VInt y) = VInt <$> arithInt ops x y
-evalArith ops x y = case (asDouble x, asDouble y) of
-    (Just p, Just q) -> VFloat <$> arithFloat ops p q
-    _ -> Left "type error: expected two numbers"
-
--- | 整数除法向零截断，溢出返回错误；浮点除法不能除以零
-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)
-
--- | 能当数用的值
-asDouble :: Value -> Maybe Double
-asDouble (VInt n) = Just (fromIntegral n)
-asDouble (VFloat d) = Just d
-asDouble _ = Nothing
-
--- | 比较两个值：NULL 给 NULL，其余按全序比
-compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
-compareValues rel x y
-    | x == VNull || y == VNull = Right VNull
-    | comparableValue x y = Right (VBool (rel (compareValue x y)))
-    | otherwise = Left "type error: cannot compare these values"
-
--- | 两个值是否落在可以用全序比较的同一族里
-comparableValue :: Value -> Value -> Bool
-comparableValue (VInt _) (VFloat _) = True
-comparableValue (VFloat _) (VInt _) = True
-comparableValue (VInt _) (VInt _) = True
-comparableValue (VFloat _) (VFloat _) = True
-comparableValue (VStr _) (VStr _) = True
-comparableValue (VBool _) (VBool _) = True
-comparableValue _ _ = False
-
--- | 逻辑与的三值真值表
-andValues :: Value -> Value -> Either String Value
-andValues (VBool False) _ = Right (VBool False)
-andValues _ (VBool False) = Right (VBool False)
-andValues (VBool True) (VBool True) = Right (VBool True)
-andValues VNull (VBool True) = Right VNull
-andValues (VBool True) VNull = Right VNull
-andValues VNull VNull = Right VNull
-andValues _ _ = Left "type error: expected two booleans"
-
--- | 逻辑或的三值真值表
-orValues :: Value -> Value -> Either String Value
-orValues (VBool True) _ = Right (VBool True)
-orValues _ (VBool True) = Right (VBool True)
-orValues (VBool False) (VBool False) = Right (VBool False)
-orValues VNull (VBool False) = Right VNull
-orValues (VBool False) VNull = Right VNull
-orValues VNull VNull = Right VNull
-orValues _ _ = Left "type error: expected two booleans"
-
--- | NOT 的三值取反
-threeValuedNot :: Value -> Value
-threeValuedNot (VBool b) = VBool (not b)
-threeValuedNot _ = VNull
-
--- | 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
-    Right $
-        if VBool True `elem` results
-            then VBool True
-            else if VNull `elem` results then VNull else VBool False

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

@@ -1,82 +0,0 @@
-module ChuSQL.Core.Engine.Error (
-    ErrorCategory (..),
-    ErrorRule (..),
-    errorRules,
-    errorCategory,
-    errorCode,
-    errorLike,
-    accountErrorCode,
-) where
-
-import Data.List (isInfixOf)
-
--- 引擎与存储错误文本的唯一分类表和协议错误码表
-
--- | 错误大类
-data ErrorCategory
-    = NoDatabaseError
-    | PermissionError
-    | CatalogError
-    | TypeError
-    | StorageError
-    | ProtocolError
-    | UnknownError
-    deriving (Eq, Show)
-
--- | 一条识别规则：命中文本片段就算这一类，并给出协议错误码
-data ErrorRule = ErrorRule
-    { ruleMarker :: String
-    , ruleCategory :: ErrorCategory
-    , ruleCode :: String
-    }
-
--- | 唯一的错误识别表，顺序即优先级
-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"
-    , ErrorRule "unknown column" CatalogError "query_error"
-    , ErrorRule "unknown database" CatalogError "not_found"
-    , ErrorRule "unknown role" CatalogError "not_found"
-    , ErrorRule "unknown account" CatalogError "not_found"
-    , ErrorRule "unknown index" CatalogError "query_error"
-    , ErrorRule "unknown user" CatalogError "query_error"
-    , ErrorRule "permission denied" PermissionError "query_error"
-    , ErrorRule "already exists" CatalogError "query_error"
-    , ErrorRule "type error" TypeError "query_error"
-    , ErrorRule "cannot put this value into" TypeError "query_error"
-    , ErrorRule "division by zero" TypeError "query_error"
-    , ErrorRule "overflow" TypeError "query_error"
-    , ErrorRule "storage" StorageError "query_error"
-    , ErrorRule "storage library call failed" StorageError "query_error"
-    , ErrorRule "unsupported protocol" ProtocolError "query_error"
-    , ErrorRule "executed by the session" ProtocolError "query_error"
-    , ErrorRule "transaction" ProtocolError "query_error"
-    ]
-
--- | 命中的第一条规则
-errorLike :: String -> Maybe ErrorRule
-errorLike message = case [r | r <- errorRules, ruleMarker r `isInfixOf` message] of
-    [] -> Nothing
-    (r : _) -> Just r
-
--- | 错误文本属于哪一大类
-errorCategory :: String -> ErrorCategory
-errorCategory message = maybe UnknownError ruleCategory (errorLike message)
-
--- | 错误文本对应的协议错误码
-errorCode :: String -> String
-errorCode message = maybe "query_error" ruleCode (errorLike message)
-
--- | 账号服务对外的错误码
-accountErrorCode :: String -> String
-accountErrorCode "account already exists" = "conflict"
-accountErrorCode "identity already exists" = "conflict"
-accountErrorCode "the last enabled login superuser cannot be removed" = "bad_request"
-accountErrorCode "unknown account" = "not_found"
-accountErrorCode _ = "storage_error"

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

@@ -1,151 +0,0 @@
-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

@@ -1,73 +0,0 @@
-module ChuSQL.Core.Engine.Parallel (
-    parallelShardLimit,
-    Pool,
-    workerPool,
-    poolRun,
-) where
-
-import Control.Concurrent (forkIO)
-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)
-
--- 并行执行：常驻工作线程池，结果按提交顺序收回。
-
--- | 单次并行扫描最多切几片
-parallelShardLimit :: Int
-parallelShardLimit = 8
-
--- | 池：工作线程共享的待办队列
-newtype Pool = Pool (Chan (IO ()))
-
-{-# NOINLINE poolRef #-}
-
--- | 进程全局的池，按容量复用
-poolRef :: MVar (Maybe (Int, Pool))
-poolRef = unsafePerformIO (newMVar Nothing)
-
--- | 按容量取池，不够就新建一个
-workerPool :: Int -> IO Pool
-workerPool size = modifyMVar poolRef reuse
-  where
-    -- \| 复用队列并按需补充工作线程
-    reuse current = case current of
-        Just (capacity, pool@(Pool jobs))
-            | capacity >= wanted -> pure (current, pool)
-            | 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 个常驻线程吃队列
-    startPool n = do
-        jobs <- newChan
-        sequence_ [forkIO (worker jobs) | _ <- [1 .. n]]
-        pure (Pool jobs)
-
--- | 一个工作线程：等待并执行队首待办
-worker :: Chan (IO ()) -> IO ()
-worker jobs = forever (join (readChan jobs))
-
--- | 往池里丢一个待办
-submit :: Pool -> IO () -> IO ()
-submit (Pool jobs) = writeChan jobs
-
--- | 跑一个动作，结果或异常都填进格子
-fillCell :: MVar (Either SomeException a) -> IO a -> IO ()
-fillCell cell act = try act >>= putMVar cell
-
--- | 并发跑一批动作，按输入顺序返回结果与异常
-poolRun :: Pool -> [IO a] -> IO [a]
-poolRun _ [] = pure []
-poolRun pool actions = do
-    cells <- mapM (const newEmptyMVar) actions
-    sequence_ [submit pool (fillCell cell act) | (cell, act) <- zip cells actions]
-    outcomes <- mapM takeMVar cells
-    mapM (either throwIO pure) outcomes

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

@@ -1,177 +0,0 @@
-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

@@ -1,111 +0,0 @@
-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

@@ -1,80 +0,0 @@
-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

@@ -1,76 +0,0 @@
-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

@@ -1,152 +0,0 @@
-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

@@ -1,99 +0,0 @@
-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

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

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

@@ -1,129 +0,0 @@
-module ChuSQL.Core.Engine.Storage (
-    MonadStorage (..),
-    IndexResult (..),
-) where
-
-import ChuSQL.Core.Model (Column, Database, Row, Table (..), Value (..))
-
--- 存储层抽象：MonadStorage 类与 IndexResult。
-
-data IndexResult
-    = IndexRows [Row]
-    | NoIndex
-    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 [])
-
-    -- \| 全表扫描
-    scan :: String -> m (Either String [Row])
-
-    -- \| 只返回指定列；空清单保留每行的存在性。
-    scanColumns :: String -> [String] -> m (Either String [Row])
-    scanColumns t cols = do
-        result <- scan t
-        pure (fmap (map (\row -> [(c, v) | c <- cols, Just v <- [lookup c row]])) result)
-
-    -- \| 本存储能用的并行分片数；不支持并行的存储返回 1
-    parallelShards :: m Int
-    parallelShards = pure 1
-
-    -- \| 按分片并行扫描并按分片序拼接；默认退回顺序扫描
-    scanShards :: Int -> String -> Maybe [String] -> m (Either String [Row])
-    scanShards _ t = maybe (scan t) (scanColumns t)
-
-    -- \| 追加一行
-    insert :: String -> Row -> m (Either String ())
-
-    -- \| 一批行一起追加
-    insertMany :: String -> [Row] -> m (Either String ())
-    insertMany t = go
-      where
-        -- \| 逐行插入，出错就停
-        go [] = pure (Right ())
-        go (r : rs) = do
-            x <- insert t r
-            case x of
-                Left e -> pure (Left e)
-                Right _ -> go rs
-
-    -- \| 按 id 批量删行
-    deleteKeys :: String -> [Int] -> m (Either String ())
-    deleteKeys t ks = do
-        rows <- scan t
-        case rows of
-            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
-
-    -- \| 整表替换
-    replaceAll :: String -> [Row] -> m (Either String ())
-
-    -- \| 按某一列的索引取一行（键可以是整数或字符串）
-    lookupByColumn :: String -> String -> Value -> m (Either String IndexResult)
-    lookupByColumn _ _ _ = pure (Right NoIndex)
-
-    -- \| 按某一列的索引做范围扫描；没有可用索引就回 Nothing
-    scanRange ::
-        String ->
-        String ->
-        Maybe (Value, Bool) ->
-        Maybe (Value, Bool) ->
-        m (Either String (Maybe [Row]))
-    scanRange _ _ _ _ = pure (Right Nothing)
-
-    -- \| 建一张空表
-    createTable :: String -> [(String, Column)] -> m (Either String ())
-
-    -- \| 删除表
-    dropTable :: String -> m (Either String ())
-
-    -- \| 给某一列建索引（id 列要求唯一）
-    createIndex :: String -> String -> m (Either String ())
-    createIndex _ _ = pure (Right ())
-
-    -- \| 去掉某一列的索引
-    dropIndex :: String -> String -> m (Either String ())
-    dropIndex _ _ = pure (Right ())
-
-    -- \| 删一列，连它的索引与数据一起去掉
-    dropColumn :: String -> String -> m (Either String ())
-
-    -- \| ALTER 用：整表换列定义与全部行
-    replaceSchema :: String -> [(String, Column)] -> [Row] -> m (Either String ())
-
-    -- \| 取全库快照（表名 + 列 + 全部行）
-    snapshot :: m (Either String Database)
-
-    -- \| 取全库结构：只要表名和列，不要行
-    schema :: m (Either String Database)
-    schema = fmap (fmap (map withoutRows)) snapshot
-      where
-        -- \| 表定义去掉所有行
-        withoutRows (name, t) = (name, t{tableRows = []})

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

@@ -1,113 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-
-module ChuSQL.Core.Engine.Storage.FFI (
-    StorageHandle,
-    storageVersion,
-    openStorage,
-    closeStorage,
-    storageRequest,
-    maintainStorage,
-) where
-
-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
-import Data.Text.Encoding.Error (lenientDecode)
-import Foreign
-import Foreign.C
-
--- Rust 存储库 cdylib 的 C ABI 绑定（ffi.rs），收发单行 JSON。
--- 错误读取绑定同一 OS 线程；响应复制期间屏蔽取消并归还缓冲。
-
--- | 存储实例句柄（Rust 侧的 *mut Storage）
-newtype StorageHandle = StorageHandle (Ptr ())
-
-foreign import ccall unsafe "chusql_storage_version"
-    cStorageVersion :: IO CString
-
-foreign import ccall safe "chusql_storage_open"
-    cStorageOpen :: CString -> IO (Ptr ())
-
-foreign import ccall safe "chusql_storage_close"
-    cStorageClose :: Ptr () -> IO ()
-
-foreign import ccall safe "chusql_storage_request"
-    cStorageRequest :: Ptr () -> Ptr CChar -> CSize -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt
-
-foreign import ccall unsafe "chusql_storage_free"
-    cStorageFree :: Ptr CChar -> CSize -> IO ()
-
-foreign import ccall unsafe "chusql_storage_last_error"
-    cStorageLastError :: Ptr CSize -> IO (Ptr CChar)
-
-foreign import ccall safe "chusql_storage_maintenance"
-    cStorageMaintenance :: CString -> Ptr CChar -> CSize -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt
-
--- | 离线修复系统目录并返回结果
-maintainStorage :: FilePath -> BS.ByteString -> IO (Either String BS.ByteString)
-maintainStorage path payload = BS.useAsCString (TE.encodeUtf8 (T.pack path)) $ \config ->
-    callStorage (cStorageMaintenance config) payload
-
--- | 库版本（Rust 侧的 CARGO_PKG_VERSION）
-storageVersion :: IO String
-storageVersion = cStorageVersion >>= peekCString
-
--- | 打开存储实例，失败给错误文本
-openStorage :: Maybe FilePath -> IO (Either String StorageHandle)
-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))
-        Right ptr
-            | ptr == nullPtr -> Left <$> lastError
-            | otherwise -> pure (Right (StorageHandle ptr))
-  where
-    -- \| 没有路径就传空指针，否则转成 C 字符串
-    withCStringOrNull Nothing f = f nullPtr
-    withCStringOrNull (Just s) f = BS.useAsCString (TE.encodeUtf8 (T.pack s)) f
-
--- | 关掉存储实例
-closeStorage :: StorageHandle -> IO ()
-closeStorage (StorageHandle handle) = cStorageClose handle
-
--- | 一条 JSON 请求换一条 JSON 响应
-storageRequest :: StorageHandle -> BS.ByteString -> IO (Either String BS.ByteString)
-storageRequest (StorageHandle handle) = callStorage (cStorageRequest handle)
-
--- | 调用存储并复制和归还响应缓冲
-callStorage ::
-    (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
-                        output <- peek outRef
-                        len <- peek lenRef
-                        bytes <-
-                            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
-    ptr <- cStorageLastError lenRef
-    if ptr == nullPtr
-        then pure "storage: unknown error"
-        else do
-            len <- peek lenRef
-            raw <- BS.packCStringLen (ptr, fromIntegral len)
-            pure (T.unpack (TE.decodeUtf8With lenientDecode raw))

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

@@ -1,472 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Core.Engine.Storage.IPC (
-    IPCStorage (..),
-    Env (..),
-    envForDatabase,
-    defaultEnv,
-    runIPCStorage,
-    Request (..),
-    Response (..),
-    Account (..),
-    SchemaColumn (..),
-    TableInfo (..),
-    StorageLink (..),
-    setStorageLink,
-    localStorageLink,
-    sendRequest,
-    sendRawRequest,
-    closeConnection,
-    setDatabaseName,
-    getDatabaseName,
-    doListTables,
-    doLookupByColumn,
-    doInsert,
-    doInsertMany,
-    doDeleteKeys,
-    doDescribeTable,
-    doDropTable,
-    doListCatalog,
-) where
-
-import Data.Foldable (for_)
-import Control.Monad (when)
-import ChuSQL.Core.Engine.Parallel (parallelShardLimit, poolRun, workerPool)
-import ChuSQL.Core.Engine.Storage
-import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest)
-import ChuSQL.Core.Model
-import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
-import Control.Concurrent (getNumCapabilities)
-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)
-import System.IO.Unsafe (unsafePerformIO)
-
--- IPC 存储实现：把 MonadStorage 的操作变成发给存储库的 JSON 请求。
-
--- | 一条会话的存储环境：当前库名随会话走，不共享
-data Env = Env
-    { envDatabase :: Maybe String
-    , envSchemaGuard :: Maybe Database
-    }
-
-newtype IPCStorage a = IPCStorage
-    { runIPCStorageIn :: Env -> IO a
-    }
-
--- | 按库名造一个会话环境
-envForDatabase :: Maybe String -> Env
-envForDatabase name = Env name Nothing
-
--- | 进程默认环境：读全局库名，给测试与 CLI 用
-defaultEnv :: IO Env
-defaultEnv = envForDatabase <$> readMVar databaseRef
-
--- | 用进程默认环境跑（兼容既有调用点）
-runIPCStorage :: IPCStorage a -> IO a
-runIPCStorage action = defaultEnv >>= runIPCStorageIn action
-
-instance Functor IPCStorage where
-    fmap f (IPCStorage m) = IPCStorage (fmap f . m)
-
-instance Applicative IPCStorage where
-    pure = IPCStorage . const . pure
-    IPCStorage mf <*> IPCStorage ma = IPCStorage $ \env -> mf env <*> ma env
-
-instance Monad IPCStorage where
-    IPCStorage m >>= k = IPCStorage $ \env -> do
-        a <- m env
-        runIPCStorageIn (k a) env
-
--- | 一条到存储库的链路：管请求与关闭
-data StorageLink = StorageLink
-    { slRequest :: BS.ByteString -> IO (Either String BS.ByteString)
-    , slClose :: IO ()
-    }
-
-{-# 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 $ \_ -> 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
-            , slClose = closeStorage handle
-            }
-
--- | 关掉当前链路（进程退出前调用）；没有链路就什么都不做
-closeConnection :: IO ()
-closeConnection = modifyMVar_ linkRef $ \current -> withMVar (snd linkUsers) $ \_ -> do
-    for_ current slClose
-    pure Nothing
-
--- | 发一条请求并解码应答；链路没装就报错，不崩
-sendRequest :: Request -> IO Response
-sendRequest req = withStorageLink $ \case
-                                      Nothing -> pure (RespError "storage not configured")
-                                      Just link
-                                        -> do raw <- slRequest link (BL.toStrict (encode req))
-                                              case raw of
-                                                Left e -> pure (RespError ("storage error: " ++ e))
-                                                Right bytes
-                                                  -> case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
-                                                       Left e -> pure (RespError ("decode error: " ++ e))
-                                                       Right resp -> pure resp
-
--- | 原样转发一条载荷给存储库
-sendRawRequest :: BS.ByteString -> IO (Either String BS.ByteString)
-sendRawRequest payload = withStorageLink $ \current -> do
-    case current of
-        Nothing -> pure (Left "storage not configured")
-        Just link -> slRequest link payload
-
-{-# NOINLINE databaseRef #-}
-
--- | 进程全局的当前库名
-databaseRef :: MVar (Maybe String)
-databaseRef = unsafePerformIO (newMVar Nothing)
-
--- | 设定当前库名（会话层决定，本层只记住并发给存储）
-setDatabaseName :: Maybe String -> IO ()
-setDatabaseName name = modifyMVar_ databaseRef (const (pure name))
-
--- | 当前库名
-getDatabaseName :: IO (Maybe String)
-getDatabaseName = readMVar databaseRef
-
--- | 给语句类请求盖上当前库名
-stampDatabase :: Maybe String -> Request -> Request
-stampDatabase Nothing req = req
-stampDatabase (Just db) req
-    | globalRequest req = req
-    | otherwise = ReqInDatabase db req
-
--- | 是不是不该带库名的全局请求
-globalRequest :: Request -> Bool
-globalRequest ReqDatabase{} = True
-globalRequest ReqAllCatalog = True
-globalRequest ReqAccountsList = True
-globalRequest ReqAccountCreate{} = True
-globalRequest ReqAccountReset{} = True
-globalRequest ReqAccountLogin{} = True
-globalRequest ReqAccountDrop{} = True
-globalRequest ReqPing = True
-globalRequest _ = False
-
--- | 发请求并把响应翻成 Either
-ask :: Env -> String -> Request -> (Response -> Maybe a) -> IO (Either String a)
-ask env what req recognize = do
-    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 ()
-okOnly _ = Nothing
-
--- | 发 Scan
-doScan :: Env -> String -> IO (Either String [Row])
-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) $ \case
-                                                                      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) $ \case
-                                                                                                  RespRows rows -> Just rows
-                                                                                                  _ -> Nothing
-
--- | 发 Insert（索引由存储层维护）
-doInsert :: Env -> String -> Row -> IO (Either String ())
-doInsert env t r = ask env "insert" (ReqInsert t r) okOnly
-
--- | 发 InsertBatch：一批行一次请求
-doInsertMany :: Env -> String -> [Row] -> IO (Either String ())
-doInsertMany env t rs = ask env "insert_batch" (ReqInsertBatch t rs) okOnly
-
--- | 发 DeleteKeys
-doDeleteKeys :: Env -> String -> [Int] -> IO (Either String ())
-doDeleteKeys env t ks = ask env "delete_keys" (ReqDeleteKeys t ks) okOnly
-
--- | 发 ListTables
-doListTables :: Env -> IO (Either String [String])
-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 $ \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) $ \case
-                                                                                     RespRows rows -> Just (IndexRows rows)
-                                                                                     RespNoIndex -> Just NoIndex
-                                                                                     _ -> Nothing
-
--- | 范围扫描：没有可用索引就回 Nothing，让上层退回扫描
-doScanRange ::
-    Env ->
-    String ->
-    String ->
-    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) $ \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) $ \case
-                                                                          RespSchema info -> Just info
-                                                                          _ -> Nothing
-
--- | 发 DropTable
-doDropTable :: Env -> String -> IO (Either String ())
-doDropTable env t = ask env "drop_table" (ReqDropTable t) okOnly
-
--- | 线上 schema 转本地列
-schemaToColumns :: [SchemaColumn] -> [(String, Column)]
-schemaToColumns = map toColumn
-
--- | 线上 schema 转本地 column
-toColumn :: SchemaColumn -> (String, Column)
-toColumn sc =
-    ( scName sc
-    , Column
-        { columnType = fromMaybe CStr (parseColumnType (scType sc))
-        , columnNullable = scNullable sc
-        , columnDefault = scDefault sc
-        , columnAutoIncrement = scAutoIncrement sc
-        , columnUnique = scUnique sc
-        , columnPrimaryKey = scPrimaryKey sc
-        , columnCheck = scCheck sc
-        }
-    )
-
--- | 本地列转线上 schema
-toWire :: (String, Column) -> SchemaColumn
-toWire (n, c) =
-    SchemaColumn
-        { scName = n
-        , scType = typeName (columnType c)
-        , scNullable = columnNullable c
-        , scDefault = columnDefault c
-        , scAutoIncrement = columnAutoIncrement c
-        , scPrimaryKey = columnPrimaryKey c
-        , scUnique = columnUnique c
-        , scCheck = columnCheck 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" "") $ \case
-                                                                                                        RespTables names -> Just names
-                                                                                                        _ -> Nothing
-
-    -- \| 发 Scan
-    scan t = IPCStorage (`doScan` t)
-
-    -- \| 只取指定列
-    scanColumns t cols = IPCStorage (\env -> doScanColumns env t cols)
-
-    -- \| 并行分片数：按 RTS 能力数，封顶在 parallelShardLimit
-    parallelShards = IPCStorage $ \_ -> do max 1 . min parallelShardLimit <$> getNumCapabilities
-
-    -- \| 分片并行扫，再按分片序拼接
-    scanShards width t cols
-        | width <= 1 = IPCStorage (\env -> maybe (doScan env t) (doScanColumns env t) cols)
-        | otherwise = IPCStorage $ \env -> do
-            pool <- workerPool width
-            parts <- poolRun pool [doScanShard env t cols shard width | shard <- [0 .. width - 1]]
-            pure (fmap concat (sequence parts))
-
-    -- \| 发 Insert（索引由存储层自己维护）
-    insert t r = IPCStorage (\env -> doInsert env t r)
-
-    -- \| 一批行一次请求：N 行只落一次盘
-    insertMany t rs = IPCStorage (\env -> doInsertMany env t rs)
-
-    -- \| 按 id 批量删行
-    deleteKeys t ks = IPCStorage (\env -> doDeleteKeys env t ks)
-
-    -- \| 发 ReplaceAll
-    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)
-
-    -- \| 范围扫描（没有索引就回 Nothing）
-    scanRange t c lo hi = IPCStorage (\env -> doScanRange env t c lo hi)
-
-    -- \| 发 CreateTable
-    createTable name cols = IPCStorage $ \env -> ask env "create_table" (ReqCreateTable name (map toWire cols)) okOnly
-
-    -- \| ALTER：整表换列定义与全部行
-    replaceSchema name cols rows = IPCStorage $ \env -> ask env "replace_schema" (ReqReplaceSchema name (map toWire cols) rows) okOnly
-
-    -- \| 发 DropTable
-    dropTable name = IPCStorage (`doDropTable` name)
-
-    -- \| 建索引
-    createIndex t c = IPCStorage $ \env -> ask env "create_index" (ReqCreateIndex t c) okOnly
-
-    -- \| 删索引
-    dropIndex t c = IPCStorage $ \env -> ask env "drop_index" (ReqDropIndex t c) okOnly
-
-    -- \| 删一列
-    dropColumn t c = IPCStorage $ \env -> ask env "drop_column" (ReqDropColumn t c) okOnly
-
-    -- \| 列表 + 逐表扫描拼库
-    snapshot = IPCStorage $ \env -> do
-        result <- doListCatalog env
-        case result of
-            Left err -> pure (Left err)
-            Right xs -> fmap sequence (mapM (loadEntry env) xs)
-      where
-        -- \| 读取表数据并保留扫描错误
-        loadEntry env info = do
-            rows <- doScan env (tiTable info)
-            pure $
-                fmap
-                    ( \rs ->
-                        ( tiTable info
-                        , Table (tiTable info) (schemaToColumns (tiColumns info)) rs (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info)
-                        )
-                    )
-                    rows
-
-    -- \| 只问数据字典要结构，设了当前库只留它的表
-    schema = IPCStorage $ \env -> do
-        result <- ask env "all_catalogs" ReqAllCatalog $ \case
-                                                           RespCatalog infos -> Just infos
-                                                           _ -> Nothing
-        pure (fmap (concatMap (visibleTables (envDatabase env))) result)
-
--- | 线上表信息转引擎侧统计
-metaOf :: TableInfo -> TableMeta
-metaOf info = TableMeta (tiRows info) (tiStats info) (tiHistograms info) (tiIndexes info)
-
--- | 没设库名就照单全收；设了库名只收这个库的表，键名去掉库名前缀
-visibleTables :: Maybe String -> TableInfo -> [(String, Table)]
-visibleTables current info
-    | Just db <- current =
-        [bare named | unqualify (Just db) (tiTable info) /= tiTable info]
-    | otherwise = [bare info]
-  where
-    named = info{tiTable = unqualify current (tiTable info)}
-    -- \| 组装成不带行的表
-    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,128 +0,0 @@
-module ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage)) where
-
-import ChuSQL.Core.Engine.Storage
-import ChuSQL.Core.Model
-import Data.HashSet qualified as HS
-import Data.Word (Word64)
-
--- 内存实现：Database 上的状态，错误通道是 Either String。
-
-newtype MemoryStorage a = MemoryStorage {runMemoryStorage :: Database -> Either String (a, Database)}
-
-instance Functor MemoryStorage where
-    fmap f (MemoryStorage m) = MemoryStorage $ \db -> do
-        (a, db') <- m db
-        Right (f a, db')
-
-instance Applicative MemoryStorage where
-    pure x = MemoryStorage $ \db -> Right (x, db)
-    MemoryStorage mf <*> MemoryStorage ma = MemoryStorage $ \db -> do
-        (f, db1) <- mf db
-        (a, db2) <- ma db1
-        Right (f a, db2)
-
-instance Monad MemoryStorage where
-    MemoryStorage m >>= k = MemoryStorage $ \db -> do
-        (a, db') <- m db
-        runMemoryStorage (k a) db'
-
-instance MonadStorage MemoryStorage where
-    -- \| 纯状态视图在求值期间不受外部修改
-    withSchemaGuard _ action = action
-
-    -- | 纯状态写入不受外部结构变更影响
-    withWriteSchemaGuard _ action = action
-
-    -- \| 全表扫描
-    scan t = MemoryStorage $ \db -> do
-        tbl <- lookupTable db t
-        Right (Right (tableRows tbl), db)
-
-    -- \| 追加一行
-    insert t r = MemoryStorage $ \db -> do
-        tbl <- lookupTable db t
-        Right (Right (), replaceTable t tbl{tableRows = tableRows tbl ++ [r]} db)
-
-    -- \| 整表替换
-    replaceAll t rows = MemoryStorage $ \db -> do
-        tbl <- lookupTable db t
-        Right (Right (), replaceTable t tbl{tableRows = rows} db)
-
-    -- \| 建空表；已存在报错
-    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 Nothing (Just 1))])
-
-    -- \| 删表；不存在报错
-    dropTable name = MemoryStorage $ \db ->
-        if any ((== name) . fst) db
-            then Right (Right (), filter ((/= name) . fst) db)
-            else Right (Left ("unknown table: " ++ name), db)
-
-    -- \| 删一列：表定义里去掉这一列，每一行里的那一格也一起去掉
-    dropColumn name col = MemoryStorage $ \db ->
-        case lookup name db of
-            Nothing -> Right (Left ("unknown table: " ++ name), db)
-            Just tbl ->
-                if col `notElem` map fst (tableCols tbl)
-                    then Right (Left ("unknown column: " ++ col), db)
-                    else do
-                        version <- nextSchemaVersion tbl
-                        Right
-                            ( Right ()
-                            , replaceTable
-                                name
-                                tbl
-                                    { tableCols = filter ((/= col) . fst) (tableCols tbl)
-                                    , tableRows = map (filter ((/= col) . fst)) (tableRows tbl)
-                                    , tableSchemaVersion = Just version
-                                    }
-                                db
-                            )
-
-    -- \| 原样返回当前库
-    snapshot = MemoryStorage $ \db -> Right (Right db, db)
-
-    -- \| 返回实时行数与去重统计的无数据结构
-    schema = MemoryStorage $ \db -> Right (Right (map describe db), db)
-      where
-        -- \| 将存储数据汇总为结构统计
-        describe (name, table) =
-            (name, table{tableRows = [], tableMeta = Just metadata})
-          where
-            metadata = TableMeta (length (tableRows table)) distinct [] []
-            distinct = [columnStatistics column (tableRows table) | (column, _) <- tableCols table]
-
-    -- \| 改表结构：列定义与行一起换
-    replaceSchema name cols rows = MemoryStorage $ \db -> case lookup name db of
-        Nothing -> Right (Left ("unknown table: " ++ name), 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
-            [] -> (column, HS.size values, False)
-            row : rest -> go rest (maybe values (\v -> HS.insert (canonicalValue v) values) (lookup column row))
-
--- | 用给定表替换同名表
-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,236 +0,0 @@
-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
-        -- | 输出名称与投影表达式，普通列用 Col
-        { selectItems :: [(String, Expr)]
-        , selectFrom :: FromClause
-        , selectWhere :: Maybe Expr
-        , selectGroupBy :: [String]
-        , 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)
-    | CreateTable String [(String, Column)]
-    | CreateDomain String ColumnType
-    | DropDomain String
-    | ShowDomains
-    | DropTable String
-    | CreateIndex String String
-    | DropIndex String String
-    | DropColumn String String
-    | AddColumn String (String, Column)
-    | RenameColumn String String String
-    | AlterColumnType String String ColumnType
-    | AlterColumnDefault String String (Maybe Value)
-    | AlterColumnNull String String Bool
-    | CreateUser String String
-    | AlterUser String String
-    | AlterIdentity String [(String, Bool)]
-    | ShowGrants
-    | ShowRoles
-    | DropUser String
-    -- | 新角色：权限的载体，用户靠成员资格继承它的权限
-    | CreateRole String
-    -- | 删角色：连同它的授权与成员一起删
-    | DropRole String
-    -- | GRANT 权限 ON 表 TO 角色，末位表示带 WITH GRANT OPTION
-    | GrantPrivileges [String] String String Bool
-    -- | REVOKE 权限 ON 表 FROM 角色
-    | RevokePrivileges [String] String String
-    | RevokeGrantOption [String] String String
-    -- | GRANT 角色 TO 用户：给用户加角色
-    | GrantRole String [String]
-    -- | REVOKE <角色> FROM <用户>[, ...]
-    | RevokeRole String [String]
-    | CreateDatabase String
-    | DropDatabase String
-    | UseDatabase String
-    | ShowDatabases
-    -- | 开事务：BEGIN / START TRANSACTION
-    | BeginTransaction
-    -- | 提交事务
-    | CommitTransaction
-    -- | 回滚事务
-    | RollbackTransaction
-    -- | 建保存点：SAVEPOINT 名字
-    | Savepoint String
-    -- | 回滚到保存点：ROLLBACK TO [SAVEPOINT] 名字
-    | RollbackToSavepoint String
-    -- | 释放保存点：RELEASE [SAVEPOINT] 名字
-    | ReleaseSavepoint String
-    deriving (Show, Eq)
-
--- | 连接类型：内连接与左外连接
-data JoinKind
-    = InnerJoin
-    | LeftJoin
-    deriving (Show, Eq)
-
--- | 数据来源：单表、派生表（子查询，输出列已改成裸列名）、带连接的来源，或空
-data FromClause
-    = FromTable (Maybe String) String
-    | FromSubquery (Maybe String) Statement
-    | FromJoin JoinKind FromClause FromClause Expr
-    | FromUnit
-    deriving (Show, Eq)
-
--- | 子查询：语句，加上它对外层列的引用（自由变量，语义检查时填）
-data Subquery = Subquery
-    { subqueryStatement :: Statement
-    , subqueryRefs :: [String]
-    }
-    | BoundSubquery
-    { subqueryStatement :: Statement
-    , subqueryRefs :: [String]
-    , subquerySlots :: [(String, Expr)]
-    }
-    deriving (Show, Eq)
-
--- | 量词：ANY 至少一行成立，ALL 每一行都成立
-data Quantifier
-    = AnyQ
-    | AllQ
-    deriving (Show, Eq)
-
--- | 量词比较里的比较运算符
-data CompareOp
-    = CmpEq
-    | CmpNe
-    | CmpGt
-    | CmpGtE
-    | CmpLt
-    | CmpLtE
-    deriving (Show, Eq)
-
--- | 条件表达式：列、字面量、算术、比较、逻辑、聚合与子查询
-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
-    | LitStr String
-    | LitBool Bool
-    | LitDate String
-    | LitTimestamp String
-    | LitBlob String
-    | Add Expr Expr
-    | Sub Expr Expr
-    | Mul Expr Expr
-    | Div Expr Expr
-    | Neg Expr
-    | Gt Expr Expr
-    | Lt Expr Expr
-    | Eq Expr Expr
-    | GtE Expr Expr
-    | LtE Expr Expr
-    | NotEq Expr Expr
-    | And Expr Expr
-    | Or Expr Expr
-    | IsNull Expr
-    | IsNotNull Expr
-    | CountAll
-    | CountOf Expr
-    | SumOf Expr
-    | AvgOf Expr
-    | MinOf Expr
-    | MaxOf Expr
-    | ScalarSub Subquery
-    | InSub Expr Subquery Bool
-    | InList Expr [Expr] Bool
-    | ExistsSub Subquery Bool
-    | QuantCmp CompareOp Expr Subquery Quantifier
-    deriving (Show, Eq)
-
--- | 排序方向：升序或降序
-data SortDir
-    = Asc
-    | 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
-        { 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,949 +0,0 @@
-{-# 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)
-import Data.List (intercalate, isInfixOf)
-import Data.Maybe (fromMaybe)
-import Data.Void (Void)
-import Text.Megaparsec
-import Text.Megaparsec.Char
-import Text.Megaparsec.Char.Lexer qualified as Lxr
-
--- SQL 解析：词法 + 语法，把文本变成语句树。
-
-type Parser = Parsec Void String
-
--- | 跳过空白
-sc :: Parser ()
-sc = Lxr.space space1 (Lxr.skipLineComment "--") (Lxr.skipBlockComment "/*" "*/")
-
--- | 词后面吃掉空白
-lexeme :: Parser a -> Parser a
-lexeme = Lxr.lexeme sc
-
--- | 读一个符号
-symbol :: String -> Parser String
-symbol = Lxr.symbol sc
-
--- | 读关键字（不分大小写）
-keyword :: String -> Parser ()
-keyword k = lexeme $ try $ do
-    _ <- string' k
-    notFollowedBy (satisfy isIdentChar)
-
--- | 读一个名字
-identifier :: Parser String
-identifier = lexeme $ do
-    first <- satisfy (\ch -> isAlpha ch || ch == '_')
-    rest <- many (satisfy isIdentChar)
-    return (first : rest)
-
--- | 账号名：裸名字或单引号字符串
-userName :: Parser String
-userName = identifier <|> stringLit
-
--- | 名字里允许的字符
-isIdentChar :: Char -> Bool
-isIdentChar ch = isAlphaNum ch || ch == '_'
-
--- | 读一个整数
-integer :: Parser Int
-integer = lexeme Lxr.decimal
-
--- | 读一个浮点数（必须有小数点或指数）
-floatLit :: Parser Double
-floatLit = lexeme Lxr.float
-
--- | 读一个字符串字面量
-stringLit :: Parser String
-stringLit = lexeme $ do
-    _ <- char '\''
-    s <- many stringChar
-    _ <- char '\''
-    return s
-
--- | 字符串里的一个字符
-stringChar :: Parser Char
-stringChar =
-    choice
-        [ '\'' <$ try (string "''")
-        , satisfy (/= '\'')
-        ]
-
--- | X'ABCD' 形式的二进制字面量，统一存成大写十六进制文本
-blobLit :: Parser String
-blobLit = lexeme $ do
-    _ <- char 'x' <|> char 'X'
-    _ <- char '\''
-    s <- many (satisfy isHexDigit)
-    _ <- char '\''
-    return (map toUpper s)
-
--- | 升序或降序
-sortDir :: Parser SortDir
-sortDir = (Desc <$ keyword "desc") <|> (Asc <$ keyword "asc") <|> pure Asc
-
--- | LIMIT 后面的整数
-limitClause :: Parser Int
-limitClause = do
-    keyword "limit"
-    integer
-
--- | 能带表名的列名
-qualifiedName :: Parser String
-qualifiedName = do
-    first <- identifier
-    rest <- many (symbol "." *> identifier)
-    return (intercalate "." (first : rest))
-
--- | 读一个表达式
-expr :: Parser Expr
-expr = makeExprParser atom operatorTable
-
--- | 运算符优先级（从紧到松）
-operatorTable :: [[Operator Parser Expr]]
-operatorTable =
-    [ [Prefix (Neg <$ symbol "-")]
-    , [InfixL (Mul <$ symbol "*"), InfixL (Div <$ symbol "/")]
-    , [InfixL (Add <$ symbol "+"), InfixL (Sub <$ symbol "-")]
-    , [ InfixN comparisonOp ]
-    , [ Postfix inPredicate
-        , Postfix (try quantifiedCmp)
-        , Postfix (IsNotNull <$ try (keyword "is" *> keyword "not" *> keyword "null"))
-        , Postfix (IsNull <$ (keyword "is" *> keyword "null"))
-        ]
-    , [InfixL (And <$ keyword "AND")]
-    , [InfixL (Or <$ keyword "OR")]
-    ]
-
--- | 普通比较：读最长的运算符，后面不能是 ANY / ALL
-comparisonOp :: Parser (Expr -> Expr -> Expr)
-comparisonOp = try $ do
-    op <- cmpOp
-    notFollowedBy quantifierKeyword
-    return (compareNode op)
-
--- | 量词：ANY 或 ALL
-quantifierKeyword :: Parser Quantifier
-quantifierKeyword = (AnyQ <$ keyword "any") <|> (AllQ <$ keyword "all")
-
--- | 比较运算符符号
-cmpOp :: Parser CompareOp
-cmpOp =
-    choice
-        [ CmpNe <$ try (symbol "<>" <|> symbol "!=")
-        , CmpGtE <$ try (symbol ">=")
-        , CmpLtE <$ try (symbol "<=")
-        , CmpGt <$ symbol ">"
-        , CmpLt <$ symbol "<"
-        , CmpEq <$ symbol "="
-        ]
-
--- | 量词比较 ANY / ALL
-quantifiedCmp :: Parser (Expr -> Expr)
-quantifiedCmp = do
-    op <- cmpOp
-    q <- quantifierKeyword
-    sq <- between (symbol "(") (symbol ")") subquerySelect
-    return (\e -> QuantCmp op e sq q)
-
--- | 最小的表达式单位
-atom :: Parser Expr
-atom =
-    choice
-        [ LitNull <$ keyword "null"
-        , LitBool True <$ keyword "TRUE"
-        , LitBool False <$ keyword "FALSE"
-        , try (LitDate <$> (keyword "date" *> stringLit))
-        , try (LitTimestamp <$> (keyword "timestamp" *> stringLit))
-        , try (LitBlob <$> blobLit)
-        , LitFloat <$> try floatLit
-        , LitInt <$> integer
-        , LitStr <$> stringLit
-        , try aggregateCall
-        , try constructorCall
-        , try scalarFunctionCall
-        , try existsPredicate
-        , Col <$> qualifiedName
-        , try scalarSubquery
-        , between (symbol "(") (symbol ")") expr
-        ]
-
--- | [NOT] EXISTS (SELECT ...)
-existsPredicate :: Parser Expr
-existsPredicate = do
-    negated <- (True <$ try (keyword "not" *> keyword "exists")) <|> (False <$ keyword "exists")
-    sq <- between (symbol "(") (symbol ")") subquerySelect
-    return (ExistsSub sq negated)
-
--- | 标量子查询：(SELECT ...)
-scalarSubquery :: Parser Expr
-scalarSubquery = ScalarSub <$> between (symbol "(") (symbol ")") subquerySelect
-
--- | 读 [NOT] IN：子查询或值清单
-inPredicate :: Parser (Expr -> Expr)
-inPredicate = do
-    negated <- (True <$ try (keyword "not" *> keyword "in")) <|> (False <$ keyword "in")
-    body <-
-        between (symbol "(") (symbol ")") $
-            choice
-                [ Left <$> try subquerySelect
-                , Right <$> sepBy1 expr (symbol ",")
-                ]
-    return $ \e -> case body of
-        Left sq -> InSub e sq negated
-        Right es -> InList e es negated
-
--- | 括号里的子查询；对外层列的引用留给语义检查填
-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)
-  where
-    -- | COUNT(*)，没有参数
-    countAll = CountAll <$ try (keyword (builtinName BCountAll) *> between (symbol "(") (symbol ")") (symbol "*"))
-    -- | 表里每一个带参数的内置函数
-    named (name, builtin) = builtinNode builtin <$> aggArg name
-    -- | 读聚合函数的参数
-    aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr)
-
--- | 只认字面量，给 DEFAULT 用
-literalValue :: Parser Value
-literalValue =
-    choice
-        [ VNull <$ keyword "null"
-        , VBool True <$ keyword "TRUE"
-        , VBool False <$ keyword "FALSE"
-        , try (negateLit <$> floatLit)
-        , VInt <$> integer
-        , VFloat <$> try floatLit
-        , VStr <$> stringLit
-        ]
-  where
-    -- | 负浮点字面量
-    negateLit d = VFloat (negate d)
-
--- | 一个排序键：输出序号、列名或表达式
-orderItem :: Parser (OrderKey, SortDir)
-orderItem = do
-    expression <- expr
-    dir <- sortDir
-    let key = case expression of
-            LitInt position -> OrderPosition position
-            Col column -> OrderColumn column
-            _ -> OrderExpression expression
-    return (key, dir)
-
--- | ORDER BY 的列表
-orderByClause :: Parser [(OrderKey, SortDir)]
-orderByClause = do
-    keyword "order"
-    keyword "by"
-    sepBy1 orderItem (symbol ",")
-
--- | GROUP BY 的列表
-groupByClause :: Parser [String]
-groupByClause = do
-    keyword "group"
-    keyword "by"
-    sepBy1 qualifiedName (symbol ",")
-
--- | SET 里的一条赋值
-assignment :: Parser (String, Expr)
-assignment = do
-    col <- identifier
-    _ <- symbol "="
-    e <- expr
-    return (col, e)
-
--- | 保留字清单，别名不许用
-reservedWords :: [String]
-reservedWords =
-    [ "select"
-    , "as"
-    , "from"
-    , "where"
-    , "order"
-    , "by"
-    , "limit"
-    , "join"
-    , "left"
-    , "outer"
-    , "inner"
-    , "exists"
-    , "in"
-    , "on"
-    , "and"
-    , "or"
-    , "asc"
-    , "desc"
-    , "insert"
-    , "into"
-    , "values"
-    , "delete"
-    , "update"
-    , "set"
-    , "create"
-    , "table"
-    , "index"
-    , "drop"
-    , "alter"
-    , "add"
-    , "rename"
-    , "to"
-    , "column"
-    , "user"
-    , "identified"
-    , "null"
-    , "is"
-    , "not"
-    , "default"
-    , "check"
-    , "unique"
-    , "primary"
-    , "key"
-    , "auto_increment"
-    , "type"
-    , "group"
-    , "having"
-    , "with"
-    , "any"
-    , "all"
-    ]
-
--- | 别名（不许用保留字）
-aliasName :: Parser String
-aliasName = try $ do
-    name <- identifier
-    if map toLower name `elem` reservedWords then empty else return name
-
--- | 表名 + 可选别名
-tableRef :: Parser (Maybe String, String)
-tableRef = do
-    tbl <- tableName
-    mAlias <- optional ((keyword "as" *> aliasName) <|> aliasName)
-    return (mAlias, tbl)
-
--- | 连接类型：内连接 / 左外连接
-joinKind :: Parser JoinKind
-joinKind =
-    try ((keyword "left" *> optional (keyword "outer") *> keyword "join")
-           $> LeftJoin)
-        <|> try ((keyword "inner" *> keyword "join") $> InnerJoin)
-        <|> (keyword "join" $> InnerJoin)
-
--- | FROM 里的一个来源：表或派生表
-fromSource :: Parser FromClause
-fromSource = fromSubquerySource <|> (uncurry FromTable <$> tableRef)
-
--- | 派生表：括号里的一条 SELECT，必须有别名
-fromSubquerySource :: Parser FromClause
-fromSubquerySource = do
-    stmt <- between (symbol "(") (symbol ")") queryStatement
-    mAlias <- optional ((keyword "as" *> aliasName) <|> aliasName)
-    case mAlias of
-        Nothing -> fail "FROM subquery needs an alias"
-        Just name -> return (FromSubquery (Just name) stmt)
-
--- | 一个 JOIN ... ON
-joinClause :: Parser (JoinKind, FromClause, Expr)
-joinClause = do
-    kind <- joinKind
-    src <- fromSource
-    keyword "on"
-    cond <- expr
-    return (kind, src, cond)
-
--- | FROM 子句（可含多个 JOIN）
-fromClause :: Parser FromClause
-fromClause = do
-    src <- fromSource
-    joins <- many joinClause
-    return (foldl (\acc (k, s, c) -> FromJoin k acc s c) src joins)
-
--- | SELECT 的列清单
-selectList :: Parser [(String, Expr)]
-selectList =
-    choice
-        [ [("*", Col "*")] <$ symbol "*"
-        , sepBy1 selectItem (symbol ",")
-        ]
-
--- | 投影项：列名或表达式，可带 AS 别名
-selectItem :: Parser (String, Expr)
-selectItem = do
-    (source, e) <- match expr
-    mAlias <- optional (try (keyword "as" *> aliasName))
-    pure (fromMaybe (selectItemLabel source e) mAlias, e)
-
--- | 投影项的默认标签：列用列名，表达式用原文
-selectItemLabel :: String -> Expr -> String
-selectItemLabel _ (Col c) = c
-selectItemLabel source _ = reverse (dropWhile isSpace (reverse source))
-
--- | 读 CREATE TABLE
-createTableStatement :: Parser Statement
-createTableStatement = do
-    keyword "create"
-    keyword "table"
-    name <- tableName
-    cols <- between (symbol "(") (symbol ")") (sepBy1 columnDef (symbol ","))
-    return (CreateTable name cols)
-
--- | 读 DROP TABLE
-dropTableStatement :: Parser Statement
-dropTableStatement = do keyword "drop"
-                        keyword "table"
-                        DropTable <$> tableName
-
--- | 读 CREATE INDEX（列名即索引名）
-createIndexStatement :: Parser Statement
-createIndexStatement = do
-    keyword "create"
-    keyword "index"
-    keyword "on"
-    tbl <- tableName
-    col <- between (symbol "(") (symbol ")") identifier
-    return (CreateIndex tbl col)
-
--- | 读 DROP INDEX
-dropIndexStatement :: Parser Statement
-dropIndexStatement = do
-    keyword "drop"
-    keyword "index"
-    keyword "on"
-    tbl <- tableName
-    col <- between (symbol "(") (symbol ")") identifier
-    return (DropIndex tbl col)
-
--- | 读 ALTER TABLE 的加列、删列、改名与改属性
-alterTableStatement :: Parser Statement
-alterTableStatement = do
-    keyword "alter"
-    keyword "table"
-    tbl <- tableName
-    choice
-        [ do
-            keyword "add"
-            void (optional (keyword "column"))
-            (name, col) <- columnDef
-            pure (AddColumn tbl (name, col))
-        , do
-            keyword "drop"
-            void (optional (keyword "column"))
-            DropColumn tbl <$> identifier
-        , do
-            keyword "rename"
-            void (optional (keyword "column"))
-            old <- identifier
-            keyword "to"
-            RenameColumn tbl old <$> identifier
-        , do
-            keyword "alter"
-            void (optional (keyword "column"))
-            col <- identifier
-            choice
-                [ AlterColumnType tbl col <$> (keyword "type" *> columnTypeP)
-                , try (AlterColumnNull tbl col False <$ (keyword "set" *> keyword "not" *> keyword "null"))
-                , try (AlterColumnNull tbl col True <$ (keyword "drop" *> keyword "not" *> keyword "null"))
-                , try (AlterColumnDefault tbl col . Just <$> (keyword "set" *> keyword "default" *> literalValue))
-                , AlterColumnDefault tbl col Nothing <$ (keyword "drop" *> keyword "default")
-                ]
-        ]
-
--- | 读 CREATE USER，口令是明文
-createUserStatement :: Parser Statement
-createUserStatement = do keyword "create"
-                         keyword "user"
-                         name <- userName
-                         CreateUser name <$> identifiedBy
-
--- | 读 IDENTIFIED BY '口令'
-identifiedBy :: Parser String
-identifiedBy = do
-    keyword "identified"
-    keyword "by"
-    stringLit
-
--- | 读 ALTER USER 改口令
-alterUserStatement :: Parser Statement
-alterUserStatement = do
-    keyword "alter"
-    keyword "user"
-    name <- userName
-    (AlterUser name <$> identifiedBy) <|> (AlterIdentity name <$> some identityAttribute)
-
--- | 读身份属性开关
-identityAttribute :: Parser (String, Bool)
-identityAttribute = choice
-    [ ("allow_sudo_auth", True) <$ keyword "allow_sudo_auth"
-    , ("allow_sudo_auth", False) <$ keyword "noallow_sudo_auth"
-    , ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
-    , ("system_catalog_manager", False) <$ keyword "nosystem_catalog_manager"
-    , ("login", True) <$ keyword "login", ("login", False) <$ keyword "nologin"
-    , ("superuser", True) <$ keyword "superuser", ("superuser", False) <$ keyword "nosuperuser"
-    , ("enabled", True) <$ keyword "enabled", ("enabled", False) <$ keyword "disabled"
-    ]
-
--- | 读 ALTER ROLE 属性或口令
-alterRoleStatement :: Parser Statement
-alterRoleStatement = do
-    keyword "alter"
-    keyword "role"
-    name <- userName
-    (AlterUser name <$> identifiedBy) <|> (AlterIdentity name <$> some identityAttribute)
-
--- | 读 DROP USER
-dropUserStatement :: Parser Statement
-dropUserStatement = do keyword "drop"
-                       keyword "user"
-                       DropUser <$> userName
-
--- | 读 CREATE ROLE
-createRoleStatement :: Parser Statement
-createRoleStatement = do
-    keyword "create"
-    keyword "role"
-    CreateRole <$> userName
-
--- | 读 DROP ROLE
-dropRoleStatement :: Parser Statement
-dropRoleStatement = do
-    keyword "drop"
-    keyword "role"
-    DropRole <$> userName
-
--- | 权限名，统一收成大写
-privilegeName :: Parser String
-privilegeName =
-    choice
-        [ "SELECT" <$ keyword "select"
-        , "INSERT" <$ keyword "insert"
-        , "UPDATE" <$ keyword "update"
-        , "DELETE" <$ keyword "delete"
-        , "CONNECT" <$ keyword "connect"
-        , "CREATE" <$ keyword "create"
-        , "ALL" <$ keyword "all"
-        ]
-
--- | ON 后面的授权对象：* 或一张表
-grantObject :: Parser String
-grantObject = try (("database:" ++) <$> (keyword "database" *> identifier))
-    <|> try ((++ ".*") <$> (identifier <* symbol "." <* symbol "*"))
-    <|> ("*" <$ symbol "*") <|> (optional (keyword "table") *> tableName)
-
--- | 可选的 WITH GRANT OPTION
-grantOption :: Parser Bool
-grantOption = (True <$ try (keyword "with" *> keyword "grant" *> keyword "option")) <|> pure False
-
--- | 读 GRANT：带 ON 的授权限，不带的加角色
-grantStatement :: Parser Statement
-grantStatement = do
-    keyword "grant"
-    choice
-        [ try $ do
-            privs <- sepBy1 privilegeName (symbol ",")
-            keyword "on"
-            obj <- grantObject
-            keyword "to"
-            GrantPrivileges privs obj <$> userName <*> grantOption
-        , GrantRole <$> userName <*> (keyword "to" *> sepBy1 userName (symbol ","))
-        ]
-
--- | 读 REVOKE：与 GRANT 对称
-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"
-            (if optionOnly then RevokeGrantOption else RevokePrivileges) privs obj <$> userName
-        , if optionOnly then fail "GRANT OPTION FOR requires object privileges" else RevokeRole <$> userName <*> (keyword "from" *> sepBy1 userName (symbol ","))
-        ]
-
--- | 建表时的一列：类型后面跟若干约束
-columnDef :: Parser (String, Column)
-columnDef = do
-    name <- identifier
-    ty <- columnTypeP
-    mods <- many columnConstraint
-    return (name, foldl (\c f -> f c) (plainColumn ty) mods)
-
--- | 一条列约束
-columnConstraint :: Parser (Column -> Column)
-columnConstraint =
-    choice
-        [ try ((keyword "not" *> keyword "null")
-                 $> (\ c -> c {columnNullable = False}))
-        , keyword "null" $> (\ c -> c {columnNullable = True})
-        , keyword "auto_increment"
-            $>
-              (\ c -> c {columnAutoIncrement = True, columnNullable = False})
-        , try ((keyword "primary" *> keyword "key")
-                 $>
-                   (\ c
-                      -> c {columnPrimaryKey = True, columnUnique = True,
-                            columnNullable = False}))
-        , keyword "unique" $> (\ c -> c {columnUnique = True})
-        , keyword "default" *> ((\v c -> c{columnDefault = Just v}) <$> literalValue)
-        , keyword "check" *> ((\s c -> c{columnCheck = Just s}) <$> checkText)
-        ]
-
--- | CHECK 后面括号里的表达式原文，交给执行期再解析
-checkText :: Parser String
-checkText = between (symbol "(") (symbol ")") (match expr) >>= \(source, _) -> pure source
-
--- | 括号里的长度参数
-sizeParen :: Parser Int
-sizeParen = try (between (symbol "(") (symbol ")") integer)
-
--- | 列类型关键字
-columnTypeP :: Parser ColumnType
-columnTypeP =
-    choice
-        [ 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 "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") $> CDouble)
-        , keyword "double" >> pure CDouble
-        , keyword "decimal" >> 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
-    args <- optional (try (between (symbol "(") (symbol ")") decimalArgs))
-    pure $ case args of
-        Nothing -> CDecimal 10 0
-        Just (p, s) -> CDecimal p s
-
--- | DECIMAL 的精度与小数位参数
-decimalArgs :: Parser (Int, Int)
-decimalArgs = do
-    p <- integer
-    s <- fromMaybe 0 <$> optional (symbol "," *> integer)
-    pure (p, s)
-
--- | 读 SELECT
-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 distinct then SelectDistinct else id) (Select cols fromC mWhere groupBy having orderBy mLimit)
-
--- | 读 WITH：展开每个 CTE 再读主查询
-withStatement :: Parser Statement
-withStatement = do
-    keyword "with"
-    defs <- sepBy1 cteDef (symbol ",")
-    main <- selectStatement
-    either fail return (expandWith defs main)
-
--- | 一个 CTE：名字、可选列清单与查询
-cteDef :: Parser (String, [String], Statement)
-cteDef = do
-    name <- identifier
-    cols <- fromMaybe [] <$> optional (between (symbol "(") (symbol ")") (sepBy1 identifier (symbol ",")))
-    keyword "as"
-    body <- between (symbol "(") (symbol ")") queryStatement
-    return (name, cols, body)
-
--- | 查询：允许 WITH 开头
-queryStatement :: Parser Statement
-queryStatement = withStatement <|> selectStatement
-
--- | 按顺序把每个 CTE 展开成派生表
-expandWith :: [(String, [String], Statement)] -> Statement -> Either String Statement
-expandWith defs main = go [] defs
-  where
-    -- | 前面的 CTE 已进环境，接着展开本体
-    go env [] = expandStatement env main
-    go env ((name, cols, body) : rest) = do
-        body' <- expandStatement env body
-        named <- renameColumns name cols body'
-        go (env ++ [(cteKey name, named)]) rest
-
--- | CTE 名不分大小写
-cteKey :: String -> String
-cteKey = map toLower
-
--- | CTE 带列清单时改本体的输出名
-renameColumns :: String -> [String] -> Statement -> Either String Statement
-renameColumns _ [] q = Right q
-renameColumns name cols (SelectDistinct q) = SelectDistinct <$> renameColumns name cols q
-renameColumns name cols q@Select { selectItems = items } = do
-    checkCteArity name cols (map snd items)
-    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 (OrderColumn column, direction) = case [new | ((old, _), new) <- zip items cols, old == column] of
-        [] -> Right (OrderColumn column, 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"
-
--- | 列清单个数必须和本体输出一致
-checkCteArity :: String -> [String] -> [a] -> Either String ()
-checkCteArity name cols out
-    | length cols == length out = Right ()
-    | otherwise = Left ("WITH: column list of " ++ name ++ " does not match its query")
-
--- | 把语句里对 CTE 的引用换成派生表
-expandStatement :: [(String, Statement)] -> Statement -> Either String Statement
-expandStatement env stmt = case stmt of
-    SelectDistinct q -> SelectDistinct <$> expandStatement env q
-    q@Select { selectFrom = fromC, selectItems = items, selectWhere = mWhere } -> do
-        fromC' <- expandClause env fromC
-        items' <- traverse (\(name, e) -> fmap (name,) (expandExpr env e)) items
-        w <- traverse (expandExpr env) mWhere
-        having <- traverse (expandExpr env) (selectHaving q)
-        ordering <- mapM expandOrder (selectOrderBy q)
-        Right q { selectFrom = fromC', selectItems = items', selectWhere = w, selectHaving = having, selectOrderBy = ordering }
-    _ -> Right 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
-expandClause env fromC = case fromC of
-    FromTable mAlias tbl
-        | Just body <- lookup (cteKey tbl) env -> Right (FromSubquery (Just (fromMaybe tbl mAlias)) body)
-        | otherwise -> Right fromC
-    FromSubquery mAlias stmt -> FromSubquery mAlias <$> expandStatement env stmt
-    FromJoin kind left right cond ->
-        FromJoin kind <$> expandClause env left <*> expandClause env right <*> expandExpr env cond
-    FromUnit -> Right FromUnit
-
--- | 表达式里的子查询也要展开
-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
-    Div a b -> Div <$> go a <*> go b
-    Gt a b -> Gt <$> go a <*> go b
-    Lt a b -> Lt <$> go a <*> go b
-    Eq a b -> Eq <$> go a <*> go b
-    GtE a b -> GtE <$> go a <*> go b
-    LtE a b -> LtE <$> go a <*> go b
-    NotEq a b -> NotEq <$> go a <*> go b
-    And a b -> And <$> go a <*> go b
-    Or a b -> Or <$> go a <*> go b
-    Neg a -> Neg <$> go a
-    IsNull a -> IsNull <$> go a
-    IsNotNull a -> IsNotNull <$> go a
-    CountOf a -> CountOf <$> go a
-    SumOf a -> SumOf <$> go a
-    AvgOf a -> AvgOf <$> go a
-    MinOf a -> MinOf <$> go a
-    MaxOf a -> MaxOf <$> go a
-    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 -> (`ExistsSub` neg) <$> goSub sq
-    QuantCmp op x sq q -> (\x' sq' -> QuantCmp op x' sq' q) <$> go x <*> goSub sq
-    _ -> Right e
-  where
-    -- | 继续看子表达式
-    go = expandExpr env
-    -- | 继续看子查询里的语句
-    goSub sq = (\stmt -> sq { subqueryStatement = stmt }) <$> expandStatement env (subqueryStatement sq)
-
--- | 读 INSERT，可一次插多行
-insertStatement :: Parser Statement
-insertStatement = do
-    keyword "INSERT"
-    keyword "INTO"
-    tbl <- tableName
-    cols <-
-        between
-            (symbol "(")
-            (symbol ")")
-            (sepBy1 identifier (symbol ","))
-    keyword "VALUES"
-    rows <- sepBy1 valueRow (symbol ",")
-    return (Insert tbl cols rows)
-
--- | 一行值：一对括号里的若干字面量
-valueRow :: Parser [Expr]
-valueRow = between (symbol "(") (symbol ")") (sepBy1 expr (symbol ","))
-
--- | 读 DELETE
-deleteStatement :: Parser Statement
-deleteStatement = do
-    keyword "DELETE"
-    keyword "FROM"
-    tbl <- tableName
-    mWhere <- optional (keyword "WHERE" *> expr)
-    return (Delete tbl mWhere)
-
--- | 读 UPDATE
-updateStatement :: Parser Statement
-updateStatement = do
-    keyword "update"
-    tbl <- tableName
-    keyword "set"
-    assigns <- sepBy1 assignment (symbol ",")
-    mWhere <- optional (keyword "where" *> expr)
-    return (Update tbl assigns mWhere)
-
--- | 事务控制语句
-transactionStatement :: Parser Statement
-transactionStatement =
-    try (BeginTransaction <$ (keyword "start" *> keyword "transaction"))
-        <|> (BeginTransaction <$ (keyword "begin" *> optional (keyword "transaction")))
-        <|> (CommitTransaction <$ (keyword "commit" *> optional (keyword "transaction")))
-        <|> try (RollbackToSavepoint <$> rollbackToName)
-        <|> (RollbackTransaction <$ (keyword "rollback" *> optional (keyword "transaction")))
-        <|> (Savepoint <$> (keyword "savepoint" *> identifier))
-        <|> (ReleaseSavepoint <$> (keyword "release" *> optional (keyword "savepoint") *> identifier))
-  where
-    -- | ROLLBACK TO [SAVEPOINT] 名字
-    rollbackToName =
-        keyword "rollback" *> keyword "to" *> optional (keyword "savepoint") *> identifier
-
--- | 解析总入口
-parseStatement :: String -> Either String Statement
-parseStatement input =
-    case runParser (sc *> statementP <* sc <* eof) "<query>" input of
-        Left err -> Left (safeParseError input err)
-        Right q -> Right q
-  where
-    -- | 按关键字分派到各语句解析器
-    statementP =
-        withStatement
-            <|> transactionStatement
-            <|> selectStatement
-            <|> try (CreateDatabase <$> (keyword "create" *> keyword "database" *> identifier))
-            <|> try (DropDatabase <$> (keyword "drop" *> keyword "database" *> identifier))
-            <|> (UseDatabase <$> (keyword "use" *> identifier))
-            <|> try (ShowDatabases <$ (keyword "show" *> keyword "databases"))
-            <|> try (ShowDomains <$ (keyword "show" *> keyword "domains"))
-            <|> try (CreateDomain <$> (keyword "create" *> keyword "domain" *> identifier) <*> (keyword "as" *> columnTypeP))
-            <|> try (DropDomain <$> (keyword "drop" *> keyword "domain" *> identifier))
-            <|> insertStatement
-            <|> deleteStatement
-            <|> updateStatement
-            <|> try createUserStatement
-            <|> try alterUserStatement
-            <|> try alterRoleStatement
-            <|> try (ShowGrants <$ (keyword "show" *> keyword "grants"))
-            <|> try (ShowRoles <$ (keyword "show" *> keyword "roles"))
-            <|> try dropUserStatement
-            <|> try createRoleStatement
-            <|> try dropRoleStatement
-            <|> try grantStatement
-            <|> try revokeStatement
-            <|> try createIndexStatement
-            <|> try createTableStatement
-            <|> try dropIndexStatement
-            <|> try alterTableStatement
-            <|> dropTableStatement
-
--- | 解析一个裸表达式（CHECK 约束原文用）
-parseExpression :: String -> Either String Expr
-parseExpression input =
-    case runParser (sc *> expr <* sc <* eof) "<expr>" input of
-        Left err -> Left (safeParseError input err)
-        Right e -> Right e
-
--- | 隐去含口令输入的解析诊断
-safeParseError :: String -> ParseErrorBundle String Void -> String
-safeParseError input errors
-    | any (`isInfixOf` map toLower input) ["password", "identified"] = "syntax error in credential statement (input redacted)"
-    | otherwise = errorBundlePretty errors
-
--- | 表名至多有一个库前缀。
-tableName :: Parser String
-tableName = do
-    first <- identifier
-    databaseTable <- optional (symbol "." *> identifier)
-    pure (maybe first (\t -> map toLower first ++ "." ++ t) databaseTable)

chusql-core/engine/stack.yaml

@@ -1,8 +0,0 @@
-resolver: lts-24.59
-
-extra-lib-dirs:
-    - ../storage/target/release
-
-packages:
-    - .
-    - ../model

chusql-core/engine/stack.yaml.lock

@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/topics/lock_files
-
-packages: []
-snapshots:
-- completed:
-    sha256: 0f728e30e843d7f00460ad56858b995a3b227fca683659c7df9f2fc3988a3ce1
-    size: 732465
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/59.yaml
-  original: lts-24.59

chusql-core/engine/test/NormalizationSpec.hs

@@ -1,68 +0,0 @@
-{-# 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

@@ -1,870 +0,0 @@
-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

@@ -1,25 +0,0 @@
-cabal-version: 2.4
-
-name:           chusql-core-model
-version:        1.0.0
-synopsis:       Shared ChuSQL data models and wire protocol types
-description:    Defines shared column and value models, storage protocol requests
-                and responses, table schemas, accounts, and query results.
-                Contains data types without execution logic, allowing clients to
-                use the models without linking the query engine.
-build-type:     Simple
-
-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

@@ -1,669 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-
-module ChuSQL.Core.Model
-    ( ColumnType (..)
-    , Column (..)
-    , pattern TInt
-    , pattern TStr
-    , pattern TBool
-    , TypeClass (..)
-    , Value (..)
-    , Row
-    , TableMeta (..)
-    , Histogram (..)
-    , Table (..)
-    , TableIdentity (..)
-    , Database
-    , histogramOf
-    , histogramFor
-    , colNames
-    , colType
-    , lookupTable
-    , resolveTable
-    , lastTablePart
-    , deriveQualifier
-    , allColumns
-    , qualify
-    , unqualify
-    , resolveColumn
-    , plainColumn
-    , typeLabel
-    , typeName
-    , parseColumnType
-    , domainTableName
-    , isDomainTable
-    , typeClassOf
-    , assignable
-    , comparableTypes
-    , integerType
-    , numericType
-    , valueFits
-    , coerceValue
-    , canonicalValue
-    , compareValue
-    , valuesEqual
-    , hashValue
-    ) where
-
-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
-
--- 数据模型：列类型、列约束、值、行、表、数据库，外加查表小工具。
-
--- | 列的基础类型
-data ColumnType
-    = CInt
-    | CBigInt
-    | CSmallInt
-    | CStr
-    | CVarchar Int
-    | CChar Int
-    | CBool
-    | CFloat
-    | CDouble
-    | CDecimal Int Int
-    | CDate
-    | CTimestamp
-    | CBlob
-    | CNull
-    | CDomain String ColumnType
-    | CRuntime TypeId
-    deriving (Show, Eq)
-
--- | 列定义：类型 + 约束；约束全部取默认值就是普通可空列。
-data Column = Column
-    { columnType :: ColumnType
-    , columnNullable :: Bool
-    , columnDefault :: Maybe Value
-    , columnAutoIncrement :: Bool
-    , columnUnique :: Bool
-    , columnPrimaryKey :: Bool
-    , columnCheck :: Maybe String
-    }
-    deriving (Eq)
-
--- | 普通可空列
-plainColumn :: ColumnType -> Column
-plainColumn t = Column t True Nothing False False False Nothing
-
--- | 普通整型列的匹配模式
-pattern TInt :: Column
-pattern TInt <- Column CInt _ _ _ _ _ _
-  where
-    TInt = plainColumn CInt
-
--- | 普通字符串列的匹配模式
-pattern TStr :: Column
-pattern TStr <- Column CStr _ _ _ _ _ _
-  where
-    TStr = plainColumn CStr
-
--- | 普通布尔列的匹配模式
-pattern TBool :: Column
-pattern TBool <- Column CBool _ _ _ _ _ _
-  where
-    TBool = plainColumn CBool
-
--- | 错误消息里用的类型名
-typeLabel :: ColumnType -> String
-typeLabel CInt = "TInt"
-typeLabel CBigInt = "TBigInt"
-typeLabel CSmallInt = "TSmallInt"
-typeLabel CStr = "TStr"
-typeLabel (CVarchar n) = "TVarchar " ++ show n
-typeLabel (CChar n) = "TChar " ++ show n
-typeLabel CBool = "TBool"
-typeLabel CFloat = "TFloat"
-typeLabel CDouble = "TDouble"
-typeLabel (CDecimal p s) = "TDecimal " ++ show p ++ " " ++ show s
-typeLabel CDate = "TDate"
-typeLabel CTimestamp = "TTimestamp"
-typeLabel CBlob = "TBlob"
-typeLabel CNull = "NULL"
-typeLabel (CDomain name _) = name
-typeLabel (CRuntime tid) = renderTypeExpr (typeExpression tid)
-
--- | 线上/磁盘上的类型名
-typeName :: ColumnType -> String
-typeName CInt = "int"
-typeName CBigInt = "bigint"
-typeName CSmallInt = "smallint"
-typeName CStr = "str"
-typeName (CVarchar n) = "varchar(" ++ show n ++ ")"
-typeName (CChar n) = "char(" ++ show n ++ ")"
-typeName CBool = "bool"
-typeName CFloat = "float"
-typeName CDouble = "double"
-typeName (CDecimal p s) = "decimal(" ++ show p ++ "," ++ show s ++ ")"
-typeName CDate = "date"
-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
-domainTableName name = "__system_domain_" ++ map toLower name
-
--- | 判断类型定义目录键
-isDomainTable :: String -> Bool
-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 =
-        CDomain name <$> parseColumnType definition
-    | otherwise = case (base, args) of
-        ("int", []) -> Just CInt
-        ("integer", []) -> Just CInt
-        ("bigint", []) -> Just CBigInt
-        ("smallint", []) -> Just CSmallInt
-        ("str", []) -> Just CStr
-        ("text", []) -> Just CStr
-        ("varchar", []) -> Just CStr
-        ("varchar", [n]) -> CVarchar <$> positive n
-        ("char", []) -> Just (CChar 1)
-        ("char", [n]) -> CChar <$> positive n
-        ("bool", []) -> Just CBool
-        ("boolean", []) -> Just CBool
-        ("float", []) -> Just CFloat
-        ("real", []) -> Just CFloat
-        ("double", []) -> Just CDouble
-        ("decimal", []) -> Just (CDecimal 10 0)
-        ("numeric", []) -> Just (CDecimal 10 0)
-        ("decimal", [p]) -> flip CDecimal 0 <$> positive p
-        ("numeric", [p]) -> flip CDecimal 0 <$> positive p
-        ("decimal", [p, s]) -> CDecimal <$> positive p <*> plain s
-        ("numeric", [p, s]) -> CDecimal <$> positive p <*> plain s
-        ("date", []) -> Just CDate
-        ("timestamp", []) -> Just CTimestamp
-        ("blob", []) -> Just CBlob
-        _ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
-  where
-    -- | 去掉空白的类型名
-    cleaned = map toLower (filter (not . isSpace) raw)
-    -- | 基础名与参数段
-    (base, rest) = span (/= '(') cleaned
-    -- | 括号里的参数表
-    args = case stripSuffixMaybe ")" (drop 1 rest) of
-        Nothing -> []
-        Just inner -> map (filter (not . isSpace)) (splitOn ',' inner)
-
--- | 去掉结尾
-stripSuffixMaybe :: String -> String -> Maybe String
-stripSuffixMaybe suffix s
-    | suffix `isSuffixOf` s = Just (take (length s - length suffix) s)
-    | otherwise = Nothing
-
--- | 按逗号切开
-splitOn :: Char -> String -> [String]
-splitOn sep s = case break (== sep) s of
-    (part, []) -> [part]
-    (part, _ : rest) -> part : splitOn sep rest
-
--- | 正数参数
-positive :: String -> Maybe Int
-positive s
-    | not (null s) && all isDigit s = Just (read s)
-    | otherwise = Nothing
-
--- | 非负整数参数
-plain :: String -> Maybe Int
-plain = positive
-
--- | 写出普通列就只说类型名，带约束才补在后面
-instance Show Column where
-    show c = typeLabel (columnType c) ++ notNull ++ def ++ auto ++ uni ++ key ++ check
-      where
-        notNull = if columnNullable c then "" else " NOT NULL"
-        def = maybe "" (\v -> " DEFAULT " ++ show v) (columnDefault c)
-        auto = if columnAutoIncrement c then " AUTO_INCREMENT" else ""
-        uni = if columnUnique c then " UNIQUE" else ""
-        key = if columnPrimaryKey c then " PRIMARY KEY" else ""
-        check = maybe "" (\s -> " CHECK (" ++ s ++ ")") (columnCheck c)
-
--- | 类型大类
-data TypeClass
-    = NumericClass
-    | TextClass
-    | TemporalClass
-    | BooleanClass
-    | NullClass
-    | RuntimeClass
-    deriving (Show, Eq)
-
--- | 整型大类判断
-typeClassOf :: ColumnType -> TypeClass
-typeClassOf CInt = NumericClass
-typeClassOf CBigInt = NumericClass
-typeClassOf CSmallInt = NumericClass
-typeClassOf CFloat = NumericClass
-typeClassOf CDouble = NumericClass
-typeClassOf CDecimal{} = NumericClass
-typeClassOf CStr = TextClass
-typeClassOf CVarchar{} = TextClass
-typeClassOf CChar{} = TextClass
-typeClassOf CBlob = TextClass
-typeClassOf CDate = TemporalClass
-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
-
--- | 是不是整数类型
-integerType :: ColumnType -> Bool
-integerType CInt = True
-integerType CBigInt = True
-integerType CSmallInt = True
-integerType (CDomain _ base) = integerType base
-integerType _ = False
-
--- | 比较用的类型族：同大类可比，日期时间与文本互比
-comparableTypes :: ColumnType -> ColumnType -> Bool
-comparableTypes a b
-    | typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = False
-    | otherwise = a == CNull || b == CNull || sameClass || crossTemporal
-  where
-    -- | 两个类型同属一个大类
-    sameClass = typeClassOf a == typeClassOf b
-    -- | 时间与文本放在一起比
-    crossTemporal = (temporal a && textual b) || (textual a && temporal b)
-    -- | 是不是时间类型
-    temporal t = typeClassOf t == TemporalClass
-    -- | 是不是文本类型
-    textual t = typeClassOf t == TextClass
-
--- | 是不是数值类型
-numericType :: ColumnType -> Bool
-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
-valueFits CSmallInt (VInt _) = True
-valueFits CFloat (VInt _) = True
-valueFits CFloat (VFloat _) = True
-valueFits CDouble (VInt _) = True
-valueFits CDouble (VFloat _) = True
-valueFits CDecimal{} (VInt _) = True
-valueFits CDecimal{} (VFloat _) = True
-valueFits CStr (VStr _) = True
-valueFits CVarchar{} (VStr _) = True
-valueFits CChar{} (VStr _) = True
-valueFits CBool (VBool _) = True
-valueFits CDate (VStr _) = True
-valueFits CTimestamp (VStr _) = True
-valueFits CBlob (VStr _) = True
-valueFits _ _ = False
-
--- | 把值收进列类型：NULL 原样通过，类型不符报错
-coerceValue :: ColumnType -> Value -> Either String Value
-coerceValue _ VNull = Right VNull
-coerceValue t v = case t of
-    CInt -> toInt t v
-    CBigInt -> toInt t v
-    CSmallInt -> toInt t v
-    CFloat -> toFloat t v
-    CDouble -> toFloat t v
-    CDecimal p s -> toDecimal p s v
-    CStr -> toText t v
-    CVarchar n -> toSized n v
-    CChar n -> toSized n v
-    CBool -> toBool t v
-    CDate -> toDate v
-    CTimestamp -> toTimestamp v
-    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
-toInt _ (VInt n) = Right (VInt n)
-toInt t (VFloat d) = case properFraction d :: (Int, Double) of
-    (n, frac)
-        | frac == 0 -> Right (VInt n)
-        | otherwise -> Left ("cannot put a fractional number into " ++ typeLabel t)
-toInt t _ = Left ("cannot put this value into " ++ typeLabel t)
-
--- | 数值收进浮点列
-toFloat :: ColumnType -> Value -> Either String Value
-toFloat _ (VInt n) = Right (VFloat (fromIntegral n))
-toFloat _ (VFloat d) = Right (VFloat d)
-toFloat t _ = Left ("cannot put this value into " ++ typeLabel t)
-
--- | DECIMAL 按小数位四舍五入
-toDecimal :: Int -> Int -> Value -> Either String Value
-toDecimal p s v
-    | p <= 0 || p > 308 || s < 0 || s > p = Left "invalid decimal precision or scale"
-    | otherwise = case v of
-        VInt n -> rounded (fromIntegral n)
-        VFloat d -> rounded d
-        _ -> Left ("cannot put this value into " ++ typeLabel (CDecimal p s))
-  where
-    -- | 缩放因子
-    scale = (10 :: Double) ^ s
-    -- | 按比例四舍五入
-    rounded d
-        | isNaN d || isInfinite d || isInfinite (d * scale) = Left "decimal value is not finite or exceeds precision"
-        | abs result >= (10 :: Double) ^ (p - s) = Left "decimal value exceeds precision"
-        | otherwise = Right (VFloat result)
-      where
-        result = fromIntegral (round (d * scale) :: Integer) / scale
-
--- | 字符串收进文本列
-toText :: ColumnType -> Value -> Either String Value
-toText _ (VStr s) = Right (VStr s)
-toText t _ = Left ("cannot put this value into " ++ typeLabel t)
-
--- | 按列长度限制收字符串
-toSized :: Int -> Value -> Either String Value
-toSized n (VStr s)
-    | length s <= n = Right (VStr s)
-    | otherwise = Left ("value is longer than " ++ show n ++ " characters")
-toSized _ _ = Left "cannot put this value into a character column"
-
--- | 布尔收进布尔列
-toBool :: ColumnType -> Value -> Either String Value
-toBool _ (VBool b) = Right (VBool b)
-toBool t _ = Left ("cannot put this value into " ++ typeLabel t)
-
--- | 字符串收进日期列
-toDate :: Value -> Either String Value
-toDate (VStr s)
-    | validDateText s = Right (VStr s)
-    | otherwise = Left "date must look like YYYY-MM-DD"
-toDate _ = Left "date must be a string"
-
--- | 字符串收进时间戳列
-toTimestamp :: Value -> Either String Value
-toTimestamp (VStr s)
-    | validTimestampText s = Right (VStr s)
-    | otherwise = Left "timestamp must look like YYYY-MM-DD HH:MM:SS"
-toTimestamp _ = Left "timestamp must be a string"
-
--- | YYYY-MM-DD
-validDateText :: String -> Bool
-validDateText s = case splitOn '-' s of
-    [y, m, d] -> allOf 4 y && allOf 2 m && allOf 2 d
-    _ -> False
-
--- | 日期时间格式；中间允许空格或 T
-validTimestampText :: String -> Bool
-validTimestampText s = case break (\c -> c == ' ' || c == 'T') s of
-    (d, _ : tm) -> validDateText d && validTimeText tm
-    _ -> False
-
--- | HH:MM:SS
-validTimeText :: String -> Bool
-validTimeText t = case splitOn ':' t of
-    [h, m, sec] -> allOf 2 h && allOf 2 m && allOf 2 sec
-    _ -> False
-
--- | 一段字符串是不是固定长度的数字
-allOf :: Int -> String -> Bool
-allOf n s = length s == n && all isDigit s
-
-
--- | 引擎里的一行值
-data Value
-    = VNull
-    | VInt Int
-    | VFloat Double
-    | VStr String
-    | VBool Bool
-    | VRuntime TypeId RuntimeValue
-    deriving (Show, Eq)
-
--- | 值的比较关键字：整值浮点折成整数
-canonicalValue :: Value -> Value
-canonicalValue (VFloat d)
-    | wholeDouble d = VInt (truncate d)
-canonicalValue v = v
-
--- | 浮点是不是能精确折成整数的整值
-wholeDouble :: Double -> Bool
-wholeDouble d =
-    not (isNaN d)
-        && not (isInfinite d)
-        && abs d <= 9007199254740992
-        && d == fromIntegral (truncate d :: Int)
-
--- | 值的全序：NULL 最小，数值跨类型比大小，异族按族的先后
-compareValue :: Value -> Value -> Ordering
-compareValue a b = case (canonicalValue a, canonicalValue b) of
-    (VNull, VNull) -> EQ
-    (VNull, _) -> LT
-    (_, VNull) -> GT
-    (VInt x, VInt y) -> compare x y
-    (VInt x, VFloat y) -> compare (fromIntegral x) y
-    (VFloat x, VInt y) -> compare x (fromIntegral y)
-    (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)
-
--- | 族的先后，只用来给异族值定序
-valueRank :: Value -> Int
-valueRank VNull = 0
-valueRank (VInt _) = 1
-valueRank (VFloat _) = 1
-valueRank (VStr _) = 2
-valueRank (VBool _) = 3
-valueRank VRuntime{} = 4
-
--- | 相等语义：比较关键字相同即相等，与 hashValue 配套
-valuesEqual :: Value -> Value -> Bool
-valuesEqual a b = canonicalValue a == canonicalValue b
-
--- | 值的关键字哈希，与 valuesEqual 用同一套关键字
-hashValue :: Value -> Int
-hashValue v = case canonicalValue v of
-    VNull -> hashWithSalt 0 (0 :: Int)
-    VInt n -> hashWithSalt 1 n
-    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
-    hashWithSalt s = hashWithSalt s . hashValue
-
--- | 一行数据
-type Row = [(String, Value)]
-
--- | 一列的等宽直方图：区间下界、上界与每桶计数
-data Histogram = Histogram
-    { histLow :: Double
-    , histHigh :: Double
-    , histBuckets :: [Int]
-    }
-    deriving (Show, Eq)
-
--- | 一张表的统计：行数、各列不同值数、列直方图与索引
-data TableMeta = TableMeta
-    { metaRowCount :: Int
-    , metaDistinct :: [(String, Int, Bool)]
-    , metaHistograms :: [(String, Histogram)]
-    , metaIndexes :: [String]
-    }
-    deriving (Show)
-
--- | 保存持久化数据库与表编号
-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)
-
--- | 库：库名到表的映射
-type Database = [(String, Table)]
-
--- | 这一列的直方图
-histogramFor :: TableMeta -> String -> Maybe Histogram
-histogramFor m col = lookup col (metaHistograms m)
-
--- | 数值列按 16 个等宽桶统计，无数值给 Nothing
-histogramOf :: [Value] -> Maybe Histogram
-histogramOf values = case mapMaybe numericOf values of
-    [] -> Nothing
-    vs -> let lo = minimum vs; hi = maximum vs in Just (Histogram lo hi (bucketCounts lo hi vs))
-
--- | 值转成用于分桶的数；非数值给 Nothing
-numericOf :: Value -> Maybe Double
-numericOf (VInt n) = Just (fromIntegral n)
-numericOf (VFloat d) = Just d
-numericOf _ = Nothing
-
--- | 每个桶里落了多少个值
-bucketCounts :: Double -> Double -> [Double] -> [Int]
-bucketCounts lo hi vs = [length [v | v <- vs, bucketIndexOf lo hi v == i] | i <- [0 .. bucketTotal - 1]]
-
--- | 值落在第几个桶；区间退化时都算第 0 桶
-bucketIndexOf :: Double -> Double -> Double -> Int
-bucketIndexOf lo hi v
-    | hi <= lo = 0
-    | otherwise = max 0 (min (bucketTotal - 1) (floor ((v - lo) / (hi - lo) * fromIntegral bucketTotal) :: Int))
-
--- | 直方图的桶数
-bucketTotal :: Int
-bucketTotal = 16
-
--- | 取表的列名
-colNames :: Table -> [String]
-colNames = map fst . tableCols
-
--- | 查某列的定义
-colType :: Table -> String -> Maybe Column
-colType t c = lookup c (tableCols t)
-
--- | 按名查表，没有就报错
-lookupTable :: Database -> String -> Either String Table
-lookupTable db t = maybe (Left ("unknown table: " ++ t)) Right (lookup t db)
-
--- | 取表名引用的最后一段
-lastTablePart :: String -> String
-lastTablePart = reverse . takeWhile (/= '.') . reverse
-
--- | 推导列前缀：有别名用别名，否则取表名末段
-deriveQualifier :: Maybe String -> String -> String
-deriveQualifier (Just a) _ = a
-deriveQualifier Nothing t = lastTablePart t
-
--- | 按名查表并返回 schema 键：精确、前缀、唯一后缀
-resolveTable :: Database -> String -> Either String (String, Table)
-resolveTable db name = case lookup name db of
-    Just table -> Right (name, table)
-    Nothing
-        | '.' `elem` name, Just table <- lookup bare db -> Right (bare, table)
-        | [(key, table)] <- suffixed -> Right (key, table)
-        | otherwise -> Left (miss suffixed)
-  where
-    -- | 引用里去掉库前缀的那一段
-    bare = lastTablePart name
-    -- | schema 里以这个表名收尾的键：`sales.users` 能推出裸表名引用
-    suffixed = [(key, table) | (key, table) <- db, ('.' : name) `isSuffixOf` key]
-    -- | 一个候选都没有就是查无此表，多于一个就是有歧义
-    miss [] = "unknown table: " ++ name
-    miss _ = "ambiguous table: " ++ name
-
--- | 通配列名
-allColumns :: String
-allColumns = "*"
-
--- | 给列名加别名前缀
-qualify :: Maybe String -> String -> String
-qualify Nothing c = c
-qualify (Just a) c = a ++ "." ++ c
-
--- | 去掉别名前缀
-unqualify :: Maybe String -> String -> String
-unqualify Nothing c = c
-unqualify (Just a) c = fromMaybe c (stripPrefix (a ++ ".") c)
-
--- | 裸列仅允许唯一匹配，限定名必须精确匹配
-resolveColumn :: String -> [(String, a)] -> Either String (String, a)
-resolveColumn name env = case [(k, v) | (k, v) <- env, matches k] of
-    [entry] -> Right entry
-    [] -> Left ("unknown column: " ++ name)
-    _ -> Left ("ambiguous column: " ++ name)
-  where
-    -- | 裸名匹配末段，库限定名只补一层前缀
-    matches k = k == name || ('.' : name) `isSuffixOf` k
-        || (length (filter (== '.') name) == 2 && length (filter (== '.') k) == 1 && ('.' : k) `isSuffixOf` name)

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

@@ -1,509 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module ChuSQL.Core.Protocol (
-    SchemaColumn (..),
-    Request (..),
-    TxnOp (..),
-    Response (..),
-    TableInfo (..),
-    Account (..),
-    QueryResult (..),
-    valueToJSON,
-    valueFromJSON,
-    rowToJSON,
-    rowFromJSON,
-    queryResultJson,
-) where
-
-import ChuSQL.Core.Model (Histogram (..), Row, TableIdentity (..), Value (..))
-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.Char (isDigit)
-import Data.Scientific (base10Exponent, floatingOrInteger, fromFloatDigits)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Word (Word64)
-import Text.Read (readMaybe)
-
--- 线上协议类型：存储层请求/响应与查询结果集。
-
--- | 数据字典里一列的线上形状
-data SchemaColumn = SchemaColumn
-    { scName :: String
-    , scType :: String
-    , scNullable :: Bool
-    , scDefault :: Maybe Value
-    , scAutoIncrement :: Bool
-    , scPrimaryKey :: Bool
-    , scUnique :: Bool
-    , scCheck :: Maybe String
-    }
-    deriving (Show, Eq)
-
--- | 列编码成 JSON
-instance ToJSON SchemaColumn where
-    toJSON sc =
-        object
-            [ "name" .= scName sc
-            , "ty" .= scType sc
-            , "nullable" .= scNullable sc
-            , "default" .= fmap valueToJSON (scDefault sc)
-            , "auto_increment" .= scAutoIncrement sc
-            , "primary_key" .= scPrimaryKey sc
-            , "unique" .= scUnique sc
-            , "check" .= scCheck sc
-            ]
-
--- | JSON 解回列
-instance FromJSON SchemaColumn where
-    parseJSON = withObject "SchemaColumn" $ \o -> do
-        n <- o .: "name"
-        t <- o .: "ty"
-        nullable <- o .:? "nullable" .!= True
-        defJson <- o .:? "default"
-        def <- mapM valueFromJSON defJson
-        auto <- o .:? "auto_increment" .!= False
-        pk <- o .:? "primary_key" .!= False
-        uniq <- o .:? "unique" .!= False
-        chk <- o .:? "check"
-        pure (SchemaColumn n t nullable def auto pk uniq chk)
-
--- | 存储层请求
-data Request
-    = ReqPing
-    | ReqDatabase String String
-    | ReqAllCatalog
-    | ReqInDatabase String Request
-    | ReqAccountsList
-    | ReqIdentityInitialize T.Text
-    | ReqRoleCreate T.Text
-    | ReqCatalogManage Request
-    | 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)
-    | ReqAccountDrop T.Text
-    | ReqScan String
-    | ReqScanColumns String [String]
-    | ReqScanShard String (Maybe [String]) Int Int
-    | ReqInsert String Row
-    | ReqInsertBatch String [Row]
-    | ReqDeleteKeys String [Int]
-    | ReqReplaceAll String [Row]
-    | ReqListTables
-    | 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
-    | ReqDropIndex String String
-    | ReqDropColumn String String
-    | ReqReplaceSchema String [SchemaColumn] [Row]
-    | ReqListCatalog
-    | ReqApplyTransaction [TxnOp]
-
--- | 事务提交里的一条写操作
-data TxnOp
-    = TxnUpsert String [Row]
-    | TxnDelete String [Int]
-    | TxnReplace String [Row]
-    deriving (Show, Eq)
-
--- | 事务操作编码成 JSON
-instance ToJSON TxnOp where
-    toJSON (TxnUpsert t rs) =
-        object
-            [ "op" .= ("upsert" :: T.Text)
-            , "table" .= t
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON (TxnDelete t ks) =
-        object
-            [ "op" .= ("delete" :: T.Text)
-            , "table" .= t
-            , "ids" .= ks
-            ]
-    toJSON (TxnReplace t rs) =
-        object
-            [ "op" .= ("replace" :: T.Text)
-            , "table" .= t
-            , "rows" .= map rowToJSON rs
-            ]
-
--- | 请求编码成 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
-        A.Object fields -> A.Object (KM.insert "database" (A.String (T.pack name)) fields)
-        other -> other
-    toJSON (ReqCatalogManage command) = object ["method" .= ("catalog_manage" :: T.Text), "command" .= command]
-    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 sudo) =
-        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]
-    toJSON (ReqAccountDrop u) = object ["method" .= ("account_drop" :: T.Text), "user" .= u]
-    toJSON ReqPing = object ["method" .= ("ping" :: T.Text)]
-    toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t]
-    toJSON (ReqScanColumns t cols) = object ["method" .= ("scan" :: T.Text), "table" .= t, "columns" .= cols]
-    toJSON (ReqScanShard t cols shard shards) =
-        object
-            [ "method" .= ("scan_shard" :: T.Text)
-            , "table" .= t
-            , "columns" .= cols
-            , "shard" .= shard
-            , "shards" .= shards
-            ]
-    toJSON (ReqInsert t r) =
-        object
-            [ "method" .= ("insert" :: T.Text)
-            , "table" .= t
-            , "row" .= rowToJSON r
-            ]
-    toJSON (ReqInsertBatch t rs) =
-        object
-            [ "method" .= ("insert_batch" :: T.Text)
-            , "table" .= t
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON (ReqDeleteKeys t ks) =
-        object
-            [ "method" .= ("delete_keys" :: T.Text)
-            , "table" .= t
-            , "keys" .= ks
-            ]
-    toJSON (ReqReplaceAll t rs) =
-        object
-            [ "method" .= ("replace_all" :: T.Text)
-            , "table" .= t
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON ReqListTables = object ["method" .= ("list_tables" :: T.Text)]
-    toJSON (ReqLookupByColumn t c k) =
-        object
-            [ "method" .= ("lookup_by_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            , "key" .= valueToJSON k
-            ]
-    toJSON (ReqRangeByIndex t c lo hi) =
-        object
-            [ "method" .= ("range_by_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            , "lo" .= fmap (valueToJSON . fst) lo
-            , "lo_inclusive" .= maybe True snd lo
-            , "hi" .= fmap (valueToJSON . fst) hi
-            , "hi_inclusive" .= maybe True snd hi
-            ]
-    toJSON (ReqDescribeTable t) =
-        object
-            [ "method" .= ("describe_table" :: T.Text)
-            , "table" .= t
-            ]
-    toJSON (ReqCreateTable t cols) =
-        object
-            [ "method" .= ("create_table" :: T.Text)
-            , "table" .= t
-            , "columns" .= cols
-            ]
-    toJSON (ReqDropTable t) =
-        object ["method" .= ("drop_table" :: T.Text), "table" .= t]
-    toJSON (ReqCreateIndex t c) =
-        object
-            [ "method" .= ("create_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            ]
-    toJSON (ReqDropIndex t c) =
-        object
-            [ "method" .= ("drop_index" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            ]
-    toJSON (ReqDropColumn t c) =
-        object
-            [ "method" .= ("drop_column" :: T.Text)
-            , "table" .= t
-            , "column" .= c
-            ]
-    toJSON (ReqReplaceSchema t cols rs) =
-        object
-            [ "method" .= ("replace_schema" :: T.Text)
-            , "table" .= t
-            , "columns" .= cols
-            , "rows" .= map rowToJSON rs
-            ]
-    toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
-    toJSON (ReqApplyTransaction ops) =
-        object
-            [ "method" .= ("apply_transaction" :: T.Text)
-            , "ops" .= ops
-            ]
-
--- | 一张表的梗概：列、行数、索引与列统计
-data TableInfo = TableInfo
-    { tiTable :: String
-    , tiColumns :: [SchemaColumn]
-    , tiRows :: Int
-    , tiIndexes :: [String]
-    , tiStats :: [(String, Int, Bool)]
-    , tiHistograms :: [(String, Histogram)]
-    , tiIdentity :: Maybe TableIdentity
-    , tiSchemaVersion :: Maybe Word64
-    }
-    deriving (Show, Eq)
-
--- | 表信息编码成 JSON
-instance ToJSON TableInfo where
-    toJSON info =
-        object
-            [ "table" .= tiTable info
-            , "columns" .= tiColumns info
-            , "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) =
-            object (statFields ++ histFields (lookup name hists))
-          where
-            statFields = ["name" .= name, "distinct" .= distinct, "capped" .= capped]
-            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
-    | not (null counts) = Just (Histogram low high counts)
-histogramFromWire _ _ _ = Nothing
-
--- | JSON 解回表信息
-instance FromJSON TableInfo where
-    parseJSON = withObject "TableInfo" $ \o -> do
-        table <- o .: "table"
-        columns <- o .: "columns"
-        count <- o .: "row_count"
-        indexes <- o .:? "indexes" .!= []
-        stats <- o .:? "stats" .!= []
-        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
-                identity
-                (version >>= \v -> if v == 0 then Nothing else Just v)
-            )
-      where
-        parseStat = withObject "ColumnStat" $ \o -> do
-            name <- o .: "name"
-            distinct <- o .: "distinct"
-            capped <- o .:? "capped" .!= False
-            low <- o .:? "lo"
-            high <- o .:? "hi"
-            counts <- o .:? "hist" .!= []
-            pure (name, distinct, capped, histogramFromWire low high counts)
-
--- | 一条账号记录
-data Account = Account
-    { accountId :: Integer
-    , accountUser :: T.Text
-    , accountHash :: T.Text
-    , accountRevision :: Integer
-    , accountRegisteredAt :: T.Text
-    , accountLastLoginAt :: Maybe T.Text
-    , accountCanLogin :: Bool
-    , accountIsSuperuser :: Bool
-    , accountEnabled :: Bool
-    , accountSystemCatalogManager :: Bool
-    , accountAllowSudoAuth :: Bool
-    }
-    deriving (Eq)
-
--- | 账号的展示：只露账号名与版本号
-instance Show Account where
-    show a = "Account " ++ show (accountUser a) ++ " revision=" ++ show (accountRevision a)
-
--- | JSON 解回账号
-instance FromJSON Account where
-    parseJSON = withObject "Account" $ \o ->
-        Account
-            <$> o .: "id"
-            <*> 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
-            , "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
-    = RespPong
-    | RespAccounts [Account]
-    | RespRows [Row]
-    | RespTables [String]
-    | RespSchema TableInfo
-    | RespNoIndex
-    | RespOk
-    | RespError String
-    | RespCatalog [TableInfo]
-
--- | JSON 解回响应
-instance FromJSON Response where
-    parseJSON = withObject "Response" $ \o -> do
-        status <- o .: "status"
-        case status :: T.Text of
-            "accounts" -> RespAccounts <$> o .: "accounts"
-            "pong" -> pure RespPong
-            "ok" -> pure RespOk
-            "no_index" -> pure RespNoIndex
-            "rows" -> RespRows <$> (o .: "rows" >>= mapM rowFromJSON)
-            "tables" -> RespTables <$> o .: "tables"
-            "error" -> RespError <$> o .: "message"
-            "schema" -> RespSchema <$> parseJSON (A.Object o)
-            "catalog" -> do
-                xs <- o .: "schemas" :: Parser [A.Value]
-                RespCatalog <$> mapM parseJSON xs
-            other -> fail ("unknown status: " ++ T.unpack other)
-
--- | 值编码成 JSON
-valueToJSON :: Value -> A.Value
-valueToJSON VNull = A.Null
-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
-valueFromJSON A.Null = pure VNull
-valueFromJSON (A.Number n) =
-    case floatingOrInteger n :: Either Double Integer of
-        Right i -> pure (VInt (fromIntegral i))
-        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
-rowToJSON :: Row -> A.Value
-rowToJSON r =
-    A.Object (KM.fromList [(K.fromString k, valueToJSON v) | (k, v) <- r])
-
--- | JSON 解回一行
-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)
-rowFromJSON _ = fail "row must be a JSON object"
-
--- | 一条语句的结果集：列名与排好的行
-data QueryResult = QueryResult
-    { qrColumns :: [Text]
-    , qrRows :: [[Value]]
-    , qrRowCount :: Int
-    , qrTruncated :: Bool
-    , qrDatabase :: Maybe Text
-    }
-    deriving (Eq, Show)
-
--- | JSON 解回结果集
-instance FromJSON QueryResult where
-    parseJSON = withObject "QueryResult" $ \o -> do
-        cols <- o .: "columns"
-        rows <- o .: "rows"
-        QueryResult cols
-            <$> mapM (mapM valueFromJSON) rows
-            <*> o .:? "rowCount" .!= 0
-            <*> o .:? "truncated" .!= False
-            <*> o .:? "database"
-
--- | 结果还原成 JSON（JSON 输出与 TCP 结果集共用）
-queryResultJson :: QueryResult -> A.Value
-queryResultJson result =
-    object
-        [ "columns" .= qrColumns result
-        , "rows" .= map (map valueToJSON) (qrRows result)
-        , "rowCount" .= qrRowCount result
-        , "truncated" .= qrTruncated result
-        , "database" .= qrDatabase result
-        ]

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

@@ -1,294 +0,0 @@
-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/model/stack.yaml

@@ -1,4 +0,0 @@
-resolver: lts-24.59
-
-packages:
-    - .

chusql-core/model/stack.yaml.lock

@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/topics/lock_files
-
-packages: []
-snapshots:
-- completed:
-    sha256: 0f728e30e843d7f00460ad56858b995a3b227fca683659c7df9f2fc3988a3ce1
-    size: 732465
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/59.yaml
-  original: lts-24.59

chusql-core/storage/Cargo.lock

@@ -1,294 +0,0 @@
-# This file is automatically @generated by Cargo.
-# It is not intended for manual editing.
-version = 4
-
-[[package]]
-name = "bitflags"
-version = "2.13.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "3ded4057c258ba199e2d26386d3af3780957ecaee6c4ef4041c6b4b8b97c0b06"
-
-[[package]]
-name = "cfg-if"
-version = "1.0.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4e7648175b45a9a48536d676f68d918270699102aa8dab5496df06904c914600"
-
-[[package]]
-name = "chusql-core-storage"
-version = "0.1.0"
-dependencies = [
- "serde",
- "serde_json",
- "tempfile",
- "toml",
-]
-
-[[package]]
-name = "equivalent"
-version = "1.0.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "877a4ace8713b0bcf2a4e7eec82529c029f1d0619886d18145fea96c3ffe5c0f"
-
-[[package]]
-name = "errno"
-version = "0.3.14"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "39cab71617ae0d63f51a36d69f866391735b51691dbda63cf6f96d042b63efeb"
-dependencies = [
- "libc",
- "windows-sys",
-]
-
-[[package]]
-name = "fastrand"
-version = "2.5.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "da7c62ceae207dd37ea5b845da6a0696c799f85e97da1ab5b7910be3c1c80223"
-
-[[package]]
-name = "getrandom"
-version = "0.4.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "300e883d756b2e4ec94e02791f39b04b522276138852cfc41d9fb7e904106099"
-dependencies = [
- "cfg-if",
- "libc",
- "r-efi",
-]
-
-[[package]]
-name = "hashbrown"
-version = "0.17.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ed5909b6e89a2db4456e54cd5f673791d7eca6732202bbf2a9cc504fe2f9b84a"
-
-[[package]]
-name = "indexmap"
-version = "2.14.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "cc4e190f5d26ca7051642629da2c52fc03bde85a03197c99408dcd291734c855"
-dependencies = [
- "equivalent",
- "hashbrown",
-]
-
-[[package]]
-name = "itoa"
-version = "1.0.18"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "8f42a60cbdf9a97f5d2305f08a87dc4e09308d1276d28c869c684d7777685682"
-
-[[package]]
-name = "libc"
-version = "0.2.189"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "3eaf3ede3fee6db1a4c2ee091bf8a8b4dccdc6d17f656fb07896ee72867612f2"
-
-[[package]]
-name = "linux-raw-sys"
-version = "0.12.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "32a66949e030da00e8c7d4434b251670a91556f4144941d37452769c25d58a53"
-
-[[package]]
-name = "memchr"
-version = "2.8.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "cf8baf1c55e62ffcace7a9f06f4bd9cd3f0c4beb022d3b367256b91b87513d98"
-
-[[package]]
-name = "once_cell"
-version = "1.21.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9f7c3e4beb33f85d45ae3e3a1792185706c8e16d043238c593331cc7cd313b50"
-
-[[package]]
-name = "proc-macro2"
-version = "1.0.107"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "985e7ec9bb745e6ce6535b544d84d6cd6f7ad8bd711c398938ae983b91a766d9"
-dependencies = [
- "unicode-ident",
-]
-
-[[package]]
-name = "quote"
-version = "1.0.47"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1fbf4db142a473a8d80c26bbf18454ed458bf8d26c8219c331daecfdbd079001"
-dependencies = [
- "proc-macro2",
-]
-
-[[package]]
-name = "r-efi"
-version = "6.0.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f8dcc9c7d52a811697d2151c701e0d08956f92b0e24136cf4cf27b57a6a0d9bf"
-
-[[package]]
-name = "rustix"
-version = "1.1.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "891efababe418670775f199f0d233d84843c227a0949a883ce15b37c78d6629d"
-dependencies = [
- "bitflags",
- "errno",
- "libc",
- "linux-raw-sys",
- "windows-sys",
-]
-
-[[package]]
-name = "serde"
-version = "1.0.229"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4148590afebada386688f18773da617792bf2ef03ffc1e4cbd2b1d45b023e0ba"
-dependencies = [
- "serde_core",
- "serde_derive",
-]
-
-[[package]]
-name = "serde_core"
-version = "1.0.229"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "67dca2c9c51e58a4791a4b1ed58308b39c64224d349a935ab5039aa360942a48"
-dependencies = [
- "serde_derive",
-]
-
-[[package]]
-name = "serde_derive"
-version = "1.0.229"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e7a5d71263a5a7d47b41f6b3f06ba276f10cc18b0931f1799f710578e2309348"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "serde_json"
-version = "1.0.151"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c841b55ecdae098c80dcae9cf767f6f8a0c2cdb3416bbef72181df4d0fe73f14"
-dependencies = [
- "itoa",
- "memchr",
- "serde",
- "serde_core",
- "zmij",
-]
-
-[[package]]
-name = "serde_spanned"
-version = "0.6.9"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bf41e0cfaf7226dca15e8197172c295a782857fcb97fad1808a166870dee75a3"
-dependencies = [
- "serde",
-]
-
-[[package]]
-name = "syn"
-version = "3.0.6"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "8593e8e72159ed2257d083c7a454a85cbf854f37a0966d8d483aff8c8a3ebcee"
-dependencies = [
- "proc-macro2",
- "quote",
- "unicode-ident",
-]
-
-[[package]]
-name = "tempfile"
-version = "3.27.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "32497e9a4c7b38532efcdebeef879707aa9f794296a4f0244f6f69e9bc8574bd"
-dependencies = [
- "fastrand",
- "getrandom",
- "once_cell",
- "rustix",
- "windows-sys",
-]
-
-[[package]]
-name = "toml"
-version = "0.8.23"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "dc1beb996b9d83529a9e75c17a1686767d148d70663143c7854d8b4a09ced362"
-dependencies = [
- "serde",
- "serde_spanned",
- "toml_datetime",
- "toml_edit",
-]
-
-[[package]]
-name = "toml_datetime"
-version = "0.6.11"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "22cddaf88f4fbc13c51aebbf5f8eceb5c7c5a9da2ac40a13519eb5b0a0e8f11c"
-dependencies = [
- "serde",
-]
-
-[[package]]
-name = "toml_edit"
-version = "0.22.27"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "41fe8c660ae4257887cf66394862d21dbca4a6ddd26f04a3560410406a2f819a"
-dependencies = [
- "indexmap",
- "serde",
- "serde_spanned",
- "toml_datetime",
- "toml_write",
- "winnow",
-]
-
-[[package]]
-name = "toml_write"
-version = "0.1.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5d99f8c9a7727884afe522e9bd5edbfc91a3312b36a77b5fb8926e4c31a41801"
-
-[[package]]
-name = "unicode-ident"
-version = "1.0.26"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d245f478577f809a851594d02313b640fb437e0bb33866753cff937863096954"
-
-[[package]]
-name = "windows-link"
-version = "0.2.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f0805222e57f7521d6a62e36fa9163bc891acd422f971defe97d64e70d0a4fe5"
-
-[[package]]
-name = "windows-sys"
-version = "0.61.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ae137229bcbd6cdf0f7b80a31df61766145077ddf49416a728b02cb3921ff3fc"
-dependencies = [
- "windows-link",
-]
-
-[[package]]
-name = "winnow"
-version = "0.7.15"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "df79d97927682d2fd8adb29682d1140b343be4ac0f08fd68b7765d9c059d3945"
-dependencies = [
- "memchr",
-]
-
-[[package]]
-name = "zmij"
-version = "1.0.23"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "29666d0abbfad1e3dc4dcf6144730dd3a3ab225bbbdac83319345b1b44ccfc1b"

chusql-core/storage/Cargo.toml

@@ -1,16 +0,0 @@
-[package]
-name = "chusql-core-storage"
-version = "0.1.0"
-edition = "2024"
-
-[lib]
-name = "chusql_core_storage"
-crate-type = ["cdylib", "rlib"]
-
-[dependencies]
-serde = { version = "1", features = ["derive"] }
-serde_json = "1"
-toml = "0.8"
-
-[dev-dependencies]
-tempfile = "3"

chusql-core/storage/chusql-core-storage.toml.example

@@ -1,41 +0,0 @@
-# ChuSQL 存储服务配置示例
-#
-# 用法：安装时把本文件放到固定的用户配置目录（Windows 是 %APPDATA%\ChuSQL\settings.toml，
-#       其它平台是 ${XDG_CONFIG_HOME:-$HOME/.config}/ChuSQL/settings.toml）；
-#       临时换一份就用命令行参数 --config <path>（没有环境变量通道了）。
-#
-# 每一项都可以删掉：没写的项回退到内置默认值（下面注释里的值就是默认值）。
-# 优先级：本文件 > 内置默认值（没有配置键走环境变量了）。
-# 启动时 server 会把"读了哪个文件、每个选项从哪来"打进日志（[INFO] 开头那几行）。
-
-[page]
-# 页大小（字节）：512 ~ 65536 之间的 2 的幂。
-# 注意：改它会让已有数据文件（.db）读不出来（文件长度对不上页大小会直接报错）。
-size = 4096
-
-[btree]
-# B+ 树一个节点最多几个孩子（>= 3，且必须能放进一页：12 + (order-1)*8 + order*8 <= size）。
-# 注意：改它会让已有索引文件（.idx）对不上文件头里记的值，打开时报错。
-order = 4
-
-[buffer]
-# 缓冲池里最多放几页（>= 1）。
-pool_size = 1024
-
-[storage]
-# 数据目录：一张表一个 <表名>.db，一个索引一个 <表名>.idx。
-# 不写就跟随平台惯例（Windows %LOCALAPPDATA%\ChuSQL\data，
-# Unix ${XDG_DATA_HOME:-$HOME/.local/share}/chusql/data，跟安装脚本装的位置一致）；
-# 要固定就写绝对路径，例如：
-# data_dir = "/srv/chusql/data"
-#
-# 日志输出目录：启动器（csql-web）与安装脚本按它决定日志写哪；相对路径以启动目录为基准。
-# log_files = "./logs"
-
-[log]
-# 日志等级：off / error / warn / info / debug。debug 会多打每个请求和连接。
-level = "info"
-
-# 颜色没有配置项也没有环境变量：要写的那条流是终端就着色，重定向到文件就不着色。
-# 行格式：[等级 本地日期时间] [来源] 消息；来源 core=服务自身、request=由存储请求触发
-# ERROR 加粗红、WARN 加粗橙、DEBUG 加粗不变色、INFO 不加样式

chusql-core/storage/src/btree.rs

@@ -1,521 +0,0 @@
-use std::io;
-use std::path::Path;
-
-use crate::page::{Page, PageFile, PageId};
-
-// 磁盘 B+ 树：键是变长字节串，允许重复键，叶子链支持范围扫描。
-
-const META_PAGE: PageId = 0;
-const META_MAGIC: &[u8; 4] = b"CBK2";
-const OFF_PAGE_SIZE: usize = 4;
-const OFF_MAX_KEY: usize = 8;
-const OFF_ROOT: usize = 10;
-const OFF_ORDER: usize = 18;
-
-const NODE_LEAF: u8 = 0;
-const NODE_INTERNAL: u8 = 1;
-const OFF_KIND: usize = 0;
-const OFF_COUNT: usize = 1;
-const OFF_NEXT: usize = 3;
-const HEADER: usize = 11;
-const SLOT: usize = 2;
-const CELL_FIXED: usize = 2 + 8;
-
-/// 键长上限：节点里的格子必须放得进一页
-pub const MAX_KEY_BYTES: usize = 64;
-
-/// 一个节点最多几个键
-fn max_keys(order: usize) -> usize {
-    order - 1
-}
-
-/// 一个格子最多占多少字节
-fn max_cell_bytes() -> usize {
-    CELL_FIXED + MAX_KEY_BYTES
-}
-
-/// 这个 order 放得进一页吗
-pub fn fits_in_page(page_size: usize, order: usize) -> bool {
-    order >= 2 && HEADER + max_keys(order) * (SLOT + max_cell_bytes()) <= page_size
-}
-
-/// 一页最多几个孩子
-pub fn max_order(page_size: usize) -> usize {
-    page_size.saturating_sub(HEADER) / (SLOT + max_cell_bytes()) + 1
-}
-
-/// 读一个 u8
-fn read_u8(p: &Page, off: usize) -> u8 {
-    p.data[off]
-}
-
-/// 写一个 u8
-fn write_u8(p: &mut Page, off: usize, v: u8) {
-    p.data[off] = v;
-}
-
-/// 读一个小端 u16
-fn read_u16(p: &Page, off: usize) -> u16 {
-    u16::from_le_bytes([p.data[off], p.data[off + 1]])
-}
-
-/// 写一个小端 u16
-fn write_u16(p: &mut Page, off: usize, v: u16) {
-    p.data[off..off + 2].copy_from_slice(&v.to_le_bytes());
-}
-
-/// 读一个小端 u32
-fn read_u32(p: &Page, off: usize) -> u32 {
-    u32::from_le_bytes([p.data[off], p.data[off + 1], p.data[off + 2], p.data[off + 3]])
-}
-
-/// 写一个小端 u32
-fn write_u32(p: &mut Page, off: usize, v: u32) {
-    p.data[off..off + 4].copy_from_slice(&v.to_le_bytes());
-}
-
-/// 读一个小端 u64
-fn read_u64(p: &Page, off: usize) -> u64 {
-    let mut b = [0u8; 8];
-    b.copy_from_slice(&p.data[off..off + 8]);
-    u64::from_le_bytes(b)
-}
-
-/// 写一个小端 u64
-fn write_u64(p: &mut Page, off: usize, v: u64) {
-    p.data[off..off + 8].copy_from_slice(&v.to_le_bytes());
-}
-
-/// 写文件头
-fn write_meta(page: &mut Page, page_size: usize, order: usize, root: PageId) {
-    page.zero();
-    page.data[0..4].copy_from_slice(META_MAGIC);
-    write_u32(page, OFF_PAGE_SIZE, page_size as u32);
-    write_u16(page, OFF_MAX_KEY, MAX_KEY_BYTES as u16);
-    write_u64(page, OFF_ROOT, root);
-    write_u16(page, OFF_ORDER, order as u16);
-}
-
-/// 校验文件头与配置
-fn check_meta(page: &Page, page_size: usize, order: usize) -> io::Result<()> {
-    if page.data[0..4] != *META_MAGIC {
-        return Err(io::Error::new(
-            io::ErrorKind::InvalidData,
-            "not a chusql index file (bad magic)",
-        ));
-    }
-    let stored_page = read_u32(page, OFF_PAGE_SIZE) as usize;
-    let stored_order = read_u16(page, OFF_ORDER) as usize;
-    if stored_page != page_size || stored_order != order {
-        return Err(io::Error::new(
-            io::ErrorKind::InvalidData,
-            format!(
-                "index file was built with page.size={} btree.order={}, config says page.size={} btree.order={}",
-                stored_page, stored_order, page_size, order
-            ),
-        ));
-    }
-    Ok(())
-}
-
-/// 一个节点：叶子存行位置，内部节点存孩子页号
-struct Node {
-    kind: u8,
-    next: PageId,
-    keys: Vec<Vec<u8>>,
-    values: Vec<u64>,
-}
-
-/// 一个格子占多少字节
-fn cell_bytes(key: &[u8]) -> usize {
-    CELL_FIXED + key.len()
-}
-
-/// 节点占多少字节
-fn node_bytes(node: &Node) -> usize {
-    HEADER + node.keys.len() * SLOT + node.keys.iter().map(|k| cell_bytes(k)).sum::<usize>()
-}
-
-/// 把节点写回一页（格子从页尾往前摆，槽位从头部往后长）
-fn put_node(p: &mut Page, node: &Node) -> io::Result<()> {
-    if node.keys.len() > u16::MAX as usize || node_bytes(node) > p.data.len() {
-        return Err(io::Error::new(
-            io::ErrorKind::InvalidInput,
-            "index node does not fit in a page",
-        ));
-    }
-    p.zero();
-    write_u8(p, OFF_KIND, node.kind);
-    write_u16(p, OFF_COUNT, node.keys.len() as u16);
-    // 内部节点比键多一个孩子，最后一个放在 next 槽位里
-    let trailer = if node.kind == NODE_INTERNAL {
-        node.values.last().copied().unwrap_or(0)
-    } else {
-        node.next
-    };
-    write_u64(p, OFF_NEXT, trailer);
-    let mut cursor = p.data.len();
-    for (i, key) in node.keys.iter().enumerate() {
-        let size = cell_bytes(key);
-        cursor -= size;
-        write_u16(p, cursor, key.len() as u16);
-        p.data[cursor + 2..cursor + 2 + key.len()].copy_from_slice(key);
-        write_u64(p, cursor + 2 + key.len(), node.values[i]);
-        write_u16(p, HEADER + i * SLOT, cursor as u16);
-    }
-    Ok(())
-}
-
-/// 从一页读出节点
-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);
-        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 {
-        Ok(Node { kind, next: trailer, keys, values })
-    }
-}
-
-/// 叶子里的插入位置：同键按 value 排，保证顺序稳定
-fn leaf_slot(keys: &[Vec<u8>], values: &[u64], key: &[u8], value: u64) -> usize {
-    let mut i = keys.partition_point(|k| k.as_slice() < key);
-    while i < keys.len() && keys[i].as_slice() == key && values[i] < value {
-        i += 1;
-    }
-    i
-}
-
-/// 内部节点里选哪个孩子
-fn child_slot(keys: &[Vec<u8>], key: &[u8]) -> usize {
-    keys.partition_point(|k| k.as_slice() <= key)
-}
-
-/// 切开一个节点：返回上提的键与右半节点
-fn split_node(node: &mut Node) -> (Vec<u8>, Node) {
-    let mid = node.keys.len() / 2;
-    if node.kind == NODE_LEAF {
-        let sep = node.keys[mid].clone();
-        let right = Node {
-            kind: NODE_LEAF,
-            next: node.next,
-            keys: node.keys.split_off(mid),
-            values: node.values.split_off(mid),
-        };
-        (sep, right)
-    } else {
-        let sep = node.keys[mid].clone();
-        let right_keys = node.keys.split_off(mid + 1);
-        let right_values = node.values.split_off(mid + 1);
-        node.keys.pop();
-        (
-            sep,
-            Node { kind: NODE_INTERNAL, next: 0, keys: right_keys, values: right_values },
-        )
-    }
-}
-
-/// 磁盘 B+ 树
-pub struct DiskBTree {
-    file: PageFile,
-    order: usize,
-}
-
-impl DiskBTree {
-    /// 打开或新建索引文件
-    pub fn open<P: AsRef<Path>>(
-        path: P,
-        page_size: usize,
-        order: usize,
-        pool_size: usize,
-    ) -> io::Result<Self> {
-        if !fits_in_page(page_size, order) {
-            return Err(io::Error::new(
-                io::ErrorKind::InvalidInput,
-                format!(
-                    "btree order {} does not fit in a {}-byte page (max {})",
-                    order,
-                    page_size,
-                    max_order(page_size)
-                ),
-            ));
-        }
-        let mut file = PageFile::with_options(path, page_size, pool_size)?;
-        if file.num_pages()? == 0 {
-            let mut meta = Page::new(META_PAGE, page_size);
-            write_meta(&mut meta, page_size, order, 0);
-            file.write_page(&meta)?;
-        } else {
-            let meta = file.read_page(META_PAGE)?;
-            check_meta(&meta, page_size, order)?;
-        }
-        Ok(DiskBTree { file, order })
-    }
-
-    /// 键太长直接报错，避免写坏节点
-    fn check_key(&self, key: &[u8]) -> io::Result<()> {
-        if key.len() > MAX_KEY_BYTES {
-            return Err(io::Error::new(
-                io::ErrorKind::InvalidInput,
-                format!(
-                    "index key is {} bytes, at most {} are supported",
-                    key.len(),
-                    MAX_KEY_BYTES
-                ),
-            ));
-        }
-        Ok(())
-    }
-
-    /// 读根页页号；空树是 None
-    fn root(&mut self) -> io::Result<Option<PageId>> {
-        let r = self.file.with_page(META_PAGE, |p| read_u64(p, OFF_ROOT))?;
-        Ok(if r == 0 { None } else { Some(r) })
-    }
-
-    /// 写根页页号
-    fn set_root(&mut self, r: Option<PageId>) -> io::Result<()> {
-        self.file
-            .update_page(META_PAGE, |p| write_u64(p, OFF_ROOT, r.unwrap_or(0)))
-    }
-
-    /// 追加一个新节点页
-    fn alloc(&mut self, node: &Node) -> io::Result<PageId> {
-        let page = self.file.append_page()?;
-        let id = page.id;
-        self.file.update_page(id, |p| put_node(p, node))??;
-        Ok(id)
-    }
-
-    /// 按页号读节点
-    fn load(&mut self, id: PageId) -> io::Result<Node> {
-        self.file.with_page(id, get_node)?
-    }
-
-    /// 按页号写节点
-    fn store(&mut self, id: PageId, node: &Node) -> io::Result<()> {
-        self.file.update_page(id, |p| put_node(p, node))?
-    }
-
-    /// 清空整棵树
-    pub fn clear(&mut self) -> io::Result<()> {
-        let page_size = self.file.page_size();
-        self.file.truncate()?;
-        let mut meta = Page::new(META_PAGE, page_size);
-        write_meta(&mut meta, page_size, self.order, 0);
-        self.file.write_page(&meta)?;
-        Ok(())
-    }
-
-    /// 树是空的吗（只看最左叶子，不用整树遍历）
-    pub fn is_empty(&mut self) -> io::Result<bool> {
-        let Some(mut id) = self.root()? else {
-            return Ok(true);
-        };
-        loop {
-            let node = self.load(id)?;
-            if node.kind == NODE_LEAF {
-                return Ok(node.keys.is_empty());
-            }
-            id = node.values[0];
-        }
-    }
-
-    /// 按 key 取第一个位置
-    pub fn get(&mut self, key: &[u8]) -> io::Result<Option<u64>> {
-        Ok(self.get_all(key)?.into_iter().next())
-    }
-
-    /// 按 key 取全部位置（重复键按值升序）
-    pub fn get_all(&mut self, key: &[u8]) -> io::Result<Vec<u64>> {
-        let mut values: Vec<_> = self.scan(Some(key), Some(key))?.into_iter().map(|(_, value)| value).collect();
-        values.sort_unstable();
-        Ok(values)
-    }
-
-    /// 插入一个键值对（键可重复）
-    pub fn insert(&mut self, key: &[u8], value: u64) -> io::Result<()> {
-        self.check_key(key)?;
-        match self.root()? {
-            None => {
-                let node = Node {
-                    kind: NODE_LEAF,
-                    next: 0,
-                    keys: vec![key.to_vec()],
-                    values: vec![value],
-                };
-                let id = self.alloc(&node)?;
-                self.set_root(Some(id))
-            }
-            Some(root) => match self.insert_rec(root, key, value)? {
-                None => Ok(()),
-                Some((sep, right_id)) => {
-                    let node = Node {
-                        kind: NODE_INTERNAL,
-                        next: 0,
-                        keys: vec![sep],
-                        values: vec![root, right_id],
-                    };
-                    let id = self.alloc(&node)?;
-                    self.set_root(Some(id))
-                }
-            },
-        }
-    }
-
-    /// 递归插入，溢出就把右半节点与上提键交给上层
-    fn insert_rec(
-        &mut self,
-        id: PageId,
-        key: &[u8],
-        value: u64,
-    ) -> io::Result<Option<(Vec<u8>, PageId)>> {
-        let mut node = self.load(id)?;
-        if node.kind == NODE_LEAF {
-            let at = leaf_slot(&node.keys, &node.values, key, value);
-            node.keys.insert(at, key.to_vec());
-            node.values.insert(at, value);
-        } else {
-            let child = node.values[child_slot(&node.keys, key)];
-            if let Some((sep, right_id)) = self.insert_rec(child, key, value)? {
-                let at = node.keys.partition_point(|k| k.as_slice() <= sep.as_slice());
-                node.keys.insert(at, sep);
-                node.values.insert(at + 1, right_id);
-            }
-        }
-        if node.keys.len() <= max_keys(self.order) {
-            self.store(id, &node)?;
-            return Ok(None);
-        }
-        let (sep, right) = split_node(&mut node);
-        let right_id = self.alloc(&right)?;
-        if node.kind == NODE_LEAF {
-            node.next = right_id;
-        }
-        self.store(id, &node)?;
-        Ok(Some((sep, right_id)))
-    }
-
-    /// 删掉一个 (key, value)
-    pub fn delete(&mut self, key: &[u8], value: u64) -> io::Result<bool> {
-        let Some(root) = self.root()? else {
-            return Ok(false);
-        };
-        self.delete_rec(root, key, value)
-    }
-
-    /// 递归删一个 (key, value)
-    fn delete_rec(&mut self, id: PageId, key: &[u8], value: u64) -> io::Result<bool> {
-        let mut node = self.load(id)?;
-        if node.kind == NODE_LEAF {
-            let at = leaf_slot(&node.keys, &node.values, key, value);
-            if at < node.keys.len() && node.keys[at].as_slice() == key && node.values[at] == value {
-                node.keys.remove(at);
-                node.values.remove(at);
-                self.store(id, &node)?;
-                return Ok(true);
-            }
-            return Ok(false);
-        }
-        let first = node.keys.partition_point(|k| k.as_slice() < key);
-        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)
-    }
-
-    /// 叶子链上按顺序取全部 (键, 值)
-    pub fn iter_all(&mut self) -> io::Result<Vec<(Vec<u8>, u64)>> {
-        self.scan(None, None)
-    }
-
-    /// 范围扫描：lo / hi 都是闭区间，None 表示不限
-    pub fn scan(
-        &mut self,
-        lo: Option<&[u8]>,
-        hi: Option<&[u8]>,
-    ) -> io::Result<Vec<(Vec<u8>, u64)>> {
-        let Some(mut id) = self.root()? else {
-            return Ok(Vec::new());
-        };
-        loop {
-            let node = self.load(id)?;
-            if node.kind == NODE_LEAF {
-                id = match lo {
-                    None => id,
-                    Some(start) => {
-                        let at = node.keys.partition_point(|k| k.as_slice() < start);
-                        if at < node.keys.len() { id } else { node.next }
-                    }
-                };
-                break;
-            }
-            id = match lo {
-                None => node.values[0],
-                Some(start) => node.values[node.keys.partition_point(|k| k.as_slice() < start)],
-            };
-        }
-        let mut out = Vec::new();
-        while id != 0 {
-            let node = self.load(id)?;
-            for i in 0..node.keys.len() {
-                if lo.is_some_and(|start| node.keys[i].as_slice() < start) {
-                    continue;
-                }
-                if hi.is_some_and(|end| node.keys[i].as_slice() > end) {
-                    return Ok(out);
-                }
-                out.push((node.keys[i].clone(), node.values[i]));
-            }
-            id = node.next;
-        }
-        Ok(out)
-    }
-
-    /// 脏页写回
-    pub fn flush(&mut self) -> io::Result<()> {
-        self.file.flush()
-    }
-
-    /// 当前缓存页数
-    pub fn cached_pages(&self) -> usize {
-        self.file.cached_pages()
-    }
-}

chusql-core/storage/src/catalog.rs

@@ -1,587 +0,0 @@
-use std::collections::hash_map::DefaultHasher;
-use std::collections::{BTreeMap, BTreeSet, HashMap};
-use std::hash::{Hash, Hasher};
-use std::io;
-use std::io::Write;
-use std::path::Path;
-
-use serde::{Deserialize, Serialize};
-
-use crate::protocol::{Row, SchemaColumn};
-
-// 数据字典：记每张表有哪些列、什么类型、多少行、有哪些索引，以及列级统计。
-
-const STATS_DISTINCT_CAP: u64 = 4096;
-const HIST_BUCKETS: usize = 16;
-
-#[derive(Debug, Clone, Serialize, Deserialize)]
-pub struct IndexSchema {
-    pub column: String,
-}
-
-#[derive(Debug, Clone, Default, Serialize, Deserialize)]
-pub struct ColumnStat {
-    pub distinct: u64,
-    #[serde(default)]
-    pub capped: bool,
-    #[serde(default)]
-    pub lo: Option<f64>,
-    #[serde(default)]
-    pub hi: Option<f64>,
-    #[serde(default)]
-    pub hist: Vec<u64>,
-}
-
-#[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>,
-    #[serde(default)]
-    pub dropped_columns: BTreeSet<String>,
-    #[serde(default)]
-    pub compacted: bool,
-    #[serde(default)]
-    pub row_count: u64,
-    #[serde(default)]
-    pub indexes: Vec<IndexSchema>,
-    #[serde(default)]
-    pub stats: BTreeMap<String, ColumnStat>,
-}
-
-#[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>,
-    #[serde(skip)]
-    seen: BTreeMap<String, HashMap<u64, u64>>,
-}
-
-impl Catalog {
-    /// 从文件读；不存在给空字典
-    pub fn load<P: AsRef<Path>>(path: P) -> io::Result<Self> {
-        if !path.as_ref().exists() {
-            return Ok(Catalog::default());
-        }
-        let bytes = std::fs::read(path)?;
-        if bytes.is_empty() {
-            return Ok(Catalog::default());
-        }
-        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)。
-    pub fn all_tables(&self) -> Vec<(&str, &TableSchema)> {
-        self.tables.iter().map(|(k, v)| (k.as_str(), v)).collect()
-    }
-
-    /// 写回文件
-    pub fn save<P: AsRef<Path>>(&self, path: P) -> io::Result<()> {
-        let bytes = serde_json::to_vec_pretty(self).map_err(io::Error::other)?;
-        let pending = path.as_ref().with_extension("json.pending");
-        let mut file = std::fs::File::create(&pending)?;
-        file.write_all(&bytes)?;
-        file.sync_all()?;
-        drop(file);
-        std::fs::rename(pending, &path)?;
-        std::fs::OpenOptions::new().read(true).write(true).open(path)?.sync_all()
-    }
-
-    /// 一张表的 schema
-    pub fn describe(&self, table: &str) -> Option<&TableSchema> {
-        self.tables.get(table)
-    }
-
-    /// 记录过的所有表名
-    pub fn table_names(&self) -> Vec<String> {
-        self.tables.keys().cloned().collect()
-    }
-
-    /// 按一行数据补列
-    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)?;
-        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(),
-                compacted: false,
-                row_count: 0,
-                indexes: Vec::new(),
-                stats: BTreeMap::new(),
-            },
-        );
-        Ok(())
-    }
-
-    /// 标记内部账号表
-    pub fn mark_system(&mut self, table: &str) -> io::Result<()> {
-        let entry = self.tables.get_mut(table)
-            .ok_or_else(|| io::Error::other("missing system table"))?;
-        entry.system = true;
-        Ok(())
-    }
-
-    /// 记一次插入，返回列有没有变化
-    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)?;
-            entry.row_count += 1;
-            changed
-        };
-        self.count_values(table, row);
-        Ok(changed)
-    }
-
-    /// 记一次删除：行数减少 + 更新列统计
-    pub fn record_delete(&mut self, table: &str, rows: &[Row]) {
-        let entry = self.tables.entry(table.to_string()).or_default();
-        entry.row_count = entry.row_count.saturating_sub(rows.len() as u64);
-        let seen = self.seen.entry(table.to_string()).or_default();
-        for r in rows {
-            for (name, v) in r {
-                let stat = entry.stats.entry(name.clone()).or_default();
-                hist_remove(stat, v);
-                if stat.capped {
-                    continue;
-                }
-                let key = fold(name, value_hash(v));
-                if let Some(count) = seen.get_mut(&key) {
-                    *count = count.saturating_sub(1);
-                    if *count == 0 {
-                        seen.remove(&key);
-                        stat.distinct = stat.distinct.saturating_sub(1);
-                    }
-                }
-            }
-        }
-        if entry.row_count == 0 {
-            seen.clear();
-            for stat in entry.stats.values_mut() {
-                stat.distinct = 0;
-                stat.capped = false;
-                stat.lo = None;
-                stat.hi = None;
-                stat.hist.clear();
-            }
-        }
-    }
-
-    /// 重数一遍统计与行数
-    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;
-        }
-        Ok(changed)
-    }
-
-    /// 这一列第一次见到这个值就加一
-    fn count_values(&mut self, table: &str, row: &Row) {
-        let entry = self.tables.entry(table.to_string()).or_default();
-        let seen = self.seen.entry(table.to_string()).or_default();
-        for (name, v) in row {
-            let stat = entry.stats.entry(name.clone()).or_default();
-            hist_add(stat, v);
-            if stat.capped {
-                continue;
-            }
-            let count = seen.entry(fold(name, value_hash(v))).or_insert(0);
-            *count += 1;
-            if *count == 1 {
-                stat.distinct += 1;
-                if stat.distinct >= STATS_DISTINCT_CAP {
-                    stat.capped = true;
-                }
-            }
-        }
-    }
-
-    /// 删表
-    pub fn drop_table(&mut self, table: &str) -> io::Result<()> {
-        if self.tables.remove(table).is_none() {
-            return Err(io::Error::new(
-                io::ErrorKind::NotFound,
-                format!("unknown table: {}", table),
-            ));
-        }
-        self.seen.remove(table);
-        Ok(())
-    }
-
-    /// 表改名到指定名字
-    pub fn rename_table(&mut self, from: &str, to: &str) -> io::Result<bool> {
-        let Some(entry) = self.tables.get(from) else {
-            return Ok(false);
-        };
-        if self.tables.contains_key(to) {
-            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)
-    }
-
-    /// 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();
-        entry.stats.clear();
-        self.seen.remove(table);
-        Ok(())
-    }
-
-    /// 老数据的列类型名规范化；返回有没有改动
-    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 {
-                    column.ty = fixed;
-                    changed = true;
-                }
-            }
-        }
-        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);
-            entry.columns.len() != before
-        };
-        entry.stats.remove(column);
-        entry.dropped_columns.insert(column.to_string());
-        entry.compacted = false;
-        entry.indexes.retain(|i| i.column != column);
-        self.seen.remove(table);
-        Ok(had_column)
-    }
-
-    /// 记住这一版已整理过（隐藏列名要留住）
-    pub fn mark_compacted(&mut self, table: &str) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
-        entry.compacted = true;
-        self.seen.remove(table);
-        Ok(())
-    }
-
-    /// 这张表还有隐藏列字节吗
-    pub fn has_dropped_columns(&self, table: &str) -> bool {
-        self.tables.get(table).is_some_and(|e| !e.dropped_columns.is_empty())
-    }
-
-    /// 还有隐藏列字节待整理的表
-    pub fn dropped_tables(&self) -> Vec<String> {
-        self.tables
-            .iter()
-            .filter(|(_, e)| !e.dropped_columns.is_empty() && !e.compacted)
-            .map(|(t, _)| t.clone())
-            .collect()
-    }
-
-    /// 记下一条索引定义
-    pub fn add_index(&mut self, table: &str, column: &str) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
-        if entry.indexes.iter().any(|i| i.column == column) {
-            return Err(io::Error::new(
-                io::ErrorKind::AlreadyExists,
-                format!("index on column \"{}\" already exists", column),
-            ));
-        }
-        entry.indexes.push(IndexSchema {
-            column: column.to_string(),
-        });
-        Ok(())
-    }
-
-    /// 去掉一条索引定义
-    pub fn remove_index(&mut self, table: &str, column: &str) -> io::Result<()> {
-        let entry = self
-            .tables
-            .get_mut(table)
-            .ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
-        match entry.indexes.iter().position(|i| i.column == column) {
-            None => Err(io::Error::new(
-                io::ErrorKind::NotFound,
-                format!("no index on column \"{}\"", column),
-            )),
-            Some(i) => {
-                entry.indexes.remove(i);
-                Ok(())
-            }
-        }
-    }
-}
-
-/// 把行里"字典还不知道的列"补进来；返回有没有变化
-fn add_missing_columns(entry: &mut TableSchema, row: &Row) -> io::Result<bool> {
-    let additions: Vec<_> = row.iter().filter(|(name, _)|
-        !entry.dropped_columns.contains(*name) && !entry.columns.iter().any(|c| &c.name == *name))
-        .filter_map(|(name, value)| infer_type(value).map(|ty| SchemaColumn {
-            name: name.clone(), ty, ..Default::default()
-        })).collect();
-    if additions.is_empty() {
-        return Ok(false);
-    }
-    entry.schema_version = next_schema_version(entry)?;
-    entry.columns.extend(additions);
-    Ok(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"))
-}
-
-/// 由 JSON 值猜列类型
-fn infer_type(v: &serde_json::Value) -> Option<String> {
-    match v {
-        serde_json::Value::Number(_) => Some("int".to_string()),
-        serde_json::Value::String(_) => Some("str".to_string()),
-        serde_json::Value::Bool(_) => Some("bool".to_string()),
-        _ => None,
-    }
-}
-
-/// 类型别名统一成规范名，参数原样保留
-pub fn normalize_type(ty: &str) -> String {
-    let trimmed = ty.trim();
-    let (base, args) = match trimmed.find('(') {
-        Some(i) => (&trimmed[..i], &trimmed[i..]),
-        None => (trimmed, ""),
-    };
-    match base.trim().to_ascii_lowercase().as_str() {
-        "integer" => format!("int{args}"),
-        "int" => format!("int{args}"),
-        "bigint" => format!("bigint{args}"),
-        "smallint" => format!("smallint{args}"),
-        "str" => format!("str{args}"),
-        "text" => format!("str{args}"),
-        "varchar" => format!("varchar{args}"),
-        "char" => format!("char{args}"),
-        "bool" => format!("bool{args}"),
-        "boolean" => format!("bool{args}"),
-        "float" => format!("float{args}"),
-        "real" => format!("float{args}"),
-        "double" => format!("double{args}"),
-        "decimal" => format!("decimal{args}"),
-        "numeric" => format!("decimal{args}"),
-        "date" => format!("date{args}"),
-        "timestamp" => format!("timestamp{args}"),
-        "blob" => format!("blob{args}"),
-        _ => trimmed.to_string(),
-    }
-}
-
-/// 一个值的哈希，统计不同值个数用
-fn value_hash(v: &serde_json::Value) -> u64 {
-    let mut h = DefaultHasher::new();
-    v.to_string().hash(&mut h);
-    h.finish()
-}
-
-/// 列名与值哈希合成一个哈希
-fn fold(column: &str, value_hash: u64) -> u64 {
-    let mut h = DefaultHasher::new();
-    column.hash(&mut h);
-    value_hash.hash(&mut h);
-    h.finish()
-}
-
-/// 值落在第几个桶；区间退化时都算第 0 桶
-fn hist_index(lo: f64, hi: f64, v: f64) -> usize {
-    if hi <= lo {
-        return 0;
-    }
-    let scaled = ((v - lo) / (hi - lo) * HIST_BUCKETS as f64).floor();
-    scaled.clamp(0.0, (HIST_BUCKETS - 1) as f64) as usize
-}
-
-/// 区间拓宽时把旧桶按中点并进来，只保总量
-fn hist_merge(old: &[u64], old_lo: f64, old_hi: f64, new_lo: f64, new_hi: f64) -> Vec<u64> {
-    let mut out = vec![0u64; HIST_BUCKETS];
-    for (i, count) in old.iter().enumerate() {
-        if *count == 0 {
-            continue;
-        }
-        let mid = if old_hi > old_lo {
-            old_lo + (old_hi - old_lo) * (i as f64 + 0.5) / old.len() as f64
-        } else {
-            old_lo
-        };
-        out[hist_index(new_lo, new_hi, mid)] += *count;
-    }
-    out
-}
-
-/// 把一个值并进直方图；值跑出区间就拓宽区间
-fn hist_add(stat: &mut ColumnStat, v: &serde_json::Value) {
-    let Some(x) = v.as_f64() else { return };
-    match (stat.lo, stat.hi) {
-        (Some(lo), Some(hi)) if stat.hist.len() == HIST_BUCKETS => {
-            if x < lo || x > hi {
-                let (nlo, nhi) = (lo.min(x), hi.max(x));
-                stat.hist = hist_merge(&stat.hist, lo, hi, nlo, nhi);
-                stat.lo = Some(nlo);
-                stat.hi = Some(nhi);
-            }
-            let index = hist_index(stat.lo.unwrap_or(x), stat.hi.unwrap_or(x), x);
-            stat.hist[index] += 1;
-        }
-        _ => {
-            stat.lo = Some(x);
-            stat.hi = Some(x);
-            stat.hist = vec![0u64; HIST_BUCKETS];
-            stat.hist[0] = 1;
-        }
-    }
-}
-
-/// 从直方图里减掉一个值；值在区间外就不动
-fn hist_remove(stat: &mut ColumnStat, v: &serde_json::Value) {
-    let Some(x) = v.as_f64() else { return };
-    let (Some(lo), Some(hi)) = (stat.lo, stat.hi) else { return };
-    if x < lo || x > hi || stat.hist.len() != HIST_BUCKETS {
-        return;
-    }
-    let index = hist_index(lo, hi, x);
-    if let Some(bucket) = (0..stat.hist.len()).filter(|&i| stat.hist[i] > 0).min_by_key(|&i| i.abs_diff(index)) {
-        stat.hist[bucket] -= 1;
-    }
-}

chusql-core/storage/src/config.rs

@@ -1,320 +0,0 @@
-use std::path::PathBuf;
-
-use serde::Deserialize;
-
-use crate::log::Level;
-
-// 全局配置：只从 TOML 文件读，缺项回退内置默认值；
-// 存储相关分区由本模块解析校验，其它层的分区一概不碰。
-
-/// 配置文件名
-pub const CONFIG_FILE_NAME: &str = "settings.toml";
-/// 配置目录名（随系统惯例放在用户配置目录下）
-pub const APP_DIR_NAME: &str = "ChuSQL";
-/// Unix 下的数据目录名（XDG 惯例小写，跟安装脚本的默认安装目录一致）
-pub const UNIX_APP_DIR_NAME: &str = "chusql";
-/// 数据子目录名
-pub const DATA_DIR_NAME: &str = "data";
-
-pub const DEFAULT_POOL_SIZE: usize = 1024;
-pub const DEFAULT_PAGE_SIZE: usize = 4096;
-pub const DEFAULT_BTREE_ORDER: usize = 4;
-pub const DEFAULT_LOG_LEVEL: &str = "info";
-/// 默认日志输出目录（相对启动目录）
-pub const DEFAULT_LOG_FILES: &str = "./logs";
-
-const MIN_PAGE_SIZE: usize = 512;
-const MAX_PAGE_SIZE: usize = 65536;
-const MIN_BTREE_ORDER: usize = 3;
-
-/// 默认配置文件路径（按平台惯例）
-pub fn default_config_path() -> PathBuf {
-    #[cfg(windows)]
-    {
-        let appdata = std::env::var_os("APPDATA").filter(|v| !v.is_empty());
-        if let Some(appdata) = appdata {
-            return PathBuf::from(appdata).join(APP_DIR_NAME).join(CONFIG_FILE_NAME);
-        }
-    }
-    #[cfg(not(windows))]
-    {
-        let xdg = std::env::var_os("XDG_CONFIG_HOME").filter(|v| !v.is_empty());
-        if let Some(xdg) = xdg {
-            return PathBuf::from(xdg).join(APP_DIR_NAME).join(CONFIG_FILE_NAME);
-        }
-        let home = std::env::var_os("HOME").filter(|v| !v.is_empty());
-        if let Some(home) = home {
-            return PathBuf::from(home)
-                .join(".config")
-                .join(APP_DIR_NAME)
-                .join(CONFIG_FILE_NAME);
-        }
-    }
-    PathBuf::from(APP_DIR_NAME).join(CONFIG_FILE_NAME)
-}
-
-/// Windows 默认数据目录
-#[cfg(windows)]
-pub fn default_data_dir() -> PathBuf {
-    let local = std::env::var_os("LOCALAPPDATA").filter(|v| !v.is_empty());
-    if let Some(local) = local {
-        return PathBuf::from(local).join(APP_DIR_NAME).join(DATA_DIR_NAME);
-    }
-    let roaming = std::env::var_os("APPDATA").filter(|v| !v.is_empty());
-    if let Some(roaming) = roaming {
-        return PathBuf::from(roaming).join(APP_DIR_NAME).join(DATA_DIR_NAME);
-    }
-    PathBuf::from(APP_DIR_NAME).join(DATA_DIR_NAME)
-}
-
-/// Unix 默认数据目录（XDG 惯例）
-#[cfg(not(windows))]
-pub fn default_data_dir() -> PathBuf {
-    let xdg = std::env::var_os("XDG_DATA_HOME").filter(|v| !v.is_empty());
-    if let Some(xdg) = xdg {
-        return PathBuf::from(xdg)
-            .join(UNIX_APP_DIR_NAME)
-            .join(DATA_DIR_NAME);
-    }
-    let home = std::env::var_os("HOME").filter(|v| !v.is_empty());
-    if let Some(home) = home {
-        return PathBuf::from(home)
-            .join(".local")
-            .join("share")
-            .join(UNIX_APP_DIR_NAME)
-            .join(DATA_DIR_NAME);
-    }
-    PathBuf::from(UNIX_APP_DIR_NAME).join(DATA_DIR_NAME)
-}
-
-#[derive(Debug, Clone, PartialEq, Eq)]
-pub struct Config {
-    pub page_size: usize,
-    pub btree_order: usize,
-    pub pool_size: usize,
-    pub data_dir: PathBuf,
-    pub log_files: PathBuf,
-    pub log_level: Level,
-}
-
-impl Default for Config {
-    /// 内置默认配置
-    fn default() -> Self {
-        Config {
-            page_size: DEFAULT_PAGE_SIZE,
-            btree_order: DEFAULT_BTREE_ORDER,
-            pool_size: DEFAULT_POOL_SIZE,
-            data_dir: default_data_dir(),
-            log_files: PathBuf::from(DEFAULT_LOG_FILES),
-            log_level: Level::Info,
-        }
-    }
-}
-
-#[derive(Debug, Clone, PartialEq, Eq)]
-pub enum Origin {
-    Default,
-    File(PathBuf),
-}
-
-impl Origin {
-    /// 来源的文案
-    pub fn describe(&self) -> String {
-        match self {
-            Origin::Default => "default".to_string(),
-            Origin::File(p) => format!("file {}", p.display()),
-        }
-    }
-}
-
-#[derive(Debug, Clone)]
-pub struct Loaded {
-    pub config: Config,
-    pub config_path: Option<PathBuf>,
-    pub origins: Vec<(&'static str, String, Origin)>,
-}
-
-#[derive(Debug, Default, Deserialize)]
-struct FileConfig {
-    page: Option<FilePage>,
-    btree: Option<FileBtree>,
-    buffer: Option<FileBuffer>,
-    storage: Option<FileStorage>,
-    log: Option<FileLog>,
-}
-
-#[derive(Debug, Default, Deserialize)]
-#[serde(deny_unknown_fields)]
-struct FileBuffer {
-    pool_size: Option<usize>,
-}
-
-#[derive(Debug, Default, Deserialize)]
-#[serde(deny_unknown_fields)]
-struct FilePage {
-    size: Option<usize>,
-}
-
-#[derive(Debug, Default, Deserialize)]
-#[serde(deny_unknown_fields)]
-struct FileBtree {
-    order: Option<usize>,
-}
-
-#[derive(Debug, Default, Deserialize)]
-#[serde(deny_unknown_fields)]
-struct FileStorage {
-    data_dir: Option<String>,
-    log_files: Option<String>,
-}
-
-#[derive(Debug, Default, Deserialize)]
-#[serde(deny_unknown_fields)]
-struct FileLog {
-    level: Option<String>,
-}
-
-/// 加载配置：显式路径优先，其次默认位置
-pub fn load(explicit: Option<&str>) -> Result<Loaded, String> {
-    let explicit = explicit.map(str::trim).filter(|p| !p.is_empty());
-    let path = match explicit {
-        Some(p) => {
-            let p = PathBuf::from(p);
-            if !p.is_file() {
-                return Err(format!("config file not found: {}", p.display()));
-            }
-            Some(p)
-        }
-        None => {
-            let p = default_config_path();
-            if p.is_file() { Some(p) } else { None }
-        }
-    };
-    let text = match &path {
-        Some(p) => Some(
-            std::fs::read_to_string(p)
-                .map_err(|e| format!("cannot read config file {}: {}", p.display(), e))?,
-        ),
-        None => None,
-    };
-    resolve(text.as_deref(), path)
-}
-
-/// 解析文本：文件 -> 默认
-pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, String> {
-    let file: FileConfig = match text {
-        None => FileConfig::default(),
-        Some(t) => toml::from_str(t).map_err(|e| match &path {
-            Some(p) => format!("bad config file {}: {}", p.display(), e),
-            None => format!("bad config: {}", e),
-        })?,
-    };
-
-    let file_origin = Origin::File(
-        path.clone().unwrap_or_else(default_config_path),
-    );
-
-    let (page_size, page_origin) = pick(
-        file.page.and_then(|p| p.size),
-        DEFAULT_PAGE_SIZE,
-        &file_origin,
-    );
-    let (btree_order, order_origin) = pick(
-        file.btree.and_then(|b| b.order),
-        DEFAULT_BTREE_ORDER,
-        &file_origin,
-    );
-    let (pool_size, pool_origin) = pick(
-        file.buffer.and_then(|b| b.pool_size),
-        DEFAULT_POOL_SIZE,
-        &file_origin,
-    );
-    let storage = file.storage.unwrap_or_default();
-    let (data_dir, dir_origin) = pick(
-        storage.data_dir,
-        default_data_dir().to_string_lossy().into_owned(),
-        &file_origin,
-    );
-    let (log_files, log_files_origin) = pick(
-        storage.log_files,
-        DEFAULT_LOG_FILES.to_string(),
-        &file_origin,
-    );
-    let (log_level, log_origin) = pick(
-        file.log.and_then(|l| l.level),
-        DEFAULT_LOG_LEVEL.to_string(),
-        &file_origin,
-    );
-
-    let data_dir = data_dir.trim().to_string();
-    let log_files = log_files.trim().to_string();
-    let log_level = log_level.trim();
-
-    let log_level = Level::parse(log_level)
-        .ok_or_else(|| format!("log.level is not one of off/error/warn/info/debug: {}", log_level))?;
-
-    if data_dir.is_empty() {
-        return Err("storage.data_dir must not be empty".to_string());
-    }
-    if log_files.is_empty() {
-        return Err("storage.log_files must not be empty".to_string());
-    }
-    validate_layout(page_size, btree_order)?;
-    if pool_size == 0 {
-        return Err("buffer.pool_size must be at least 1".to_string());
-    }
-    let origins = vec![
-        ("page.size", page_size.to_string(), page_origin),
-        ("btree.order", btree_order.to_string(), order_origin),
-        ("buffer.pool_size", pool_size.to_string(), pool_origin),
-        ("storage.data_dir", data_dir.clone(), dir_origin),
-        ("storage.log_files", log_files.clone(), log_files_origin),
-        ("log.level", log_level.name().to_string(), log_origin),
-    ];
-
-    Ok(Loaded {
-        config: Config {
-            page_size,
-            btree_order,
-            pool_size,
-            data_dir: PathBuf::from(data_dir),
-            log_files: PathBuf::from(log_files),
-            log_level,
-        },
-        config_path: if text.is_some() { path } else { None },
-        origins,
-    })
-}
-
-/// 取一项：文件 -> 默认
-fn pick<T>(file_value: Option<T>, default: T, file_origin: &Origin) -> (T, Origin) {
-    if let Some(value) = file_value {
-        return (value, file_origin.clone());
-    }
-    (default, Origin::Default)
-}
-
-/// 检查选项是否自洽
-fn validate_layout(page_size: usize, btree_order: usize) -> Result<(), String> {
-    if !(MIN_PAGE_SIZE..=MAX_PAGE_SIZE).contains(&page_size) || !page_size.is_power_of_two() {
-        return Err(format!(
-            "page.size must be a power of two between {} and {}, got {}",
-            MIN_PAGE_SIZE, MAX_PAGE_SIZE, page_size
-        ));
-    }
-    if btree_order < MIN_BTREE_ORDER {
-        return Err(format!(
-            "btree.order must be at least {}, got {}",
-            MIN_BTREE_ORDER, btree_order
-        ));
-    }
-    if !crate::btree::fits_in_page(page_size, btree_order) {
-        return Err(format!(
-            "btree.order {} does not fit in a {}-byte page (max {})",
-            btree_order,
-            page_size,
-            crate::btree::max_order(page_size)
-        ));
-    }
-    Ok(())
-}

chusql-core/storage/src/ffi.rs

@@ -1,183 +0,0 @@
-use std::cell::RefCell;
-use std::ffi::{c_char, CStr};
-use std::panic::{catch_unwind, AssertUnwindSafe};
-use std::ptr;
-use std::slice;
-
-use crate::runtime::Storage;
-
-// C ABI：Haskell 侧唯一存储入口，请求与响应都是 UTF-8 JSON。
-// 不 panic 穿过边界，失败走线程局部 last_error。
-
-const OK: i32 = 0;
-const ERR: i32 = -1;
-
-thread_local! {
-    static LAST_ERROR: RefCell<Vec<u8>> = const { RefCell::new(Vec::new()) };
-}
-
-/// 记下本线程最近的失败信息
-fn set_error(message: impl AsRef<str>) {
-    let text = message.as_ref().as_bytes().to_vec();
-    LAST_ERROR.with(|slot| *slot.borrow_mut() = text);
-}
-
-/// 版本号字符串（静态常量，调用方不要释放）。
-#[unsafe(no_mangle)]
-pub extern "C" fn chusql_storage_version() -> *const c_char {
-    const VERSION: &str = concat!(env!("CARGO_PKG_VERSION"), "\0");
-    VERSION.as_ptr() as *const c_char
-}
-
-/// 打开数据目录；失败返回 NULL
-///
-/// # Safety
-/// `config_path` 要么是 NULL，要么指向以 NUL 结尾的有效字符串。
-#[unsafe(no_mangle)]
-pub unsafe extern "C" fn chusql_storage_open(config_path: *const c_char) -> *mut Storage {
-    let opened = catch_unwind(AssertUnwindSafe(|| {
-        let path = if config_path.is_null() {
-            None
-        } else {
-            let text = unsafe { CStr::from_ptr(config_path) }
-                .to_str()
-                .map_err(|_| "config path is not valid UTF-8".to_string())?;
-            if text.is_empty() { None } else { Some(text.to_string()) }
-        };
-        Storage::open(path.as_deref()).map(Box::new)
-    }));
-    match opened {
-        Ok(Ok(storage)) => Box::into_raw(storage),
-        Ok(Err(e)) => {
-            set_error(e);
-            ptr::null_mut()
-        }
-        Err(_) => {
-            set_error("panic in chusql_storage_open");
-            ptr::null_mut()
-        }
-    }
-}
-
-/// 关闭句柄（NULL 安全）
-///
-/// # Safety
-/// `handle` 必须是 chusql_storage_open 返回且未被关闭过的句柄。
-#[unsafe(no_mangle)]
-pub unsafe extern "C" fn chusql_storage_close(handle: *mut Storage) {
-    if handle.is_null() {
-        return;
-    }
-    let _ = catch_unwind(AssertUnwindSafe(|| unsafe { drop(Box::from_raw(handle)) }));
-}
-
-/// 离线维护系统目录并返回 JSON
-///
-/// # Safety
-/// `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 !out.is_null() { unsafe { *out = ptr::null_mut(); } }
-    if !out_len.is_null() { unsafe { *out_len = 0; } }
-    if request.is_null() || out.is_null() || out_len.is_null() || request_len > isize::MAX as usize {
-        set_error("invalid maintenance argument");
-        return ERR;
-    }
-    let result = catch_unwind(AssertUnwindSafe(|| {
-        let path = if config_path.is_null() { None } else { Some(unsafe { CStr::from_ptr(config_path) }.to_str().map_err(|e| e.to_string())?) };
-        let text = std::str::from_utf8(unsafe { slice::from_raw_parts(request, request_len) }).map_err(|e| e.to_string())?;
-        Storage::maintenance(path, text)
-    }));
-    let response = match result {
-        Ok(Ok(response)) => response,
-        Ok(Err(err)) => { set_error(err); return ERR; }
-        Err(_) => { set_error("panic in system maintenance"); return ERR; }
-    };
-    let buffer = response.into_bytes().into_boxed_slice();
-    unsafe { *out_len = buffer.len(); *out = Box::into_raw(buffer) as *mut u8; }
-    OK
-}
-
-/// 处理一条请求，响应缓冲须归还
-///
-/// # Safety
-/// `handle` 在调用期间有效且不能并发关闭；请求字节在调用期间有效。
-/// `out`/`out_len` 可写且不与输入重叠；响应使用 free 释放。
-#[unsafe(no_mangle)]
-pub unsafe extern "C" fn chusql_storage_request(
-    handle: *const Storage,
-    request: *const u8,
-    request_len: usize,
-    out: *mut *mut u8,
-    out_len: *mut usize,
-) -> i32 {
-    if !out.is_null() {
-        unsafe { *out = ptr::null_mut() };
-    }
-    if !out_len.is_null() {
-        unsafe { *out_len = 0 };
-    }
-    if 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;
-    }
-
-    let storage = unsafe { &*handle };
-    let bytes = unsafe { slice::from_raw_parts(request, request_len) };
-    let text = match std::str::from_utf8(bytes) {
-        Ok(text) => text,
-        Err(e) => {
-            set_error(format!("request is not valid UTF-8: {}", e));
-            return ERR;
-        }
-    };
-
-    let response = match catch_unwind(AssertUnwindSafe(|| storage.request_line(text))) {
-        Ok(response) => response,
-        Err(_) => {
-            set_error("panic in chusql_storage_request");
-            return ERR;
-        }
-    };
-
-    let buffer = response.into_bytes().into_boxed_slice();
-    unsafe {
-        *out_len = buffer.len();
-        *out = Box::into_raw(buffer) as *mut u8;
-    }
-    OK
-}
-
-/// 归还响应缓冲
-///
-/// # Safety
-/// `data`/`len` 为 request 或 maintenance 原样返回且未释放的一对值。
-#[unsafe(no_mangle)]
-pub unsafe extern "C" fn chusql_storage_free(data: *mut u8, len: usize) {
-    if data.is_null() {
-        return;
-    }
-    let _ = catch_unwind(AssertUnwindSafe(|| unsafe {
-        let slice = ptr::slice_from_raw_parts_mut(data, len);
-        let _owned: Box<[u8]> = Box::from_raw(slice);
-    }));
-}
-
-/// 取本线程最近的失败信息
-///
-/// # Safety
-/// `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| {
-        let bytes = slot.borrow();
-        if !out_len.is_null() {
-            unsafe { *out_len = bytes.len() };
-        }
-        if bytes.is_empty() { ptr::null() } else { bytes.as_ptr() }
-    })
-}

chusql-core/storage/src/heap.rs

@@ -1,777 +0,0 @@
-use std::collections::HashSet;
-use std::io;
-use std::path::Path;
-use serde::de::{IgnoredAny, MapAccess, Visitor};
-use serde::Deserializer;
-
-use crate::btree::DiskBTree;
-use crate::page::PageId;
-use crate::page::{Page, PageFile};
-use crate::protocol::Row;
-
-// 堆表：行按插入顺序进页，支持全表扫描、按索引取行、行级删除。
-
-const HEADER_SIZE: usize = 2;
-const SLOT_SIZE: usize = 8;
-const SLOT_DIR_START: usize = HEADER_SIZE;
-
-/// 未选字段只校验并跳过，不分配值。
-fn decode_row(bytes: &[u8], columns: Option<&[String]>, hidden: &HashSet<String>) -> io::Result<Row> {
-    struct RowVisitor<'a>(Option<&'a [String]>, &'a HashSet<String>);
-    impl<'de> Visitor<'de> for RowVisitor<'_> {
-        type Value = Row;
-        /// 说明期望的输入形态
-        fn expecting(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
-            f.write_str("a row object")
-        }
-        /// 逐字段解出一行
-        fn visit_map<M: MapAccess<'de>>(self, mut map: M) -> Result<Row, M::Error> {
-            let mut row = Row::new();
-            while let Some(key) = map.next_key::<String>()? {
-                if !self.1.contains(&key) && self.0.is_none_or(|cols| cols.contains(&key)) {
-                    row.insert(key, map.next_value()?);
-                } else {
-                    map.next_value::<IgnoredAny>()?;
-                }
-            }
-            Ok(row)
-        }
-    }
-    let mut decoder = serde_json::Deserializer::from_slice(bytes);
-    let row = decoder.deserialize_map(RowVisitor(columns, hidden)).map_err(io::Error::other)?;
-    decoder.end().map_err(io::Error::other)?;
-    Ok(row)
-}
-
-/// 读一个小端 u16
-fn read_u16(buf: &[u8], off: usize) -> u16 {
-    u16::from_le_bytes([buf[off], buf[off + 1]])
-}
-
-/// 写一个小端 u16
-fn write_u16(buf: &mut [u8], off: usize, v: u16) {
-    buf[off..off + 2].copy_from_slice(&v.to_le_bytes());
-}
-
-/// 读一个小端 u32
-fn read_u32(buf: &[u8], off: usize) -> u32 {
-    u32::from_le_bytes([buf[off], buf[off + 1], buf[off + 2], buf[off + 3]])
-}
-
-/// 写一个小端 u32
-fn write_u32(buf: &mut [u8], off: usize, v: u32) {
-    buf[off..off + 4].copy_from_slice(&v.to_le_bytes());
-}
-
-/// (页号, 槽位号) 打包成 u64
-fn pack_position(page_id: PageId, slot: u16) -> u64 {
-    (page_id << 16) | (slot as u64)
-}
-
-/// 从 u64 解回 (页号, 槽位号)
-fn unpack_position(v: u64) -> (PageId, u16) {
-    (v >> 16, (v & 0xFFFF) as u16)
-}
-
-/// 数值里取整数，整值浮点折成整数
-pub(crate) fn scalar_int(v: &serde_json::Value) -> Option<i64> {
-    match v {
-        serde_json::Value::Number(n) => n.as_i64().or_else(|| {
-            let f = n.as_f64()?;
-            if f.fract() != 0.0 || f.abs() > 9_007_199_254_740_992.0 {
-                return None;
-            }
-            Some(f as i64)
-        }),
-        _ => None,
-    }
-}
-
-/// 取行里某一列的整数值（不是整数就没有）
-fn row_int(row: &Row, column: &str) -> Option<i64> {
-    row.get(column).and_then(scalar_int)
-}
-
-/// i64 键 → 8 字节大端（保序，负数也在前）
-fn key_of(value: i64) -> [u8; 8] {
-    (value as u64 ^ (1u64 << 63)).to_be_bytes()
-}
-
-/// JSON 值 → 索引键字节（与写索引时同一套编码）
-fn value_key(v: &serde_json::Value) -> Option<Vec<u8>> {
-    match v {
-        serde_json::Value::Number(_) => scalar_int(v).map(|k| key_of(k).to_vec()),
-        serde_json::Value::String(s) => Some(s.as_bytes().to_vec()),
-        serde_json::Value::Bool(b) => Some(vec![u8::from(*b)]),
-        _ => None,
-    }
-}
-
-/// 取行里某一列的索引键；NULL 与缺列不入索引
-fn row_key(row: &Row, column: &str) -> Option<Vec<u8>> {
-    row.get(column).and_then(value_key)
-}
-
-pub struct HeapPage;
-
-impl HeapPage {
-    /// 这一页有几个槽位
-    pub fn slot_count(page: &Page) -> u16 {
-        read_u16(&page.data, 0)
-    }
-
-    /// 改写槽位数量
-    fn set_slot_count(page: &mut Page, v: u16) {
-        write_u16(&mut page.data, 0, v);
-    }
-
-    /// 空闲空间下界
-    fn free_start(page: &Page) -> usize {
-        SLOT_DIR_START + (Self::slot_count(page) as usize) * SLOT_SIZE
-    }
-
-    /// 空闲空间上界
-    fn free_end(page: &Page) -> usize {
-        let n = Self::slot_count(page);
-        let mut min_off = page.data.len() as u32;
-        for i in 0..n as usize {
-            let slot_off = SLOT_DIR_START + i * SLOT_SIZE;
-            let off = read_u32(&page.data, slot_off);
-            let len = read_u32(&page.data, slot_off + 4);
-            if len > 0 && off < min_off {
-                min_off = off;
-            }
-        }
-        min_off as usize
-    }
-
-    /// 试插一行，放不下返回 None
-    pub fn insert_tuple(page: &mut Page, tuple: &[u8]) -> Option<u16> {
-        let n = Self::slot_count(page);
-        let free_start = Self::free_start(page);
-        let free_end = Self::free_end(page);
-
-        if free_start + SLOT_SIZE + tuple.len() > free_end {
-            return None;
-        }
-
-        let tuple_off = free_end - tuple.len();
-        page.data[tuple_off..tuple_off + tuple.len()].copy_from_slice(tuple);
-
-        let slot_off = SLOT_DIR_START + (n as usize) * SLOT_SIZE;
-        write_u32(&mut page.data, slot_off, tuple_off as u32);
-        write_u32(&mut page.data, slot_off + 4, tuple.len() as u32);
-        Self::set_slot_count(page, n + 1);
-
-        Some(n)
-    }
-
-    /// 删掉一个槽位，只把长度置 0
-    pub fn delete_tuple(page: &mut Page, slot: u16) -> bool {
-        let n = Self::slot_count(page);
-        if slot >= n {
-            return false;
-        }
-        let slot_off = SLOT_DIR_START + (slot as usize) * SLOT_SIZE;
-        if read_u32(&page.data, slot_off + 4) == 0 {
-            return false;
-        }
-        write_u32(&mut page.data, slot_off + 4, 0);
-        true
-    }
-
-    /// 读槽位里的行字节
-    pub fn get_tuple(page: &Page, slot: u16) -> Option<Vec<u8>> {
-        Self::tuple_bytes(page, slot).map(<[u8]>::to_vec)
-    }
-
-    /// 借用槽位里的行字节
-    fn tuple_bytes(page: &Page, slot: u16) -> Option<&[u8]> {
-        let n = Self::slot_count(page);
-        if slot >= n {
-            return None;
-        }
-        let slot_off = SLOT_DIR_START + (slot as usize) * SLOT_SIZE;
-        let off = read_u32(&page.data, slot_off) as usize;
-        let len = read_u32(&page.data, slot_off + 4) as usize;
-        if len == 0 {
-            return None;
-        }
-        Some(&page.data[off..off + len])
-    }
-
-    /// 所有槽位号
-    pub fn iter_slots(page: &Page) -> Vec<u16> {
-        (0..Self::slot_count(page)).collect()
-    }
-
-    /// 页内死空间字节数：行区里除活行以外的部分
-    pub fn dead_bytes(page: &Page) -> usize {
-        let n = Self::slot_count(page);
-        let mut live = 0;
-        for i in 0..n as usize {
-            let slot_off = SLOT_DIR_START + i * SLOT_SIZE;
-            live += read_u32(&page.data, slot_off + 4) as usize;
-        }
-        (page.data.len() - Self::free_end(page)).saturating_sub(live)
-    }
-
-    /// 页内整理：活行挪到页尾，槽位号不动，返回回收字节数
-    pub fn compact_page(page: &mut Page) -> usize {
-        let reclaimed = Self::dead_bytes(page);
-        if reclaimed == 0 {
-            return 0;
-        }
-
-        let n = Self::slot_count(page);
-        let mut live: Vec<(usize, Vec<u8>)> = Vec::new();
-        for i in 0..n as usize {
-            let slot_off = SLOT_DIR_START + i * SLOT_SIZE;
-            let off = read_u32(&page.data, slot_off) as usize;
-            let len = read_u32(&page.data, slot_off + 4) as usize;
-            if len > 0 {
-                live.push((i, page.data[off..off + len].to_vec()));
-            } else {
-                write_u32(&mut page.data, slot_off, 0);
-            }
-        }
-
-        let mut end = page.data.len();
-        for (i, bytes) in live {
-            end -= bytes.len();
-            page.data[end..end + bytes.len()].copy_from_slice(&bytes);
-            write_u32(&mut page.data, SLOT_DIR_START + i * SLOT_SIZE, end as u32);
-        }
-        reclaimed
-    }
-
-    /// 死空间超过四分之一就整理这一页
-    pub fn compact_if_fragmented(page: &mut Page) -> usize {
-        if Self::dead_bytes(page) * 4 >= page.data.len() {
-            Self::compact_page(page)
-        } else {
-            0
-        }
-    }
-}
-
-struct NamedIndex {
-    column: String,
-    tree: DiskBTree,
-}
-
-pub struct HeapTable {
-    hidden_columns: HashSet<String>,
-    file: PageFile,
-    indexes: Vec<NamedIndex>,
-}
-
-impl HeapTable {
-    /// 打开表（不带索引）
-    pub fn open<P: AsRef<Path>>(path: P, page_size: usize, pool_size: usize) -> io::Result<Self> {
-        Ok(HeapTable {
-            hidden_columns: HashSet::new(),
-            file: PageFile::with_options(path, page_size, pool_size)?,
-            indexes: Vec::new(),
-        })
-    }
-
-    /// 打开表并挂上 id 列索引
-    pub fn open_indexed<P: AsRef<Path>, Q: AsRef<Path>>(
-        path: P,
-        index_path: Q,
-        page_size: usize,
-        btree_order: usize,
-        pool_size: usize,
-    ) -> io::Result<Self> {
-        Self::open_with_indexes(
-            path,
-            &[("id".to_string(), index_path.as_ref().to_path_buf())],
-            page_size,
-            btree_order,
-            pool_size,
-        )
-    }
-
-    /// 打开表并挂上多组索引
-    pub fn open_with_indexes<P: AsRef<Path>>(
-        path: P,
-        indexes: &[(String, std::path::PathBuf)],
-        page_size: usize,
-        btree_order: usize,
-        pool_size: usize,
-    ) -> io::Result<Self> {
-        let mut t = HeapTable {
-            hidden_columns: HashSet::new(),
-            file: PageFile::with_options(path, page_size, pool_size)?,
-            indexes: Vec::new(),
-        };
-        let mut filled = false;
-        for (col, p) in indexes {
-            match t.attach_index(col, p, page_size, btree_order, pool_size) {
-                Ok(()) => {}
-                Err(err) if err.kind() == io::ErrorKind::InvalidData => {
-                    // 格式不兼容（例如上一版落的索引文件）：删掉重开
-                    let _ = std::fs::remove_file(p);
-                    t.attach_index(col, p, page_size, btree_order, pool_size)?;
-                }
-                Err(err) => return Err(err),
-            }
-            // 空索引（新文件、被截断、强杀留下）都按堆数据补齐
-            if t.index_empty(col)? {
-                t.fill_index(col)?;
-                filled = true;
-            }
-        }
-        if filled {
-            t.flush()?;
-        }
-        Ok(t)
-    }
-
-    /// 挂上一棵索引树，不填数据
-    fn attach_index<P: AsRef<Path>>(
-        &mut self,
-        column: &str,
-        path: P,
-        page_size: usize,
-        btree_order: usize,
-        pool_size: usize,
-    ) -> io::Result<()> {
-        let tree = DiskBTree::open(path, page_size, btree_order, pool_size)?;
-        self.indexes.push(NamedIndex {
-            column: column.to_string(),
-            tree,
-        });
-        Ok(())
-    }
-
-    /// 这一列有索引吗
-    pub fn has_index(&self, column: &str) -> bool {
-        self.indexes.iter().any(|i| i.column == column)
-    }
-
-    /// 建索引：id 列必须唯一，其余列可重复
-    pub fn build_index(
-        &mut self,
-        column: &str,
-        path: &Path,
-        page_size: usize,
-        btree_order: usize,
-        pool_size: usize,
-    ) -> io::Result<()> {
-        if self.has_index(column) {
-            return Err(io::Error::new(
-                io::ErrorKind::AlreadyExists,
-                format!("index on column \"{}\" already exists", column),
-            ));
-        }
-
-        let mut seen: HashSet<Vec<u8>> = HashSet::new();
-        let mut entries: Vec<(Vec<u8>, u64)> = Vec::new();
-        for (page_id, slot, r) in self.scan_with_positions()? {
-            let Some(k) = row_key(&r, column) else {
-                continue;
-            };
-            // 行身份索引仍然唯一；其余列允许重复值
-            if column == "id" && !seen.insert(k.clone()) {
-                return Err(io::Error::new(
-                    io::ErrorKind::InvalidInput,
-                    format!("column \"{}\" has duplicate values", column),
-                ));
-            }
-            entries.push((k, pack_position(page_id, slot)));
-        }
-
-        self.attach_index(column, path, page_size, btree_order, pool_size)?;
-        let i = self.indexes.len() - 1;
-        self.indexes[i].tree.clear()?;
-        for (k, pos) in entries {
-            self.indexes[i].tree.insert(&k, pos)?;
-        }
-        Ok(())
-    }
-
-    /// 这一列的索引是空的吗
-    fn index_empty(&mut self, column: &str) -> io::Result<bool> {
-        match self.indexes.iter_mut().find(|i| i.column == column) {
-            Some(idx) => idx.tree.is_empty(),
-            None => Ok(false),
-        }
-    }
-
-    /// 按堆里的行把某一列索引补齐
-    fn fill_index(&mut self, column: &str) -> io::Result<()> {
-        let rows = self.scan_with_positions()?;
-        let Some(i) = self.indexes.iter().position(|idx| idx.column == column) else {
-            return Ok(());
-        };
-        for (page_id, slot, row) in rows {
-            if let Some(k) = row_key(&row, column) {
-                self.indexes[i]
-                    .tree
-                    .insert(&k, pack_position(page_id, slot))?;
-            }
-        }
-        Ok(())
-    }
-
-    /// 摘掉一个索引（不删文件）
-    pub fn detach_index(&mut self, column: &str) -> bool {
-        match self.indexes.iter().position(|i| i.column == column) {
-            None => false,
-            Some(i) => {
-                self.indexes.remove(i);
-                true
-            }
-        }
-    }
-
-    /// 设置隐藏列集合
-    pub fn set_hidden_columns(&mut self, columns: HashSet<String>) {
-        self.hidden_columns = columns;
-    }
-
-    /// 隐藏一列并摘掉它的索引
-    pub fn hide_column(&mut self, column: &str) {
-        self.detach_index(column);
-        self.hidden_columns.insert(column.to_string());
-    }
-
-    /// 插入一行，并顺手写各索引
-    pub fn insert_row(&mut self, row: &Row) -> io::Result<()> {
-        self.insert_row_returning_position(row).map(|_| ())
-    }
-
-    /// 插入一行并返回它的位置
-    pub fn insert_row_returning_position(&mut self, row: &Row) -> io::Result<(PageId, u16)> {
-        let mut pending: Vec<(usize, Vec<u8>)> = Vec::new();
-        for (i, idx) in self.indexes.iter_mut().enumerate() {
-            let Some(k) = row_key(row, &idx.column) else {
-                continue;
-            };
-            if idx.column == "id" && idx.tree.get(&k)?.is_some() {
-                return Err(io::Error::new(
-                    io::ErrorKind::InvalidInput,
-                    "duplicate value on the id index".to_string(),
-                ));
-            }
-            pending.push((i, k));
-        }
-
-        let (page_id, slot) = self.insert_returning_position(row)?;
-        let pos = pack_position(page_id, slot);
-        for (i, k) in pending {
-            self.indexes[i].tree.insert(&k, pos)?;
-        }
-        Ok((page_id, slot))
-    }
-
-    /// 批量插入，落盘由调用方负责
-    pub fn insert_rows(&mut self, rows: &[Row]) -> io::Result<()> {
-        for r in rows {
-            self.insert_row(r)?;
-        }
-        Ok(())
-    }
-
-    /// 编码并验证一行能放进页
-    pub fn encode_row(row: &Row, page_size: usize) -> io::Result<Vec<u8>> {
-        let tuple = serde_json::to_vec(row).map_err(io::Error::other)?;
-
-        if HEADER_SIZE + SLOT_SIZE + tuple.len() > page_size {
-            return Err(io::Error::other(format!(
-                "tuple too large: {} bytes",
-                tuple.len()
-            )));
-        }
-        Ok(tuple)
-    }
-
-    /// 插入一行，只进堆表、不碰索引
-    fn insert_returning_position(&mut self, row: &Row) -> io::Result<(PageId, u16)> {
-        let tuple = Self::encode_row(row, self.file.page_size())?;
-        let n = self.file.num_pages()?;
-        if n > 0 {
-            let last_id = n - 1;
-            let mut slot = None;
-            self.file.update_page(last_id, |p| {
-                HeapPage::compact_page(p);
-                slot = HeapPage::insert_tuple(p, &tuple);
-            })?;
-            if let Some(s) = slot {
-                return Ok((last_id, s));
-            }
-        }
-
-        let mut p = self.file.append_page()?;
-        let page_id = p.id;
-        let slot = HeapPage::insert_tuple(&mut p, &tuple).expect("pre-checked fits");
-        self.file.write_page(&p)?;
-        Ok((page_id, slot))
-    }
-
-    /// 按 `id` 取一行
-    pub fn get_by_key(&mut self, key: i64) -> io::Result<Option<Row>> {
-        self.get_by_column_key("id", key)
-    }
-
-    /// 按某一列的整数索引取一行
-    pub fn get_by_column_key(&mut self, column: &str, key: i64) -> io::Result<Option<Row>> {
-        self.get_by_bytes(column, &key_of(key))
-    }
-
-    /// 按某一列的字符串索引取一行
-    pub fn get_by_string_key(&mut self, column: &str, key: &str) -> io::Result<Option<Row>> {
-        self.get_by_bytes(column, key.as_bytes())
-    }
-
-    /// 按某一列的整数索引取全部行
-    pub fn get_all_by_column_key(&mut self, column: &str, key: i64) -> io::Result<Vec<Row>> {
-        self.get_all_by_bytes(column, &key_of(key))
-    }
-
-    /// 按某一列的字符串索引取全部行
-    pub fn get_all_by_string_key(&mut self, column: &str, key: &str) -> io::Result<Vec<Row>> {
-        self.get_all_by_bytes(column, key.as_bytes())
-    }
-
-    /// 按索引键的字节取第一行
-    fn get_by_bytes(&mut self, column: &str, key: &[u8]) -> io::Result<Option<Row>> {
-        Ok(self.get_all_by_bytes(column, key)?.into_iter().next())
-    }
-
-    /// 按索引键的字节取全部行（重复值都给出来）
-    fn get_all_by_bytes(&mut self, column: &str, key: &[u8]) -> io::Result<Vec<Row>> {
-        let Some(idx) = self.indexes.iter_mut().find(|i| i.column == column) else {
-            return Ok(Vec::new());
-        };
-        let positions = idx.tree.get_all(key)?;
-        let mut rows = Vec::new();
-        for pos in positions {
-            let (page_id, slot) = unpack_position(pos);
-            if let Some(row) = self.read_at(page_id, slot)? {
-                rows.push(row);
-            }
-        }
-        Ok(rows)
-    }
-
-    /// 按索引做范围扫描；没索引返回 None
-    pub fn scan_range(
-        &mut self,
-        column: &str,
-        lo: Option<(&serde_json::Value, bool)>,
-        hi: Option<(&serde_json::Value, bool)>,
-    ) -> io::Result<Option<Vec<Row>>> {
-        let Some(i) = self.indexes.iter().position(|idx| idx.column == column) else {
-            return Ok(None);
-        };
-        let lo_bound = lo.and_then(|(v, inclusive)| value_key(v).map(|k| (k, inclusive)));
-        let hi_bound = hi.and_then(|(v, inclusive)| value_key(v).map(|k| (k, inclusive)));
-        // 树按闭区间取，排他端在取回来之后再筛
-        let pairs = self.indexes[i].tree.scan(
-            lo_bound.as_ref().map(|(k, _)| k.as_slice()),
-            hi_bound.as_ref().map(|(k, _)| k.as_slice()),
-        )?;
-        let mut rows = Vec::new();
-        for (key, pos) in pairs {
-            if let Some((bound, inclusive)) = &lo_bound {
-                let outside = if *inclusive { &key < bound } else { &key <= bound };
-                if outside {
-                    continue;
-                }
-            }
-            if let Some((bound, inclusive)) = &hi_bound {
-                let outside = if *inclusive { &key > bound } else { &key >= bound };
-                if outside {
-                    continue;
-                }
-            }
-            let (page_id, slot) = unpack_position(pos);
-            if let Some(row) = self.read_at(page_id, slot)? {
-                rows.push(row);
-            }
-        }
-        Ok(Some(rows))
-    }
-
-    /// 按位置读一行
-    pub fn read_at(&mut self, page_id: PageId, slot: u16) -> io::Result<Option<Row>> {
-        let hidden = &self.hidden_columns;
-        self.file.with_page(page_id, |p| {
-            HeapPage::tuple_bytes(p, slot)
-                .map(|bytes| decode_row(bytes, None, hidden))
-                .transpose()
-        })?
-    }
-
-    /// 按位置删一行并返回它
-    pub fn delete_at(&mut self, page_id: PageId, slot: u16) -> io::Result<Option<Row>> {
-        let row = self.read_at(page_id, slot)?;
-        let existed = self.file.update_page(page_id, |p| {
-            let ok = HeapPage::delete_tuple(p, slot);
-            if ok {
-                HeapPage::compact_if_fragmented(p);
-            }
-            ok
-        })?;
-        if !existed {
-            return Ok(None);
-        }
-        if let Some(r) = &row {
-            let pos = pack_position(page_id, slot);
-            for idx in &mut self.indexes {
-                if let Some(k) = row_key(r, &idx.column) {
-                    idx.tree.delete(&k, pos)?;
-                }
-            }
-        }
-        Ok(row)
-    }
-
-    /// 按 id 批量删行，返回删掉的行
-    pub fn delete_by_keys(&mut self, keys: &[i64]) -> io::Result<Vec<Row>> {
-        let mut positions: Vec<(PageId, u16)> = Vec::new();
-
-        if let Some(idx) = self.indexes.iter_mut().find(|i| i.column == "id") {
-            for &k in keys {
-                let pos = idx.tree.get(&key_of(k))?;
-                if let Some(p) = pos {
-                    positions.push(unpack_position(p));
-                }
-            }
-        } else {
-            let mut wanted: Vec<i64> = keys.to_vec();
-            wanted.sort_unstable();
-            for (page_id, slot, r) in self.scan_with_positions()? {
-                if row_int(&r, "id").is_some_and(|k| wanted.binary_search(&k).is_ok()) {
-                    positions.push((page_id, slot));
-                }
-            }
-        }
-
-        let mut deleted: Vec<Row> = Vec::new();
-        for (page_id, slot) in positions {
-            if let Some(r) = self.delete_at(page_id, slot)? {
-                deleted.push(r);
-            }
-        }
-        Ok(deleted)
-    }
-
-    /// 全表扫描
-    pub fn scan(&mut self) -> io::Result<Vec<Row>> {
-        self.scan_columns(None)
-    }
-
-    /// 全表扫描，只解码指定列
-    pub fn scan_columns(&mut self, columns: Option<&[String]>) -> io::Result<Vec<Row>> {
-        Ok(self
-            .scan_projected_with_positions(columns)?
-            .into_iter()
-            .map(|(_, _, r)| r)
-            .collect())
-    }
-
-    /// 全表扫描，同时给出每行的位置（建索引用）
-    pub fn scan_with_positions(&mut self) -> io::Result<Vec<(PageId, u16, Row)>> {
-        self.scan_projected_with_positions(None)
-    }
-
-    /// 分片扫描，只取 [from, to) 页区间内的行
-    pub fn scan_columns_pages(
-        &mut self,
-        columns: Option<&[String]>,
-        from: PageId,
-        to: PageId,
-    ) -> io::Result<Vec<Row>> {
-        Ok(self
-            .scan_pages_with_positions(columns, from, to)?
-            .into_iter()
-            .map(|(_, _, r)| r)
-            .collect())
-    }
-
-    /// 当前页数
-    pub fn num_pages(&mut self) -> io::Result<u64> {
-        self.file.num_pages()
-    }
-
-    /// 全表扫描，带位置与列投影
-    fn scan_projected_with_positions(&mut self, columns: Option<&[String]>) -> io::Result<Vec<(PageId, u16, Row)>> {
-        let n = self.file.num_pages()?;
-        self.scan_pages_with_positions(columns, 0, n)
-    }
-
-    /// 扫描 [from, to) 页区间，带位置与列投影
-    fn scan_pages_with_positions(
-        &mut self,
-        columns: Option<&[String]>,
-        from: PageId,
-        to: PageId,
-    ) -> io::Result<Vec<(PageId, u16, Row)>> {
-        let n = self.file.num_pages()?;
-        let mut out = Vec::new();
-        let hidden = &self.hidden_columns;
-        for i in from..to.min(n) {
-            self.file.with_page(i, |p| -> io::Result<()> {
-                for slot in 0..HeapPage::slot_count(p) {
-                    if let Some(bytes) = HeapPage::tuple_bytes(p, slot) {
-                        out.push((i, slot, decode_row(bytes, columns, hidden)?));
-                    }
-                }
-                Ok(())
-            })??;
-        }
-        Ok(out)
-    }
-
-    /// 整表改写并重建所有索引
-    pub fn replace_all(&mut self, rows: &[Row]) -> io::Result<()> {
-        self.file.truncate()?;
-        for idx in &mut self.indexes {
-            idx.tree.clear()?;
-        }
-        for r in rows {
-            let (page_id, slot) = self.insert_returning_position(r)?;
-            let pos = pack_position(page_id, slot);
-            for idx in &mut self.indexes {
-                if let Some(k) = row_key(r, &idx.column) {
-                    idx.tree.insert(&k, pos)?;
-                }
-            }
-        }
-        Ok(())
-    }
-
-    /// 把脏页写回（索引也一起）
-    pub fn flush(&mut self) -> io::Result<()> {
-        for idx in &mut self.indexes {
-            idx.tree.flush()?;
-        }
-        self.file.flush()
-    }
-
-    /// 整理整张表的页内碎片，返回回收字节数
-    pub fn compact_pages(&mut self) -> io::Result<usize> {
-        let n = self.file.num_pages()?;
-        let mut reclaimed = 0;
-        for i in 0..n {
-            if self.file.with_page(i, HeapPage::dead_bytes)? == 0 {
-                continue;
-            }
-            reclaimed += self.file.update_page(i, HeapPage::compact_page)?;
-        }
-        Ok(reclaimed)
-    }
-
-    /// 当前缓存页数
-    pub fn cached_pages(&self) -> usize { self.file.cached_pages() }
-    /// 命中次数
-    pub fn hits(&self) -> u64 { self.file.hits() }
-    /// 未命中次数
-    pub fn misses(&self) -> u64 { self.file.misses() }
-    /// 命中率
-    pub fn hit_rate(&self) -> f64 { self.file.hit_rate() }
-}

chusql-core/storage/src/lib.rs

@@ -1,12 +0,0 @@
-// 存储层库入口：对外暴露下面这些模块，服务与集成测试都从这里引。
-
-pub mod btree;
-pub mod catalog;
-pub mod config;
-pub mod ffi;
-pub mod heap;
-pub mod log;
-pub mod page;
-pub mod protocol;
-pub mod runtime;
-pub mod wal;