Compare commits
41
Commits
main
..
4b8c9d9e78
| Author | SHA1 | Date | |
|---|---|---|---|
 ChuNa7a
|
4b8c9d9e78 | ||
|
LIm1tZz7
|
a45e33f94b | ||
|
LIm1tZz7
|
e87c4ee6a8 | ||
|
LIm1tZz7
|
fc9bbc20e4 | ||
|
LIm1tZz7
|
ff3dbddd13 | ||
|
LIm1tZz7
|
346530d5f1 | ||
|
LIm1tZz7
|
8d2f65ab8d | ||
|
LIm1tZz7
|
b51183a794 | ||
|
LIm1tZz7
|
0475a61c66 | ||
|
LIm1tZz7
|
8ce4239452 | ||
|
LIm1tZz7
|
48eec484b7 | ||
|
LIm1tZz7
|
fd5f320360 | ||
|
LIm1tZz7
|
59027684e6 | ||
|
LIm1tZz7
|
03a1f2bfb2 | ||
|
LIm1tZz7
|
157372ae37 | ||
|
LIm1tZz7
|
d59e65b639 | ||
|
LIm1tZz7
|
7d96933e32 | ||
|
LIm1tZz7
|
9b1c835202 | ||
|
LIm1tZz7
|
df47f7da27 | ||
|
LIm1tZz7
|
30f1014016 | ||
|
LIm1tZz7
|
a8e85b7ac0 | ||
|
LIm1tZz7
|
39480e2f2e | ||
|
LIm1tZz7
|
e2997627a7 | ||
|
LIm1tZz7
|
85008895dd | ||
|
LIm1tZz7
|
484b35a8bc | ||
|
LIm1tZz7
|
29529444a1 | ||
|
LIm1tZz7
|
4c030e6181 | ||
|
LIm1tZz7
|
045ccc2dc0 | ||
|
LIm1tZz7
|
274b7fcdcc | ||
|
LIm1tZz7
|
9758439b82 | ||
|
LIm1tZz7
|
df6d348995 | ||
|
LIm1tZz7
|
687c012841 | ||
|
LIm1tZz7
|
7600f0f9ed | ||
|
LIm1tZz7
|
9e8c5f1ef0 | ||
|
LIm1tZz7
|
7f5bcc289e | ||
|
LIm1tZz7
|
2a4b446252 | ||
|
LIm1tZz7
|
e428265357 | ||
|
LIm1tZz7
|
91ce26d7f0 | ||
|
LIm1tZz7
|
0791fe0446 | ||
|
LIm1tZz7
|
cae66f0731 | ||
|
LIm1tZz7
|
a9ef1ef3e2 |
No files matched your search
@@ -0,0 +1,13 @@
|
||||
# AI agent 协作资料
|
||||
|
||||
按任务读取，不将全部资料作为每次工作的上下文。
|
||||
|
||||
- 根目录 `AGENTS.md`：开发规则和测试入口。
|
||||
- `context/progress.txt`：唯一进度、测试计数和验收来源。
|
||||
- `context/known-issues.txt`：未解决限制；`design-decisions.txt`：现有设计约束。
|
||||
- `context/main-roadmap.txt`：长期阶段；`side-branch-plan.txt`：近期任务及依赖。
|
||||
- `skills/chusql-*/`：类型、存储、跨组件边界三个项目专用技能。
|
||||
|
||||
通用技能、安装锁文件及技能生成提示词仅保留在本地，不纳入版本控制。
|
||||
`gate-check/` 为开发者和 CI 共用的门禁工具；`logs/` 为忽略的本地产物。
|
||||
这些协作资料不参与应用构建、运行或发行打包。
|
||||
@@ -0,0 +1,113 @@
|
||||
# ChuSQL 当前设计决策
|
||||
进度见 progress.txt，限制见 known-issues.txt，用户操作见 docs/。
|
||||
|
||||
## 架构与接口
|
||||
- 用户文档按主题记录于 docs/commands.md、docs/types.md、docs/architecture.md 和 docs/install.md；只读范式入口已提供。后续实施 bound IR / DOMAIN，再推进物化、递归、MVCC、compact 和并行写；规划不代表现有能力。
|
||||
- 范式迁移首版保留来源，拒绝 NULL、重复行与依赖不保持；发布目标须验证约束、完整重建并使用独立原子结构 WAL 组，不能复用禁止 DDL 的会话事务拼接执行。
|
||||
- 发布真实性采用 TUF 元数据链与 Ed25519，初始 root 必须可信取得；离线验证不证明最新版本，操作系统原生代码签名另行接入。
|
||||
- Web / CLI → server TCP → Haskell 引擎 → FFI → Rust 存储；server 独占数据目录，Haskell 库静态链接，存储为 cdylib。
|
||||
- 引擎按 AST → 语义检查 → RelOp → 优化 → 执行分层；语义与优化只读 schema，表存在性以 catalog 为准，索引由存储管理。
|
||||
- JSON 使用显式稳定标签，FFI 仅提供 version / open / close / request / free / last_error；Web 不本地执行 SQL。
|
||||
- 兼容值与类型语义集中于 Core.Model，运行时类型与版本化编码集中于 Core.Runtime，函数注册与绑定集中于 Engine.Runtime；旧运算符保留 Engine.Builtin，错误分类集中于 Engine.Error。
|
||||
- 比较与赋值兼容性分开，整数与整值浮点统一相等和哈希，SQL NULL 比较走三值逻辑；DML 的 CHECK 随写计划一次绑定，结构变更对新 schema 重新绑定。
|
||||
- 写表达式和 CHECK 复用查询的列槽位绑定及行布局整理，避免按物理返回顺序取错值；UPDATE 在执行前按 schema 一次绑定目标槽位及列定义，按槽位校验、转换并覆盖单个值。目标不存在或歧义明确失败，不保留缺失类型时直接写入的兜底；保留逐项赋值、全部赋值后的 CHECK 及未命中行不求值。
|
||||
- INSERT 目标清单拒绝重复列，合法目标在本次执行中一次映射到 VALUES 槽位；行构造保留 schema 顺序及原输入表达式求值顺序，默认值、自增、显式 NULL 和整批校验沿用既有语义。缺少已绑定输入值明确失败，不把它作为省略列处理。
|
||||
- UPDATE 在全部行求值及 CHECK 成功后、调用存储写入前，复用 INSERT 的 NOT NULL 和 UNIQUE / PRIMARY KEY 检查；唯一性以最终整表结果判断，多个 NULL 不冲突。约束失败不发布部分行修改，事务快照保留并允许修正后继续提交。
|
||||
- NOT NULL 和 UNIQUE / PRIMARY KEY 检查使用 schema 位置绑定列，缺值或位置不符明确失败，不用 mapMaybe 跳过缺列。INSERT 的已有行与经引擎重写 schema 的 ALTER 输入行在约束边界按原 schema 整理；保留列级错误顺序、NULL 去重规则和数值规范化比较。
|
||||
- 写语句及已有表 DDL 使用仅保存 schema 的 BoundWrite，复用查询的依赖验证规则；收集目标、嵌套查询和传递 DOMAIN，新增列或改类型包含新声明 DOMAIN。先以只读 validate_write 确认写守卫能力，再发送实际写入；存储按库名排序取门，在目标库独占门及其他依赖共享门内复查后执行，不改变单次请求之间的数据隔离语义。
|
||||
- BoundWrite 的 DML 动作保存 INSERT 输入槽位、UPDATE 赋值目标、DELETE 布局和预绑定 CHECK / 非空 / 唯一性约束，执行期不再重新解析或按名称绑定目标；自动编号仍从当前行集求起点，唯一性仍按最终行集校验，保持逐项赋值及未命中行不求值。
|
||||
- CHECK 定义与执行共用布尔条件、函数和槽位绑定；聚合及子查询拒绝。结构变更先按新 schema 校验保留约束、默认值及键能力，空表不跳过；CHECK 文本未采用独立列身份，改名不自动重写，失效引用明确拒绝。
|
||||
|
||||
## 查询与优化
|
||||
- 优化保持结果语义和可观察行序；相关外层列不能被投影删除，LEFT JOIN 只下推安全的左侧谓词。
|
||||
- schema 携带行数、distinct、索引和直方图，缺统计时保守退回原计划。范围成本使用 16 桶等宽直方图，无直方图时按四分之一估算。
|
||||
- 内连接从各起点贪心选序，仅在严格更省且行序不可观察处重排；统计不足或不安全条件时不改写。
|
||||
- 表 / 列限定名在语义层按作用域及唯一候选解析，别名优先；会话将当前库限定 DDL 转为裸名，拒绝跨库目标，库名随请求传递。
|
||||
- 相关子查询的语义列环境按词法层逐层查找，保留最近层的列及类型，不把不同外层并成一张表；本层歧义不向外回退。JOIN ON 和外部引用收集使用同一外层环境，来源检查失败明确传播。执行期仍使用既有扁平外层行布局。
|
||||
- SELECT 在引擎入口直接进入 BoundQuery，避免规范化引用再次作为原始来源名解析；二段限定名被最近层同名来源遮蔽，该来源缺列时不回退。裸列仍按列可见性逐层查找，已解析引用的类型推导不重新解释来源遮蔽。
|
||||
- 绑定后的子查询保存父布局中的局部或外层列槽位，取值与复用缓存键共享该绑定；诊断名称相同不表示位置相同。重绑定不把外层引用转为局部引用，布局失配和引用清单失配明确返回错误；原始关系执行 API 保留未绑定 Subquery 的名称入口。
|
||||
- 已绑定列重绑定时保留仍匹配名称的有效位置，原位置不匹配仅允许唯一同名列重定位；歧义或负位置拒绝。外层槽位保留相对位置并更新局部宽度；独立列身份未实现，结构改写仍须在绑定前完成，不能凭同名槽位识别重排后的不同列。
|
||||
- 相关子查询保留已解析外层限定名；求值绑定补回单表物理列的限定名，绑定去重与扫描投影使用同一列值，库限定引用仍校验 schema 来源。
|
||||
- JOIN 条件按子查询外层引用的值缓存替换后的表达式；首次遇到行对时才求值，每个行对仍计算普通条件，保留输出顺序、空输入和错误返回。
|
||||
- 半连接仅重写独立 IN 或单表唯一等值相关 EXISTS 的单独过滤谓词；键按两侧布局分别绑定，输出只保留原左行。独立 IN 沿用物化身份，NOT IN 感知右侧 NULL，反 EXISTS 保留空值键；大数混合比较退回原比较语义。复杂条件、可能报错的相关投影和相关聚合不重写，空左侧不执行右侧，保持完整右侧求值；空集 IN 为假、NOT IN 为真（含 NULL 左值），非空集合保持三值逻辑。
|
||||
- 每次查询执行用独立状态物化成功行集，子查询按已解析定义和具名外层绑定值共享，原始名称调用保守包含整个外层行；派生表按执行子树和外层行缓存，先共享再应用别名。各消费者独立处理标量基数与三值逻辑，失败仍明确返回，保持既有求值顺序；不跨执行保留，也不提供整条查询快照或磁盘溢出。
|
||||
- WAL 提交组落盘后、首次应用前进入 recovery_required；任何应用、刷盘或检查点错误都保持该状态，完整落盘与截断成功后才解除。
|
||||
- FROM 是来源树，派生表必须带别名且不能引用外层，输出取裸列名，重名报错；未定型 NULL 保留独立查询推导类型，不能声明为存储类型。
|
||||
- ORDER BY 优先匹配唯一输出别名，再查来源列；只将排序表达式提前计算，非排序投影保持在 LIMIT 后求值。CTE 列清单同步重命名内层排序别名。
|
||||
- ORDER BY 输出序号保留到计划生成，不转换为诊断名称；普通查询选定对应投影表达式，DISTINCT 按去重结果槽位排序，重复别名不丢失位置。名称排序仍拒绝歧义，序号不作为相关子查询自由列，排序键遵守类型能力、分组及 LIMIT 求值时序。
|
||||
- 派生表从透明算子与 schema 统计估算行数，缺统计或表达式可能报错时不重排；投影下推保留计算项，避免删除错误。内存存储提供实时行数及封顶去重统计。
|
||||
- DECIMAL(p,s) 使用有限浮点、ties-to-even 舍入和舍入后溢出检查，要求 1 <= p <= 308、0 <= s <= p；Haskell 与 Rust 写入入口统一边界，日志记录规范化值。
|
||||
- CTE 解析期展开为派生表，只接受 SELECT，不物化；多次引用重复执行，以减少实现改动面。
|
||||
- 比较及 ANY / ALL 使用独立 AST 节点，量词复用三值逻辑，空集 ANY=false、ALL=true。
|
||||
- 子查询在 Filter / Compute 中按外层绑定分组复用，暂不引入半连接；扫描按页分片，至少 1000 行、最多 8 线程，结果保序，safe FFI 释放执行能力。
|
||||
|
||||
## 会话、事务与存储
|
||||
- 每连接独立会话及工作库；短锁取得库句柄后执行，每库读写门控制可见性，表锁保护页，在用库不强行删除。
|
||||
- BEGIN 物化当前库快照，事务内走内存执行，COMMIT 提交相对基线差分，ROLLBACK 丢弃快照。
|
||||
- COMMIT 先跳过数据未修改的表，整数 id 用 IntMap / IntSet 查找差异与冲突；保留原行顺序及重复 id 的首行查找语义，冲突检查和提交操作共享一次差分。
|
||||
- 有整数 id 时按键提交及检查写写冲突，无整数 id 时整表比对；未修改表不回写，冲突保留事务并返回 serialization_failure。
|
||||
- 保存点保存不可变快照引用，同名取最近一层，回退 / 释放丢弃之后的点，结束清空；事务命令由会话层执行。
|
||||
- WAL 先记录操作及提交标记，再应用、刷数据与 catalog、写检查点、截断；仅重放已提交且超过检查点的记录。
|
||||
- WAL 帧保留长度、LSN、类型码、表名及 JSON payload，兼容旧记录；恢复按内容、schema 和文件存在性判断幂等。
|
||||
- 检查点按库 LSN，前缀截断用同目录临时文件原子替换，未提交尾部直接截短；失败保留 WAL 并进入 recovery_required。
|
||||
- 检查点采用同目录临时文件替换，长度必须为 8 字节；完整 WAL 帧损坏明确报错，尾部不完整帧保留撕裂处理。刷盘或检查点失败后封闭请求，重启重放已提交组。
|
||||
- distinct 在封顶前按值引用计数维护，列封顶不清除其他列状态；直方图独立累计与递减，桶重映射导致删除目标为空时扣最近非空桶以保持总量。rebuild_stats 先扫描数值范围，再按固定边界计数，消除重建过程的桶重映射偏差并保持输入顺序无关。
|
||||
- 表 / 索引 DDL 进 WAL，删表不重取已移除句柄；库建删不进 WAL，删除以墓碑目录收敛。
|
||||
- 页内 compact 保持槽号及索引位置，死空间达到四分之一时自动整理；无隐藏列逐页整理，有隐藏列整表重写，不跨页填空以保留行序。
|
||||
|
||||
## 身份、权限与引导
|
||||
- 对象标识使用数据库编号与库内表编号组合；数据库编号从 system catalog 的对象高水位分配，表编号从本库高水位分配，删除不降低计数器。对象解析只读取 catalog。
|
||||
- 建表编号在 WAL 组写入前分配，随建表记录提交；目录应用时推进高水位，恢复使用日志编号。只有建表组复制操作列表，普通数据提交沿用借用列表。
|
||||
- 用户是可登录角色，共用名称空间；identities 保存属性、时间、稳定编号及版本，users 只存编号和口令哈希，编号不复用。
|
||||
- 最高权限按身份属性判断，不按名称、不继承；默认用户 LOGIN、角色 NOLOGIN，两者 NOSUPERUSER / ENABLED。保护最后一个启用的登录管理员。
|
||||
- 仅旧格式迁移按管理员参数识别初始最高权限；旧账号保留信息，角色补编号，重名拒绝；身份、凭据及删除清理用同一 Accounts WAL。
|
||||
- server 判定权限，目录封装于 Server.Catalog；角色成员取向上闭包，写入拒绝环。GRANT role TO member 表示 member 继承 role 权限。
|
||||
- members 保持身份成员目录；对象授权存于受保护 __system_object_acl，使用稳定对象与身份编号，保存所有者、授予者和 grant option。CONNECT / CREATE 限数据库，四项数据权限限表或单库表范围；ALL 按作用域展开。
|
||||
- PUBLIC 默认只提供业务数据库 CONNECT，可逐库撤销；CREATE 建表登记创建者所有权，数据库所有权不隐含他人表的数据权限。启用角色可继承所有权，不继承 SUPERUSER。
|
||||
- 授权链从独立管理来源及所有权展开固定点；撤销清理无来源下游，保留独立来源，循环不能自持。禁用保留所有权和管理来源授权，停止权限贡献并清理失效下游。
|
||||
- 旧名称授权仅迁移一次到现存稳定对象；旧全局 * 固定为当时现存表，缺失对象或身份清理，旧记录无授予者时使用管理来源。
|
||||
- 权限快照按字符分块存储，比较旧快照后以同一 WAL 组替换；跨页及 Unicode 不受单行上限限制。普通存储入口隐藏并拒绝访问权限快照表。
|
||||
- 服务端共享公平读写锁排序查询与权限变更；事务提交复查身份、权限和稳定对象。建表前写入创建者声明，启动时依据现存对象恢复所有权或清理未完成声明。
|
||||
- 口令 / 属性推进 revision，权限变更预先展开受影响身份；TCP 只标记连接失效，下一请求回 unauthorized 后关闭，避免 Windows 阻塞句柄异步中断；登记在 finally 清理。
|
||||
- 系统表统一 __system_ 前缀并分层保护，内部目录按白名单访问；旧名按文件先、catalog 后迁移，崩溃后可重复收敛。
|
||||
- 安装先 bootstrap：建立 system、默认 root（LOGIN / SUPERUSER / ENABLED）、18 个内置名称，再起服务；引导请求不开放 TCP。
|
||||
- 清单编入引导并与解析器测试比对；system.__system_types 保存名称、基础表示、参数能力、编号。重复引导保留口令并补齐类型，冲突或身份降权失败；类型建表与写入用同组 WAL。
|
||||
|
||||
- sudo 认证用独立 allow_sudo_auth 属性和显式 sudo_auth_user 映射；默认关闭，只有 SUPERUSER 能管理，不继承、不隐含权限。目录管理者不得管理启用该属性的身份。
|
||||
- 选择操作系统保护的随机本机凭据与 TCP 一次性 HMAC 挑战，以复用三平台既有会话协议；Unix 只信任有效 UID 0，Windows 只信任提升 Administrators 令牌。双方校验内核回环地址，不接受客户端自报 OS 用户或 SUDO_USER。
|
||||
- 本机凭据只存放于系统保护的端口专属目录，原生入口校验提升身份；实例重启重新生成，现存目录拒绝覆盖。此方案要求服务端也提升运行，以保证创建凭据时的操作系统保护边界。
|
||||
- 挑战绑定账号、连接及实例，60 秒过期并在每次尝试时消费；证明常量时间比对，凭据不经网络发送。成功登录复用身份版本、登录时间及连接失效机制，审计不含凭据或证明。
|
||||
- sudo 属性由 Accounts WAL 持久化，旧目录缺列触发身份快照重写，旧记录缺属性默认 false，已有的错误类型明确拒绝。
|
||||
|
||||
## 自定义类型
|
||||
- 范式检查采用阿姆斯特朗属性闭包与子集枚举，候选键声明转为决定全关系的依赖；完整覆盖声明与领域原子性分别控制可证明结论，不从样本推断。二元 BCNF 建议按违反依赖无损拆分，投影依赖之并用于验证依赖保持。
|
||||
- DOMAIN 命名基础类型，列编码 domain(名称,基础类型) 保留引用，值及索引沿用底层语义。
|
||||
- 各库 __system_domain_<名称> 空目录表的 base 列保存定义，复用 catalog / DDL WAL；普通 SQL 隐藏并保护目录。
|
||||
- 嵌套只引用当前库已有类型，语义层从 schema 递归解析并拒绝循环，存储写锁内逐层校验；删除检查类型间及间接列依赖。
|
||||
- 类型 DDL 要求管理员、事务内禁止；约束与默认值后续扩展，暂不引入自定义函数 / 运算符。
|
||||
- 运行时类型使用稳定构造器编号与结构化 TypeId，逻辑类型与 PhysicalType 分离；递归值使用版本 1 标签编码，读取时校验类型、形状及载荷。
|
||||
- TypedExpression / TypedPlan 仅使用 schema 绑定，SQL BoundQuery 通过既有 RelOp 执行并按输出位置验证；输出类型保留嵌套 DOMAIN 名称，基础日期、时间戳及 Blob 保留兼容类型，函数结果不继承参数领域。
|
||||
- TypedExpression 列引用保存输入 schema 槽位与诊断名称；独立求值要求行顺序匹配，TypedPlan 扫描边界校验并按 schema 排序，每层投影绑定到子计划输出。SQL RelOp 在优化后绑定表达式列槽位，投影单向转为 Compute，排序/分组转为 BoundSort/BoundAggregate，存储结果按算子布局排列；子查询局部列在前、外层绑定在后。绑定算子不参与后续投影下推；独立作用域身份仍待迁移。
|
||||
- SQL 局部引用使用 ColumnSlot，外层引用使用 OuterColumnSlot 的相对位置及局部布局宽度。重新绑定外层引用只查询外层布局，避免同名局部捕获；语义输入拒绝执行槽位。外层行仍扁平化，多级词法作用域/来源编号另行迁移。
|
||||
- BoundQuery 执行前重新取得 schema 并比较依赖对象身份、schema 版本及列定义，依赖覆盖全部嵌套子查询及来源列的传递 DOMAIN 定义。IPC 将依赖守卫限定在本次执行环境；扫描、分片、点查及范围读均在相关库读锁内复查全部依赖后读取，跨库读锁按库名排序，持有库引用防止删除。数据、统计和无关对象不参与比较；旧目录缺失版本时仍比较列定义，已知身份或版本丢失则拒绝。守卫响应必须明确确认，旧二进制忽略字段时拒绝；未实现守卫的后端明确报错，纯内存视图可直接执行。守卫不改变既有多请求查询的数据隔离语义。
|
||||
- 内建函数先解析为稳定 FunctionId 并验证签名，再执行；SQL NULL 保留三值语义。缺少能力字典的运行时类型拒绝比较、排序、分组、极值、索引及唯一键声明。
|
||||
- SQL 字面量生成返回明确错误，先验证运行时值与有限浮点；复合值在 Web 使用 SQL 修改。
|
||||
|
||||
## 配置、构建与发行
|
||||
- Web 编辑在首个业务表加载时建立快照，在提交 / 回退时结束；既有大库基准 BEGIN 269.806 ms、COMMIT 376.345 ms，不按每次单元格编辑重建整库快照。
|
||||
- Web 登录分别建立普通 API / SQL 和编辑连接，页面 / 数据库标识绑定编辑事务，SQL 事务另绑定查询标签；同 Cookie 请求串行执行。
|
||||
- 编辑集保留在浏览器，提交从固定保存点重放；失败回退整个编辑集，冲突回滚并重新加载，成功回执去重；系统身份修改不进入数据事务。
|
||||
- system_catalog_manager 只管理普通身份，不继承、不隐含业务访问权限；存储写锁内再次拒绝特权目标及特权属性修改。
|
||||
- bootstrap 维护使用独占数据目录锁，在副本中修复并验证后保留原目录备份再发布；repair 不重放 WAL、不补初始化数据，原有数据文件必须字节一致。
|
||||
- listen_host 是监听配置，static 固定为静态目录，管理员名由 --user 指定；data_dir 存数据，log_files 存日志，相对路径以启动目录解释。
|
||||
- resources/chusql.toml 入库并打包，UI 设置样本不入库、不进包，运行时按 resources、上一级 resources、工作目录候选查找。
|
||||
- 预编译包优先，server / 存储必装，Web / CLI 可选；Windows zip、Linux/macOS tar.gz。包内模板也放 resources/，按确切产物名打包并拒绝未知工件。
|
||||
- 本地解包安装不联网，管理员名同时传 bootstrap 和 server；安装冒烟隔离配置并恢复用户 PATH，卸载可保留数据 / 配置。
|
||||
- 门禁先刷新 release cdylib，再并行 Rust、串行 Haskell、注释三条车道；Server / Web 先刷新各工程的本地依赖，任一步失败即失败。
|
||||
- 局部改动只测试受影响模块；较大改动由 agent 执行全量门禁。日志 / 临时文件在 logs/，必要时 -Full；门禁及打包强制 UTF-8 以避免 GBK 编码失败。
|
||||
- CLI 终端隐藏口令，管道兼容 LF / CRLF / 无行尾，保留空格与内部回车，提示写 stderr。
|
||||
- CLI 禁用逐行自动历史，只记录完整 SQL 与元命令；含 IDENTIFIED / PASSWORD（忽略大小写）的输入整体排除，避免多行口令或执行失败留下片段。解析错误也隐藏此类原文，筛选保守包含字符串和标识符中的同名文本，已有历史不自动删除。
|
||||
- TCP 与 Web 使用同一解析诊断脱敏路径；Web 回归校验整个 HTTP 错误响应不含口令。内置 SQL 控制台记录结果或诊断，不将 SQL 原文写入日志，外部代理和采集需自行配置。
|
||||
- BoundQuery 保存来源对象身份及列定义；DOMAIN 依赖从来源列递归展开，执行前复查。库 / 对象编号在 TableInfo 中输出十进制字符串，读取兼容旧数值，零对象编号表示无有效身份。
|
||||
- 表级 schema_version 由 catalog 持久化，新表从 1 开始，旧目录缺失版本保留 0；结构变化递增，新增结构 WAL 记录保存确定目标版本，恢复不重新分配。线上使用精确十进制字符串并兼容数值输入，0 或缺失表示未知版本；IPC schema / 快照与内存 Server 保留版本，内存 DDL 同样递增并拒绝耗尽。
|
||||
- 注释以 AGENTS.md 为准；原因写本文件，限制写 known-issues.txt，进度及计数只以 progress.txt 为准。
|
||||
@@ -0,0 +1,56 @@
|
||||
# ChuSQL 当前限制与风险
|
||||
进度见 progress.txt，设计见 design-decisions.txt；仅记录未解决的限制。
|
||||
|
||||
## 事务、恢复与并发
|
||||
- 事务是整库内存快照，不是行版本 MVCC；每会话一个事务，无嵌套事务，事务内禁止 DDL / USE。
|
||||
- BEGIN / COMMIT 仍有整库快照传输与修改表比较成本，复测见 docs/performance.md。
|
||||
- Web 首次加载业务表即固定编辑快照，同一登录会话只允许一个页面持有编辑事务；系统身份表只读，通过 SQL 管理。
|
||||
- 页面关闭的回滚请求可能因断线未送达；此时按会话空闲 / 最长寿命过期清理，后台每分钟检查一次。编辑连接失效后必须重新登录，不能恢复旧快照。
|
||||
- COMMIT 按整数 id 校验写写冲突，缺少整数 id 时整表比对及替换；冲突返回 serialization_failure，调用方回滚或重试，无自动重试或死锁检测。
|
||||
- WAL 只有 redo，检查点按库 LSN 而非页 LSN，幂等恢复代价随数据量增长；库目录建删不走 WAL，删库用墓碑目录处理。
|
||||
- recovery_required 期间除 Ping / SystemStatus 外请求被拒绝，需恢复后继续。
|
||||
- 每库读共享、写独占，写入会阻塞同库跨表读取，尚无并行写。
|
||||
- 权限变更只标记 TCP 连接失效，客户端下一次请求收到 unauthorized 后关闭，空闲连接不会立即断开；并发测试不证明性能提升。
|
||||
|
||||
## 查询与性能
|
||||
- 基础成本及贪心连接重排，无动态规划或跨外连接重排；只在行序不可观察处重排。
|
||||
- catalog 行数可能滞后，distinct 有上限；16 桶等宽直方图只统计数值并按闭区间估算，增量维护可能偏差，桶内分布仍为估算。
|
||||
- 内存统计去重上限为 4096，暂不提供直方图或索引成本；派生表可从透明算子估计行数，含聚合或可能报错表达式时仍保守。投影下推保留所有计算项，不消除潜在错误。
|
||||
- 查询内物化只在内存保存结果，尚无容量预算或磁盘溢出；既有按绑定分组求值可能更早报告同一错误。
|
||||
- CTE 解析期展开，不支持递归、写语句或 MATERIALIZED / NOT MATERIALIZED 指定；不同优化子树不能共享物化。只能引用前面定义的 CTE，前向引用按普通表名解析。
|
||||
- 半连接重写尚未覆盖组合谓词、复杂相关条件、多键、相关聚合或排序截断；可能报错的相关投影继续走原执行路径。
|
||||
- 并行只覆盖页区间扫描：schema 至少 1000 行、最多 8 线程，无页内并行，统计滞后可退回顺序扫描。
|
||||
- compact 不填跨页空洞，含隐藏列时仍需整表重写。
|
||||
|
||||
## 权限与兼容性
|
||||
- 对象权限快照整体写入，鉴权会读取身份、成员和对象元数据；尚未针对大规模权限目录做性能基准。
|
||||
- 对象高水位损坏或回退后无法恢复已删除对象的编号上限；旧二进制会丢弃新增目录字段，不应降级使用已升级的数据目录。
|
||||
- 无列级权限、所有权转移或角色 ADMIN OPTION。
|
||||
- 旧授权缺少授予来源，迁移为管理来源；旧全局 * 只绑定迁移时现存表。没有身份改名命令；已有同名 public 身份在删除前不会解析为虚拟 PUBLIC。
|
||||
- 尚无 CREATEDB / CREATEROLE、继承开关、口令到期、连接上限或 Web 专门的身份属性编辑界面。
|
||||
- 旧账号与角色重名会阻止迁移；迁移后的身份目录与 DOMAIN 编码不支持旧二进制。更早的 __chusql_users 无自动迁移。
|
||||
- 旧配置 host 不读取，web.static_dir / web.user 被忽略，升级需按 docs/config.md 调整。
|
||||
- 引导不重设已有口令、不提升已降权身份；类型定义冲突需人工解决。
|
||||
|
||||
## 类型与语义
|
||||
- 范式分析最多 12 列；领域原子性和依赖完整性由用户声明，信息不足时不认证高阶范式。分解建议仅一轮，不保证子关系已达 BCNF；尚无自动迁移。
|
||||
- DOMAIN 无自身 CHECK / NOT NULL / DEFAULT、ALTER DOMAIN、CASCADE；尚无 ENUM 或用户定义复合类型。内置目录不能靠增加行扩展基础类型。
|
||||
- DECIMAL 仍使用浮点表示，不是精确十进制存储；整数类型共用整数表示，CHAR 不补空格。
|
||||
- 少量接口设置仍用字符串类型名；Haskell 值语义和 Rust 索引键分开维护。旧 ColumnType / RelOp 仍是兼容桥，完整能力、转换及关系 IR 迁移待后续阶段。
|
||||
- 多请求查询不提供整条查询的数据快照；旧目录无有效对象编号时无法证明历史对象身份。执行期外层行仍使用扁平布局，原始关系执行 API 仍允许名称引用；尚无独立作用域或来源编号。
|
||||
- 写入的存储操作分别取门，尚无整条语句的数据快照或数据冲突检测。来源/列缺少独立身份，不能视作完整写入 bound IR；建表、库及 DOMAIN 管理不在已有表写计划范围。
|
||||
- CHECK 仍以表达式文本持久化；RENAME COLUMN 不自动改写依赖 CHECK，引用旧列名时拒绝改名。普通原始存储 DDL 不具有 Haskell 的完整表达式语义校验。
|
||||
- 运行时类型尚无 Eq / Ord / Hash 等 capability 字典，不提供比较、排序、分组、极值、去重和索引；复合字段在 Web 通过 SQL 修改，没有结构化单元格编辑器。
|
||||
- 运行时协议使用版本 1，旧客户端不支持新增类型化值；Web 的 JSON 数值仍受 JavaScript 安全整数范围限制。
|
||||
- 派生表输出取裸列名，重复名称报错；未定型 NULL 仅用于查询类型推导，不可声明为存储列类型。
|
||||
|
||||
## 构建、发行与安全
|
||||
- 离线 recover 依赖完整可用 WAL，不能保证修复损坏数据页或已截断的历史；未知系统表缺少结构时需备份或 reset。目录计数器损坏后无法还原已删除身份编号上限。
|
||||
- 旧版进程不支持数据目录独占锁；维护前必须停止所有相关进程。
|
||||
- sudo 本机认证需提升身份启动 server；当前只映射 Unix root / Windows 提升 Administrators 到一个显式配置身份，无任意 OS 用户映射或自动提权。异常退出留下的端口凭据目录须在确认停止后手工清理。
|
||||
- sudo 的 Windows 提升成功路径、macOS 编译运行及 Linux 完整提升 server/CLI 链路仍待目标平台实机验收；Debian/WSL 已验证原生凭据安全边界。
|
||||
- 直接构建独立 Stack 工程时可能复用旧注册库，必要时使用 --force-dirty 或全量门禁 -Full；Haskell 构建须串行。
|
||||
- 存储协议变化后必须重建实际 cdylib，开发环境须配置 PATH / LD_LIBRARY_PATH；旧命名构建工件仍可能残留。
|
||||
- 真实 server 测试须先引导并能找到 bootstrap；注释检查对部分多行语法可能误报。
|
||||
- GitHub 在线安装、Linux $ORIGIN 与 macOS 发布仍需实机验证；无 Release 时在线安装无法取得预编译资源。
|
||||
- SHA256 只能检测损坏，无发布签名；外部采集仍可能记录 SQL 原文。旧 CLI 历史不自动清理，任意业务字符串中的敏感数据不自动识别。
|
||||
@@ -0,0 +1,22 @@
|
||||
ChuSQL 长期路线图
|
||||
|
||||
交付状态和验收只以 progress.txt 为准；近期顺序见 side-branch-plan.txt。
|
||||
本文件描述目标，不代表现有实现或功能承诺。
|
||||
|
||||
目标链路：SQL → Parser / Binder → Typed IR → Planner / Optimizer → Executor → Rust Storage。
|
||||
类型能力与权限保持独立；catalog 保存对象、依赖和语义，内核保留必要基础机制。
|
||||
|
||||
阶段
|
||||
- A 类型与函数基础：稳定 TypeId / FunctionId、注册表、逻辑/物理类型分离、版本化值；验收见 progress.txt。
|
||||
- B 能力与运算（2–6）：Capability、Operator、Cast、Aggregate、参数多态与约束解析。
|
||||
- C 复合与自定义类型（7–12）：ADT、Record/Composite、Newtype/Domain、参数化类型、Range、用户类型。
|
||||
- D 函数与效果（13–16）：用户函数、Effect、纯 Generated Column、有副作用的 Trigger。
|
||||
- E 权限与类型化查询（17–19）：权限 Capability、Query a、Rewrite / Optimizer 函数化。
|
||||
- F 扩展：对象体系统一后实现 Extension 的版本、依赖、安装/升级/移除；其他访问方法按真实需求推进。
|
||||
|
||||
贯穿约束
|
||||
- 现有 ColumnType / Expr / RelOp 有真实消费者；迁移时逐步收拢，不提前删除兼容桥。
|
||||
- 每阶段验证持久化、升级、依赖和恢复，不能靠重新初始化掩盖不兼容。
|
||||
- 内建对象可由可信 bootstrap 元数据恢复；用户对象依赖 WAL / 备份。
|
||||
- catalog 版本与 bootstrap / recovery 匹配，系统目录索引可重建。
|
||||
- 不提前增加孤立扩展或绕过事务、权限及依赖管理。
|
||||
@@ -0,0 +1,41 @@
|
||||
ChuSQL 已完成事项
|
||||
更新：2026-10-13
|
||||
|
||||
本文件是当前完成状态及最新验收的唯一来源，等价于 project-plan.txt；不保留历史批次、提交记录或修改流水。
|
||||
设计见 design-decisions.txt，未解决限制见 known-issues.txt，后续计划见 side-branch-plan.txt。
|
||||
|
||||
## SQL 与查询执行
|
||||
|
||||
- 实现 CRUD、表列约束、索引、INNER / LEFT JOIN、聚合、GROUP BY、HAVING、ORDER BY、LIMIT、投影别名、DISTINCT / ALL；排序支持输出序号、表达式、函数、聚合及子查询。
|
||||
- 实现标量及相关子查询、派生表、非递归 CTE、IN / EXISTS、比较与 ANY / ALL；保持 NULL 三值逻辑、重复列、稳定排序、空输入聚合及空集成员比较语义；HAVING 覆盖整体组与未投影聚合，新子句参与依赖守卫和表权限检查。
|
||||
- 实现谓词 / 投影下推、常量折叠、点查 / 范围成本选择、贪心内连接重排、16 桶直方图及保序并行扫描；子查询按定义和外层值在查询内物化、跨子句复用，相同 CTE / 派生执行子树共享结果；独立 IN / NOT IN 和简单等值相关 EXISTS / NOT EXISTS 使用哈希半连接 / 反连接。
|
||||
|
||||
## 类型与绑定
|
||||
|
||||
- 建立固定类型 / 函数编号、TypeId / TypeExpr / Kind、逻辑与物理类型、版本化复合值编码；支持 Int / Double / Bool / String / List / Maybe / Tuple、length / not，接入 SQL、存储、CLI 和 Web。
|
||||
- 实现 CREATE / DROP / SHOW DOMAIN、库内嵌套定义、列引用、依赖与循环校验及持久化；查询输出保留 DOMAIN 身份。
|
||||
- 查询使用 BoundQuery；表达式、投影、连接、排序和分组按 schema 槽位绑定，存储返回行按布局整理，缺列和位置失配明确失败。
|
||||
- 相关列按最近到最远的独立词法作用域解析，局部 / 外层槽位分离；重绑定保留有效位置，失配仅允许唯一同名列重定位。子查询取值与缓存共享槽位绑定。
|
||||
- DML 使用可复用 BoundWrite，预绑定 INSERT 输入、UPDATE 目标、DELETE 布局及 CHECK / 非空 / 唯一性约束；保留默认值、自增、逐项赋值和未命中行不求值，唯一性按最终行集判断，失败不发布修改。
|
||||
- 查询与已有表写计划保存对象身份、schema 版本、列定义及传递 DOMAIN 依赖；执行前及实际存储操作锁内复查。写前握手拒绝不支持守卫的存储，跨库按名称排序取门；数据、统计和无关结构变化不使计划失效。
|
||||
- CHECK 定义与执行共用类型及槽位绑定；建表、加列和结构变更校验条件、默认值与键能力，空表不跳过，失效引用明确拒绝。
|
||||
|
||||
## 存储与事务
|
||||
|
||||
- 实现页、堆表、B+Tree、catalog、WAL、LSN 检查点、已提交组幂等恢复及页内 compact；持久化对象编号、高水位和 schema 版本，失败进入 recovery_required。
|
||||
- 实现按连接隔离工作库、整库快照事务、写写冲突检查、保存点和差分提交；权限及对象身份在事务提交时复查。
|
||||
- Web 编辑使用独立连接与页面绑定，支持跨表原子提交、保存点重放、提交去重、冲突重载、SQL 标签隔离及退出清理。
|
||||
|
||||
## 身份、工具与发行
|
||||
|
||||
- 用户与角色统一名称空间，支持 LOGIN / SUPERUSER / ENABLED、稳定编号、角色继承、迁移及删除清理；权限变更使受影响会话失效。
|
||||
- 实现对象所有权、grant option、DATABASE CONNECT / CREATE、表级数据权限及 PUBLIC、SHOW GRANTS、REVOKE GRANT OPTION FOR 和失效授权级联清理。
|
||||
- 实现默认关闭的本机 sudo 身份映射、受保护凭据、回环校验与一次性 HMAC 挑战；已验证 Windows 非提升拒绝及 Debian/WSL root 凭据安全边界。
|
||||
- 范式检查通过 Haskell / TCP / CLI / Web 提供只读分析，依据 schema 与声明检查 1NF / 2NF / 3NF / BCNF，输出违反依赖、一次无损分解及依赖保持结果。
|
||||
- 引导初始化 system、默认 root 与 18 个内置类型，重复引导保留口令并拒绝冲突；实现 system_catalog_manager 及 bootstrap repair / recover / reset。
|
||||
- 统一监听、数据 / 日志目录与配置模板；完成 Windows 分组件打包安装冒烟、管道口令兼容、敏感 SQL 诊断 / 历史脱敏及 UTF-8 构建。发行与平台未验收事项见 known-issues.txt。
|
||||
|
||||
## 最新验证
|
||||
|
||||
- 全量门禁通过：Rust 191 / Engine 598 / Server 163 / Web 80 / CLI 20 / Bootstrap 9，均零失败；动态库重建、Clippy、注释检查及 git diff --check 通过；受影响 HLint 仅保留既有惰性相关建议。
|
||||
- 验收入口：gate-check/run-gate.ps1；最新日志：logs/empty-in-gate.log。局部改动验证受影响模块，较大改动执行全量门禁；当前工作区改动未提交。
|
||||
@@ -0,0 +1,16 @@
|
||||
ChuSQL 近期任务与依赖
|
||||
|
||||
实现、测试及门禁状态只以 progress.txt 为准；设计见 design-decisions.txt，限制见 known-issues.txt。
|
||||
下列顺序是规划，不是已完成能力；每批按实际进度选择任务。
|
||||
|
||||
1. 统一绑定与类型系统：完成多级作用域、来源/列身份、写语句和约束绑定，收拢旧兼容桥；完善 DOMAIN 约束与 ALTER DOMAIN、精确 DECIMAL、复合类型 Eq / Ord / Hash，再推进 ENUM / 用户复合类型 / ADT。统一写入、导入、事务提交与 Rust 索引语义，保留 nullable、错误时序和布局语义；明确整数范围、CHAR、旧目录身份升级及数据迁移。已有 schema 版本和读取守卫的验收见 progress.txt。
|
||||
2. 查询语言与执行优化：推进递归 CTE 和写入型 CTE，扩展复杂条件去相关，完善物化内存预算及磁盘溢出，合并连接搜索、外连接变换及统计成本改进；写入型 CTE 依赖统一写入校验。优化保持行序、重复、错误时序及来源解析规则。
|
||||
3. 原子结构变更与范式迁移：将库建删、DDL、对象依赖及版本复查纳入原子发布和恢复，维护绑定失效、权限、回滚与编号高水位；在对象目录、DOMAIN 约束及结构事务基础上支持 CASCADE 和范式自动迁移，发布前验证旧数据与嵌套依赖。迁移首版保留来源，拒绝 NULL、重复行及依赖不保持，后续推进多轮分解。
|
||||
4. 存储并发与恢复：推进 MVCC、死锁检测和并行写，完善页 LSN、恢复、跨页整理及隐藏列重写。保留幂等、隔离、句柄生命周期、行序与资源预算，以实测决定并行扩展。
|
||||
5. 权限与客户端能力：完善列级权限、所有权转移、ADMIN OPTION 和身份属性；统一 Web 复合值编辑、大整数及多页面事务的交互与会话约束。按真实需求选择实施范围。
|
||||
|
||||
持续验收
|
||||
- 局部改动通过受影响模块测试；较大改动由 agent 执行全量门禁，通过后再提交。模块测试不替代异常恢复、磁盘错误、持续负载及并发冲突演练。
|
||||
- sudo、在线安装、Linux $ORIGIN、macOS 构建发行与发布签名按目标平台验证，结果登记 progress.txt。
|
||||
- 升级明确账号/授权/配置迁移、禁止降级、旧历史和异常凭据清理；不承诺旧二进制兼容、损坏页自动修复或任意 OS 用户映射。
|
||||
- Haskell 构建串行，存储协议变化重建实际动态库；门禁入口为 gate-check/run-gate.ps1。
|
||||
@@ -0,0 +1,64 @@
|
||||
---
|
||||
name: chusql-boundary-contracts
|
||||
description: 修改 ChuSQL Rust/Haskell FFI、客户端与 Server 协议、跨组件序列化契约或公开接口时使用；核对调用链、线程与所有权。单模块内部算法且接口未变时不加载。
|
||||
---
|
||||
|
||||
# ChuSQL 边界契约
|
||||
|
||||
## Scope
|
||||
|
||||
负责组件间表示、调用与生命周期。类型内容使用 chusql-type-system，落盘与恢复使用 chusql-storage-integrity，通用 unsafe 检查使用 rust-c-ffi-safety。路径相对仓库根目录，按变更读相关消费者。
|
||||
|
||||
## Architecture
|
||||
|
||||
- CLI / Web 后端通过 `chusql-interface/src/ChuSQL/Interface/Link.hs` 连接 Server TCP；`Protocol.hs` 定义网络消息，`Session.hs` 提供客户端会话操作。
|
||||
- `chusql-server/src/ChuSQL/Server/TCP.hs` 分派消息，`Session.hs` 管登录 / 鉴权，`Backend.hs` 调引擎。浏览器通过 `chusql-web/src/ChuSQL/Web/API.hs` 的 HTTP API 访问 Web 后端，不直接访问 Rust。
|
||||
- `chusql-core/engine/src/ChuSQL/Core/Engine/Storage/IPC.hs` 将 MonadStorage 操作编码为 JSON，经 localStorageLink 调 FFI；IPC 名称不表示当前另起存储进程或 Socket 服务。
|
||||
- FFI 两端是 `chusql-core/engine/src/ChuSQL/Core/Engine/Storage/FFI.hs` 与 `chusql-core/storage/src/ffi.rs`，方向 Haskell → Rust，没有回调 ABI。
|
||||
- 存储 JSON 定义于 `chusql-core/model/src/ChuSQL/Core/Protocol.hs` 与 `chusql-core/storage/src/protocol.rs`；它与 Interface TCP 属于不同协议。
|
||||
|
||||
## ABI 与所有权
|
||||
|
||||
下表符号均带 chusql_storage_ 前缀；Rust usize 对 Haskell CSize、i32 对 CInt，句柄使用 Ptr ()。不直接跨语言传 Rust struct、enum、Vec 或 Haskell 对象布局。
|
||||
|
||||
| 符号 | C ABI 形状 | 契约 |
|
||||
| --- | --- | --- |
|
||||
| version | () → const char* | 静态 NUL 字符串，不释放 |
|
||||
| open | const char* → Storage* | NULL 路径用默认；失败 NULL，成功由 close 归还 |
|
||||
| close | Storage* → void | NULL 安全；非空句柄只关闭一次 |
|
||||
| request | const Storage*, const u8*, usize, u8**, usize* → i32 | 输入借用；输出由 Rust 分配；0 / -1 |
|
||||
| maintenance | const char*, const u8*, usize, u8**, usize* → i32 | 离线操作；响应 ownership 同 request |
|
||||
| free | u8*, usize → void | 归还原始指针 / 长度对，不跨分配器、不重复释放 |
|
||||
| last_error | usize* → const u8* | 借用线程局部错误，立即复制、不释放 |
|
||||
|
||||
## Invariants
|
||||
|
||||
- 路径为 NUL 结尾 UTF-8；请求 / 响应为显式长度 UTF-8 JSON，响应不保证 NUL 结尾，不能用 C 字符串函数读取。
|
||||
- Haskell request 使用 Ptr CChar、CSize、Ptr (Ptr CChar)、Ptr CSize 并返回 CInt，maintenance 以 CString 替代句柄。改签名同步两端与实际动态库。
|
||||
- 借用指针整个调用中有效，输出可写且不与输入或其他输出重叠。Rust 拒绝 NULL / 超过 isize::MAX 的请求长度，但不能验证非空指针的分配范围 / provenance；catch_unwind 不是非法指针保护。
|
||||
- 成功输出是 Box<[u8]> 转出的所有权；Haskell callStorage 复制后 finally 调 free，失败清空输出。保留取消屏蔽，避免复制 / 释放窗口泄漏。
|
||||
- open / request / maintenance 捕获 Rust panic，经 NULL / -1 和 last_error 返回；业务错误也可能是 ABI 成功响应中的 JSON error，两层失败都要处理。
|
||||
- close / free 捕获析构 panic 但没有状态返回，当前忽略捕获结果；不能依靠析构保证提交或宣称它报告落盘失败。
|
||||
- onStorageThread 在支持 bound threads 的 RTS 中绑定调用和错误读取到同一 OS 线程；last_error 缓冲只到本线程下次设置错误前有效。
|
||||
- Haskell open / close / request / maintenance 是 safe ccall，version / free / last_error 是 unsafe ccall；长 I/O 不改为 unsafe。请求期间不得关闭句柄。
|
||||
- IPC 的 withStorageLink 计数在途请求，closeConnection 等空闲再关闭；不绕过它更换 / 释放链路。Env 保存会话工作库，不把全局默认库当多连接状态。
|
||||
- Interface TCP 是一行 UTF-8 JSON，Hello 校验 protocolVersion=1；同一 Client 的 MVar 串行化请求 / 响应。Server 每连接建 Session 并限制行长度，客户端锁不是全局数据库锁。
|
||||
- SchemaColumn 字段、method / status 标签、缺省字段、错误码及 QueryResult columns / rows 的位置关系是消费者契约，不用自动派生构造器名替代稳定标签。
|
||||
- 复合值标签为 __chusql_runtime_v1，由 Core.Runtime 编解码；Rust 行仍是通用 JSON。封装变化检查 CLI / Web / 存储重载，Web 数值受 JavaScript 安全整数限制。
|
||||
- 原始存储透传仍经过 Server 会话鉴权；新入口核对 TCP 分派、会话策略与 Web 消费者，不绕过对象权限或业务错误。
|
||||
|
||||
## Engineering Decisions
|
||||
|
||||
优先扩展共享协议与真实调用者，不增加无用途适配层；确认无人依赖的内部接口可直接调整。新增类型化值沿 JSON 载荷传递，只有实际需要才扩展 ABI。
|
||||
Rust panic、Haskell IO 失败与业务错误按边界转成明确失败；当前没有自动 ABI 兼容协商或后台回调生命周期管理。
|
||||
|
||||
## Validation
|
||||
|
||||
- ABI / ownership 变更验证 `chusql-core/storage/tests/ffi_test.rs` 的成功、错误、长度、编码和释放路径；必要时用可用 Miri，不为普通消息变更强制安装工具。
|
||||
- 存储协议变化测试相关 Rust 模块并重建实际 cdylib，再串行验证受影响 Haskell 模块；rlib 或 mock 不能证明实际 FFI 可用。
|
||||
- TCP 改动验证 Hello、错误响应和真实消费者，复用 `chusql-server/test/Spec.hs`、`chusql-web/test/Spec.hs`、`chusql-cli/test/Spec.hs` 中相关行为。
|
||||
- 入口见 `gate-check/run-step.ps1`，测试范围按风险决定，不自动运行所有者全量门禁。
|
||||
|
||||
## References
|
||||
|
||||
Web 值展示 / SQL 生成消费者见 `chusql-web/static/core.js`；总体路径见 `docs/architecture.md`。核对协议时读两端编码 / 解码和调用者，不依赖绝对行号。
|
||||
@@ -0,0 +1,53 @@
|
||||
---
|
||||
name: chusql-storage-integrity
|
||||
description: 修改 ChuSQL 存储页、索引、序列化、catalog、系统元数据、初始化、持久化事务或恢复时使用；维护实际落盘顺序与恢复约束。普通 SQL 表达式或界面任务不加载。
|
||||
---
|
||||
|
||||
# ChuSQL 存储完整性
|
||||
|
||||
## Scope
|
||||
|
||||
负责持久化状态及其与服务端事务的关系。类型语义使用 chusql-type-system，接口生命周期使用 chusql-boundary-contracts；不照搬 PostgreSQL 内核设计。路径相对仓库根目录，只读受影响模块。
|
||||
|
||||
## Architecture
|
||||
|
||||
- `chusql-core/storage/src/runtime.rs`：Storage 持有数据目录文件锁、管理数据库；Server 管每库 catalog、WAL、表缓存和读写门。
|
||||
- 数据根目录中 system/ 保存系统库，databases/<name>/ 保存业务库。每库有 catalog.json、<table>.db、内建 <table>.idx、其他 <table>.<column>.idx、wal.log 与 wal.checkpoint；诊断日志由 log_files 单独配置。
|
||||
- `chusql-core/storage/src/page.rs` 管定长页与缓存刷盘；`heap.rs` 管页内槽位、JSON 行、隐藏列和 compact；`btree.rs` 管变长字节键、重复键与叶子链范围扫描。
|
||||
- `chusql-core/storage/src/catalog.rs` 管 schema、索引、统计、隐藏列、对象编号 / 高水位；`protocol.rs` 定义线上 schema 和系统表常量。
|
||||
- `chusql-core/storage/src/wal.rs` 管 LSN、提交组、日志扫描与检查点；runtime.rs 的 group_via_wal、recover_wal、replay_op 连接记录与应用。
|
||||
- `chusql-server/src/ChuSQL/Server/Session.hs` 管会话快照、保存点、差分与冲突；`Backend.hs` 向存储提交操作。`chusql-bootstrap/` 调用 Storage::maintenance 与 maintenance_candidate 做离线维护。
|
||||
|
||||
## Invariants
|
||||
|
||||
- 表存在性以 catalog 为准，文件存在不表示已登记；不能靠打开文件创建逻辑表。语义与优化只读取 schema。
|
||||
- Catalog::save 写 pending 文件、同步后替换；单文件替换不等于 catalog、页与索引已整体原子提交。
|
||||
- 普通组先 append_group 落盘，再设置 recovery_required，然后应用、刷表、推进检查点、截断日志，全部成功才解除恢复状态。
|
||||
- 应用 / 刷盘 / 检查点 / 截断失败必须保持恢复状态并报错。普通业务请求被阻断；Ping / SystemStatus 例外由各自分派层处理，新增入口不得绕过状态。
|
||||
- 恢复仅重放检查点之后已提交组，保持 replay_op 幂等；不应用未提交组。现有 WAL 是 redo，检查点是库级 LSN，不是 undo 或页级恢复。
|
||||
- 账号引导 / 变更存在独立 WAL 路径，不能假定所有写入都走普通组函数。
|
||||
- 库 / 表对象和身份编号依赖持久化高水位，删除后不复用；迁移不能降低计数器，不能从现存对象推断已删除编号上限。
|
||||
- 系统身份 / 凭据、角色、授权、类型与 DOMAIN 元数据保持对应关系。引导保留已有口令和降权状态，拒绝定义 / 保留文件冲突；类型目录不是可动态扩展基础类型的机制。
|
||||
- 数据目录锁覆盖存储和维护生命周期；维护前停止占用进程。每库读共享 / 写独占、表句柄加锁，不假定同库跨表并行写。
|
||||
- 会话事务是整库内存快照，无嵌套事务，事务内禁止 DDL / USE。提交跳过未修改表，整数 id 按键差分，否则整表比较 / 替换；对象身份和权限需复查，冲突返回 serialization_failure 并保留事务。
|
||||
- 页内 compact 保留槽位编号与索引位置；隐藏列 compact 可能整表重写。布局、键编码、行序和隐藏列改动须检查真实消费者。
|
||||
- 页大小、B+Tree magic / 布局、槽位小端字段、JSON 行、WAL 标签 / 帧和 catalog 字段是格式契约。改变前明确加载、迁移或拒绝策略，不以重新初始化掩盖不兼容。
|
||||
|
||||
## Engineering Decisions
|
||||
|
||||
- 优化可减少分配或重复读取，但保留验证、刷盘顺序、错误传播与可观察行序。结构变更同时核对 WAL、应用、幂等恢复与 catalog 保存。
|
||||
- 数据库目录建删不走普通表 WAL，删库使用墓碑目录；不能承诺表提交组相同的崩溃原子性。
|
||||
- 离线维护在候选目录操作并保留备份；repair 不改既有表数据，recover 依赖可用 WAL，reset 重建系统目录且保留业务库。失败保留原目录 / 恢复材料。
|
||||
- 当前 Catalog::load 对不存在或空文件返回空目录，JSON 损坏报错；不能宣称所有损坏都会拒绝。rename_table_files 和部分析构 / 清理路径仍忽略 I/O 错误，不作为成功持久化保证。
|
||||
- 尚无行版本 MVCC、页级恢复、跨页填洞、并行写或通用结构迁移事务，不据此放松校验。
|
||||
|
||||
## Validation
|
||||
|
||||
- 按影响选择 `chusql-core/storage/tests/` 的 page / heap / btree / catalog / wal / runtime 测试；说明修正核对源码即可。
|
||||
- 格式 / 元数据 / WAL 改动验证重开、提交前后中断、重复恢复、缺失 / 截断 / 损坏输入与失败后状态；断言须检测实际不一致。
|
||||
- 会话差分 / 冲突变更还验证 `chusql-server/test/Spec.hs`；并发压力测试不是正确性证明。
|
||||
- 规定入口为 `gate-check/run-step.ps1 -Kind cargo`，动态库构建为 -Kind build；受影响 Haskell 模块按脚本命令串行构建，全量门禁遵守 AGENTS.md。
|
||||
|
||||
## References
|
||||
|
||||
恢复操作按需读 `docs/bootstrap.md`，配置见 `docs/config.md`，限制见 `.agents/context/known-issues.txt`；涉及拟议能力时仍以源码为准。
|
||||
@@ -0,0 +1,48 @@
|
||||
---
|
||||
name: chusql-type-system
|
||||
description: 修改 ChuSQL SQL 类型、值表示、赋值转换、类型推导、函数或表达式语义时使用；提供类型模块职责与一致性约束。仅调整界面样式或无关存储性能时不加载。
|
||||
---
|
||||
|
||||
# ChuSQL 类型系统
|
||||
|
||||
## Scope
|
||||
|
||||
负责类型语义；落盘顺序交给 chusql-storage-integrity，传输契约交给 chusql-boundary-contracts。通用语言与测试规范使用已有 Skills，不重复加载。下列路径相对仓库根目录，只读本次相关模块。
|
||||
|
||||
## Architecture
|
||||
|
||||
- `chusql-core/model/src/ChuSQL/Core/Model.hs`：`ColumnType`、列约束、`Value`；集中提供 `assignable`、`comparableTypes`、`valueFits`、`coerceValue`、相等与哈希语义。
|
||||
- `chusql-core/model/src/ChuSQL/Core/Runtime.hs`：`TypeExpr` / `TypeId`、`Kind`、独立 `PhysicalType`、`RuntimeValue`、注册表和版本化编码；Engine 的 `Runtime/Types.hs` 只是重新导出。
|
||||
- `chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs` 与 `Syntax/AST.hs` 解析声明和构造表达式；`Semantic.hs` 根据 schema 解析 DOMAIN、推导表达式并绑定身份。
|
||||
- `chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Functions.hs` 定义固定 FunctionId 与签名，现有函数 length / not；`Runtime/SQL.hs` 连接 SQL 标量和运行时值。
|
||||
- `chusql-core/engine/src/ChuSQL/Core/Engine/Runtime/Query.hs` 的 BoundQuery 保存 schema、输出类型和优化后的 RelOp，执行后按位置校验。`Runtime/Binding.hs` 另提供类型化表达式与基础计划，尚未替代完整 SQL 关系代数。
|
||||
- `chusql-core/model/src/ChuSQL/Core/Protocol.hs` 共享值的 JSON 转换；Rust 的 `chusql-core/storage/src/protocol.rs` 使用 `HashMap<String, serde_json::Value>` 保存行。
|
||||
|
||||
## Invariants
|
||||
|
||||
- 构造器编号固定：Int=1、Double=2、Bool=3、String=4、List=5、Maybe=6、Tuple=7。使用 resolveType 检查参数 / kind，不把显示名当身份，不再维护第二份注册表。
|
||||
- CRuntime / VRuntime 身份必须匹配；递归检查列表元素、Maybe 内容与元组字段数，Double 必须有限。保留逻辑类型与物理表示的区别。
|
||||
- SQL VNull 与 RMaybe Nothing 不同；CNull 是查询推导类型，不能声明为存储列。保留三值逻辑与函数 NULL 传播。
|
||||
- 赋值兼容和比较兼容分别使用 Model 入口。coerceValue 负责值收敛；整值浮点转整数、字符串长度、日期格式、DECIMAL 舍入沿现有规则处理，不在 Parser / Eval / Web 重复实现转换。
|
||||
- 整数与可规范化整值浮点保持相等 / 哈希一致。底层 compareValue 的实现不表示 SQL 已开放该类型的比较、排序、分组或索引。
|
||||
- DOMAIN 使用 domainTableName 与目录定义解析基础类型、依赖及循环；不能拿解析器占位基础类型直接执行。系统内建类型目录也不是通过增加行即可扩展的插件注册表。
|
||||
- Date / Timestamp / Blob 在 QueryType 保留 CompatibilityType；ColumnType 与 RelOp 仍有真实消费者，不能作为无用兼容层删除。
|
||||
- 类型 / 值编码版本为 1；身份、类型名、封装或值结构变化可能影响 catalog、WAL、FFI、TCP 和 Web，组合相关 Skills 核对消费者。
|
||||
- Rust 当前保存通用 JSON，只做局部校验（隐藏列、DOMAIN 依赖、DECIMAL 规范化），没有 Haskell validateValue 的完整等价检查；不要依赖原始存储请求完成所有 SQL 类型校验。
|
||||
- 错误沿 Either String 返回；`chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs` 用消息规则映射类别 / 协议码。修改错误文字须检查分类，不用默认值或 NULL 掩盖错误。
|
||||
|
||||
## Engineering Decisions
|
||||
|
||||
复用 Model / Runtime 的语义入口，在现有类型桥上做最小修改。尚无完整 capability / operator / cast 注册机制、通用显式 CAST、用户 ADT 或 Extension；DOMAIN 自身 CHECK / NOT NULL / DEFAULT 尚未实现。不要将规划当现有契约。
|
||||
DECIMAL 是有限浮点表示，采用 ties-to-even 舍入与舍入后溢出检查，并非精确十进制存储。运行时复合类型尚无 SQL Eq / Ord / Hash capability 字典。
|
||||
|
||||
## Validation
|
||||
|
||||
- 语义改动验证解析 → schema 绑定 → 执行，关注 NULL、边界值、明确错误与输出位置；说明修正只需核对源码。
|
||||
- 复用 `chusql-core/engine/test/RuntimeSpec.hs`、`chusql-core/engine/test/Spec.hs`，按需覆盖固定编码、错误身份和嵌套值。
|
||||
- 持久化类型变更验证 Rust 写入 / 重载与实际协议消费者；Web 值展示 / SQL 生成参考 `chusql-web/test/runtime-values.mjs`。
|
||||
- 测试入口见 `gate-check/run-step.ps1`，不因加载 Skill 自动执行全量门禁或追求覆盖率。
|
||||
|
||||
## References
|
||||
|
||||
按需读 `docs/types.md`，区分当前类型用法与未来约束设计。以上源码模块是契约核对入口。
|
||||
@@ -1,11 +0,0 @@
|
||||
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
|
||||
@@ -0,0 +1,14 @@
|
||||
# 构建状态：调用共用 Linux 构建流程。
|
||||
name: build
|
||||
on:
|
||||
push:
|
||||
pull_request:
|
||||
merge_group:
|
||||
workflow_dispatch:
|
||||
permissions:
|
||||
contents: read
|
||||
jobs:
|
||||
build:
|
||||
uses: ./.github/workflows/linux.yml
|
||||
with:
|
||||
phase: build
|
||||
@@ -0,0 +1,11 @@
|
||||
# 门禁状态：仅由所有者手动触发全量入口。
|
||||
name: gate
|
||||
on:
|
||||
workflow_dispatch:
|
||||
permissions:
|
||||
contents: read
|
||||
jobs:
|
||||
gate:
|
||||
uses: ./.github/workflows/linux.yml
|
||||
with:
|
||||
phase: gate
|
||||
@@ -0,0 +1,131 @@
|
||||
# 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
|
||||
@@ -0,0 +1,163 @@
|
||||
# 发版流水线：构建 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
|
||||
+103
-9
@@ -1,11 +1,105 @@
|
||||
/target/
|
||||
/data/
|
||||
.env
|
||||
node_modules/
|
||||
# ============================================================
|
||||
# ChuSQL 单仓库 .gitignore
|
||||
# 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/
|
||||
.astro/
|
||||
*.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
|
||||
.env.*.local
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# 日志
|
||||
# ------------------------------------------------------------
|
||||
*.log
|
||||
/deploy/bin/
|
||||
/deploy/secrets/
|
||||
__pycache__/
|
||||
*.pyc
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# 编辑器 / IDE
|
||||
# ------------------------------------------------------------
|
||||
.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
|
||||
@@ -1,6 +0,0 @@
|
||||
[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
|
||||
@@ -0,0 +1,52 @@
|
||||
[
|
||||
{
|
||||
"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",
|
||||
},
|
||||
]
|
||||
@@ -0,0 +1,41 @@
|
||||
# AGENTS.md — ChuSQL 开发契约
|
||||
|
||||
参考：
|
||||
- 唯一进度与验收来源：`.agents/context/progress.txt`（等价于 project-plan.txt）。
|
||||
- 限制与设计：`.agents/context/known-issues.txt`、`.agents/context/design-decisions.txt`。
|
||||
|
||||
## 核心约束
|
||||
- 测试必须通过，禁止绕过检查。
|
||||
- 不吞错误，使用明确错误返回。
|
||||
- FFI 响应由 Rust 分配并通过配套 free 归还；句柄关闭不得与请求并发。
|
||||
- 表存在性以 catalog 为准。
|
||||
- 语义检查和优化只使用 schema。
|
||||
- 索引由存储层管理，优化器只判断可点查条件。
|
||||
- 优化不能改变结果语义。
|
||||
- 持久化、事务、并发、类型及 FFI 改动优先维护不变量、内存所有权与错误传播；保留必要的迁移和恢复约束。
|
||||
|
||||
## 开发方式
|
||||
- 按任务选择已安装 Skills：编码用 ponytail / karpathy-guidelines，审查与简化按需用 ponytail-review；Rust、FFI、测试及覆盖率分别使用对应项目技能。
|
||||
- 类型、值、转换或表达式语义用 `chusql-type-system`；存储、序列化、系统目录、初始化或恢复用 `chusql-storage-integrity`；FFI、跨组件协议、序列化契约或外部接口用 `chusql-boundary-contracts`（均在 `.agents/skills/`）。
|
||||
- 跨领域组合相关 Skills，无关任务不加载；Skills 不覆盖更高优先级的安全和工程约束。
|
||||
- 简单任务直接执行；采用最小必要改动，允许有明确收益且能验证的局部结构优化，优先删除重复和无用代码。
|
||||
- 保持代码最简：用最少且易读的代码完整解决当前需求，优先复用现有实现与标准库；相同规则只维护一份，不引入仅为缩短函数或预留未来而存在的抽象、包装、配置和依赖。简化须保持求值顺序、错误传播、边界校验及恢复约束，不以压缩行数牺牲清晰度或正确性。
|
||||
- Haskell 编码后对受影响源码运行 HLint（与 nvim 的提示来源一致），修复能保持语义的建议；不通过禁用提示绕过检查。优先使用 `void`、`when/unless`、`fromMaybe`、`isJust/isNothing`、`maybeToList`、`zipWithM` 等惯用函数，避免冗余 lambda、括号、绑定、导入与 LANGUAGE pragma；涉及惰性、严格性或类型表示变化的建议须核对语义，不能机械套用。
|
||||
- 测试强度与实际风险及影响范围匹配，不机械新增测试，不盲目追求覆盖率；数据库内核微改动也须验证关键行为。
|
||||
- 不强制 TDD、子代理或多阶段审查；减少无关读取、重复搜索、工具调用和输出，Skills 不应增加无收益的流程。
|
||||
- 文档描述当前状态；不创建整改报告、修改流水账或无用途的兼容层，不修改 Git 历史。
|
||||
|
||||
## 注释规范
|
||||
- 文件级：外部引用语句（Haskell `import`、Rust `use`、JS `import`、HTML 的 `<link>`/`<script>`、
|
||||
CSS `@import`、脚本的依赖/参数区）之后写一段注释，概括本文件的功能；没有引用语句的文件写在
|
||||
文件开头。长度不超过 3 行、合计不超过 90 字。
|
||||
- 函数级：每个函数（含 Haskell 的 `where`/`let` 内函数、Rust 的私有 `fn`）前用一行不超过
|
||||
30 字的注释说明它做什么。
|
||||
- 摘要说明做什么；仅在必要处补充不直观的不变量、所有权与安全约束，不记录历史和被删实现。
|
||||
|
||||
## 协作规则
|
||||
- 全量门禁入口：`gate-check/run-gate.ps1`（三条车道并行，日志写仓库根的 `logs/`）。
|
||||
- 局部改动运行受影响模块的规定测试；较大改动由 agent 执行全量门禁，通过后再提交。
|
||||
- engine / web / storage 使用规定测试入口。
|
||||
- 规定入口见 `gate-check/run-step.ps1`；Haskell 构建串行，存储协议改动须重建实际动态库。
|
||||
- 改动说明只在交流中记录。
|
||||
Generated
-1811
File diff suppressed because it is too large.
Load diff
@@ -1,4 +0,0 @@
|
||||
[workspace]
|
||||
members = ["apps/api"]
|
||||
exclude = ["external/ChuSQL", "external/ChuSQL-RustDriver"]
|
||||
resolver = "3"
|
||||
@@ -0,0 +1,21 @@
|
||||
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.
|
||||
@@ -1,225 +0,0 @@
|
||||
# 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 元数据索引。这样即使数据库研发推迟，博客仍可独立推进。
|
||||
@@ -1,169 +1,55 @@
|
||||
# ChuBlog
|
||||
# ChuSQL
|
||||
|
||||
Rust/Axum 博客后端。文章作者在本地编辑 Markdown，通过受限 SSH Git 推送发布。注册、登录、权限管理使用 HTTP API；文章仅通过 Git 修改。ChuSQL 通过外部子模块 `external/ChuSQL-RustDriver` 接入，只存可重建索引。
|
||||
<p align="center">
|
||||
<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&label=build&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&label=tests&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>
|
||||
|
||||
本轮按最新需求只实现后端，没有前端或在线文章管理。`PLAN.md` 保留原始规划，当前范围与后续安排见 [TODO.md](TODO.md)。
|
||||
ChuSQL 是采用 Haskell SQL 引擎与 Rust 存储层的数据库项目，提供 TCP 服务、CLI 和 Web 管理端。支持查询优化、快照事务、WAL 崩溃恢复、DOMAIN 自定义类型及用户与角色管理。
|
||||
|
||||
## 项目与运行
|
||||
## 快速开始
|
||||
|
||||
```text
|
||||
ChuBlog/
|
||||
├── apps/api/
|
||||
├── external/
|
||||
│ ├── ChuSQL/ # Git 子模块，主仓库只记录版本指针
|
||||
│ └── ChuSQL-RustDriver/ # Git 子模块
|
||||
└── scripts/init-deps.py
|
||||
```
|
||||
### 安装
|
||||
|
||||
项目提供两个 HTTPS 仓库，任选其一克隆：
|
||||
Linux / macOS：
|
||||
|
||||
```sh
|
||||
git clone https://github.com/TheBadRoger/ChuBlog.git
|
||||
# 或：git clone https://repo.chunana.cn/ChuNa7a/ChuBlog.git
|
||||
cd ChuBlog
|
||||
python3 scripts/init-deps.py
|
||||
curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web
|
||||
```
|
||||
|
||||
数据库和驱动均提供两个 HTTPS 源：
|
||||
Windows（PowerShell 里下下来再跑；也有下载 zip 解压的包内安装）：
|
||||
|
||||
| 依赖 | GitHub | 自建仓库 |
|
||||
| --- | --- | --- |
|
||||
| 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 |
|
||||
```powershell
|
||||
irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1"
|
||||
& "$env:TEMP\install.ps1" -Component web
|
||||
```
|
||||
|
||||
初始化先尝试 GitHub HTTPS，连接、访问或固定提交获取失败时回退自建 HTTPS，无需 SSH 身份。已正确初始化的固定版本直接复用，有未提交修改时拒绝覆盖；回退不改为任意最新分支。项目不设置全局 `insteadOf`、localhost 映射、OS 用户或服务器 SSH 配置。
|
||||
|
||||
开发电脑仍可显式选择已有本地来源（仅开发覆盖参数，不是服务器默认流程）；只读取已提交版本：
|
||||
### 启动
|
||||
|
||||
```sh
|
||||
python3 scripts/init-deps.py --database-repo ../ChuSQL --driver-repo ../ChuSQLDriver
|
||||
csql
|
||||
```
|
||||
|
||||
子模块固定到已提交版本；源仓库必须包含这些提交。依赖源码和构建产物不进入博客仓库，更新依赖时只提交 `.gitmodules`/配置及子模块指针。不要对主仓库使用 `git add --force` 重新收录依赖文件。
|
||||
|
||||
|
||||
开发检查：
|
||||
启动CLI界面，或
|
||||
|
||||
```sh
|
||||
cargo test --all-targets
|
||||
cargo fmt --check
|
||||
cargo clippy --all-targets -- -D warnings
|
||||
csql-web
|
||||
```
|
||||
|
||||
部署基于 Debian 13。`scripts/deploy.sh` 会使用同一个依赖初始化脚本，自动在上述两个 HTTPS 源之间回退，再构建外部数据库与 Docker 镜像；沿用运行者现有的 Git 配置，不在项目内覆盖服务器环境。
|
||||
启动web界面，默认通过7778端口访问
|
||||
|
||||
```sh
|
||||
scripts/deploy.sh
|
||||
```
|
||||
## 更多参考文档
|
||||
|
||||
首次部署先准备 `.env`；也可以手动执行以下同架构构建步骤：
|
||||
|
||||
```sh
|
||||
# ChuSQL 尚未编译时，先按其项目说明构建 Rust 存储库、server 与 bootstrap。
|
||||
python3 scripts/prepare-deploy.py --build-database
|
||||
cp .env.example .env
|
||||
chmod 600 .env
|
||||
# 从标准输入输入管理员口令，Ctrl-D 结束；不要把明文写进命令行历史。
|
||||
./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 使用 ``，不允许外链图片。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 缓存和旧提交直链的回收由平台管理。
|
||||
- [安装与卸载](docs/install.md)
|
||||
- [配置选项](docs/config.md)
|
||||
- [命令与选项](docs/commands.md)
|
||||
- [SQL 语法](docs/syntax.md)
|
||||
- [类型与类型目录](docs/types.md)
|
||||
- [用户、角色与属性](docs/users-and-roles.md)
|
||||
- [系统引导与恢复](docs/bootstrap.md)
|
||||
- [架构与组件](docs/architecture.md)
|
||||
- [性能基准与瓶颈分析](docs/performance.md)
|
||||
@@ -1,64 +0,0 @@
|
||||
# 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 仓库上新增未经协调的第二个写入口。
|
||||
@@ -1,27 +0,0 @@
|
||||
[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"] }
|
||||
@@ -1,669 +0,0 @@
|
||||
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": "请使用新口令重新登录"}),
|
||||
))
|
||||
}
|
||||
@@ -1,374 +0,0 @@
|
||||
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(())
|
||||
}
|
||||
@@ -1,145 +0,0 @@
|
||||
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)
|
||||
}
|
||||
@@ -1,330 +0,0 @@
|
||||
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, ¤t).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;
|
||||
@@ -1,274 +0,0 @@
|
||||
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, ¤t.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(())
|
||||
}
|
||||
@@ -1,666 +0,0 @@
|
||||
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](javascript:alert%281%29)",
|
||||
"",
|
||||
"",
|
||||
"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);
|
||||
}
|
||||
@@ -0,0 +1,25 @@
|
||||
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
|
||||
@@ -0,0 +1,645 @@
|
||||
{-# 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)
|
||||
@@ -0,0 +1,12 @@
|
||||
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
|
||||
@@ -0,0 +1,12 @@
|
||||
# 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
|
||||
@@ -0,0 +1,167 @@
|
||||
{-# 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
|
||||
@@ -0,0 +1,43 @@
|
||||
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
|
||||
@@ -0,0 +1,77 @@
|
||||
{-# 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"
|
||||
@@ -0,0 +1,10 @@
|
||||
resolver: lts-24.59
|
||||
|
||||
extra-lib-dirs:
|
||||
- ../chusql-core/storage/target/release
|
||||
|
||||
packages:
|
||||
- .
|
||||
- ../chusql-core/engine
|
||||
- ../chusql-core/model
|
||||
- ../chusql-interface
|
||||
@@ -0,0 +1,12 @@
|
||||
# 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
|
||||
@@ -0,0 +1,135 @@
|
||||
{-# 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)
|
||||
@@ -0,0 +1,186 @@
|
||||
{-# 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"))
|
||||
@@ -0,0 +1,197 @@
|
||||
{-# 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
|
||||
@@ -0,0 +1,66 @@
|
||||
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
|
||||
@@ -0,0 +1,113 @@
|
||||
{-# 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)
|
||||
@@ -0,0 +1,21 @@
|
||||
{-# 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)))
|
||||
@@ -0,0 +1,75 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.CLI.Normalization (normalizationArguments, loadNormalizationDeclaration, renderNormalization, runNormalizationOnce) where
|
||||
|
||||
import ChuSQL.Interface.Normalization
|
||||
import ChuSQL.Interface.Session (Session, sessionDatabase, analyzeNormalization)
|
||||
import Control.Exception (IOException, try)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.Text.IO as TIO
|
||||
import System.IO (IOMode (ReadMode), stderr, withBinaryFile)
|
||||
import Text.ParserCombinators.ReadP
|
||||
|
||||
-- CLI 范式入口：读取严格声明文件、发送专用请求并显示报告。
|
||||
|
||||
-- 解析表、声明路径和独立显示格式。
|
||||
normalizationArguments :: Text -> Either Text (Text, FilePath, Bool)
|
||||
normalizationArguments input = case readP_to_S (skipSpaces *> sepBy token skipSpaces <* skipSpaces <* eof) (T.unpack input) of
|
||||
[(parts, "")] -> case parts of
|
||||
[table, "--declaration", file] -> Right (T.pack table, file, False)
|
||||
[table, "--declaration", file, "--format", "text"] -> Right (T.pack table, file, False)
|
||||
[table, "--declaration", file, "--format", "json"] -> Right (T.pack table, file, True)
|
||||
_ -> Left usage
|
||||
_ -> Left usage
|
||||
where
|
||||
usage = "usage: \\normalize TABLE --declaration FILE [--format text|json]"
|
||||
-- 保留引号内的 Windows 路径及空格。
|
||||
token = quoted '"' <++ quoted '\'' <++ munch1 (\c -> c /= ' ' && c /= '\t' && c /= '\n' && c /= '"' && c /= '\'')
|
||||
-- 读取不带转义解释的引号参数。
|
||||
quoted quote = char quote *> munch (/= quote) <* char quote
|
||||
|
||||
-- 有界读取 UTF-8 声明并拒绝重复字段。
|
||||
loadNormalizationDeclaration :: FilePath -> IO (Either Text NormalizationDeclaration)
|
||||
loadNormalizationDeclaration path = do
|
||||
loaded <- try (withBinaryFile path ReadMode (`BS.hGet` 65537)) :: IO (Either IOException BS.ByteString)
|
||||
pure $ case loaded of
|
||||
Left err -> Left (T.pack (show err))
|
||||
Right raw -> do
|
||||
value <- decodeNormalizationJSON (BL.fromStrict raw)
|
||||
case A.fromJSON value of
|
||||
A.Error message -> Left (T.pack message)
|
||||
A.Success declaration -> Right declaration
|
||||
|
||||
-- 保留报告字段并选择文本或 JSON 显示。
|
||||
renderNormalization :: Bool -> A.Value -> Text
|
||||
renderNormalization True = jsonText
|
||||
renderNormalization False = pretty 0
|
||||
|
||||
-- 将 JSON 编码为 UTF-8 文本。
|
||||
jsonText :: A.Value -> Text
|
||||
jsonText = TE.decodeUtf8 . BL.toStrict . A.encode
|
||||
|
||||
-- 缩进展示完整报告且保留所有证据。
|
||||
pretty :: Int -> A.Value -> Text
|
||||
pretty depth (A.Object fields) = T.intercalate "\n" [indent <> K.toText key <> ":\n" <> pretty (depth + 1) value | (key, value) <- KM.toList fields]
|
||||
where indent = T.replicate depth " "
|
||||
pretty depth value = T.replicate depth " " <> jsonText value
|
||||
|
||||
-- 发送声明并让失败决定 CLI 退出码。
|
||||
runNormalizationOnce :: Session -> Text -> FilePath -> Bool -> IO Bool
|
||||
runNormalizationOnce session table path jsonOutput = do
|
||||
declaration <- loadNormalizationDeclaration path
|
||||
database <- sessionDatabase session
|
||||
result <- case declaration of
|
||||
Left message -> pure (Left message)
|
||||
Right d -> analyzeNormalization session (NormalizationRequest 1 database table d Nothing Nothing)
|
||||
case result of
|
||||
Left message -> TIO.hPutStrLn stderr ("chusql: error: " <> message) >> pure False
|
||||
Right analysis -> TIO.putStrLn (renderNormalization jsonOutput analysis) >> pure True
|
||||
@@ -0,0 +1,14 @@
|
||||
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
|
||||
@@ -0,0 +1,131 @@
|
||||
{-# 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."
|
||||
]
|
||||
@@ -0,0 +1,13 @@
|
||||
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
|
||||
@@ -0,0 +1,12 @@
|
||||
# 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
|
||||
@@ -0,0 +1,216 @@
|
||||
{-# 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)
|
||||
@@ -0,0 +1,78 @@
|
||||
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
|
||||
@@ -0,0 +1,528 @@
|
||||
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)
|
||||
@@ -0,0 +1,67 @@
|
||||
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)
|
||||
@@ -0,0 +1,700 @@
|
||||
{-# 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
|
||||
@@ -0,0 +1,317 @@
|
||||
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]
|
||||
@@ -0,0 +1,220 @@
|
||||
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
|
||||
@@ -0,0 +1,94 @@
|
||||
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) ' '
|
||||
@@ -0,0 +1,321 @@
|
||||
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))
|
||||
@@ -0,0 +1,139 @@
|
||||
{-# 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)]
|
||||
@@ -0,0 +1,55 @@
|
||||
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
|
||||
@@ -0,0 +1,315 @@
|
||||
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
|
||||
@@ -0,0 +1,82 @@
|
||||
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"
|
||||
@@ -0,0 +1,151 @@
|
||||
module ChuSQL.Core.Engine.Normalization where
|
||||
|
||||
import ChuSQL.Core.Model (Column)
|
||||
import Data.List (nub, sort, subsequences, (\\))
|
||||
|
||||
-- 只读范式分析：声明验证、阿姆斯特朗闭包、候选键与分解建议。
|
||||
|
||||
type Attributes = [String]
|
||||
data Dependency = Dependency Attributes Attributes deriving (Eq, Show)
|
||||
data Verdict = Satisfied | Violated | Insufficient deriving (Eq, Show)
|
||||
data NormalForm = NF1 | NF2 | NF3 | BCNF deriving (Eq, Show)
|
||||
data Declaration = Declaration
|
||||
{ declaredKeys :: [Attributes]
|
||||
, dependencies :: [Dependency]
|
||||
, dependenciesComplete :: Bool
|
||||
, atomicAttributes :: Maybe Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
data Finding = Finding
|
||||
{ normalForm :: NormalForm
|
||||
, verdict :: Verdict
|
||||
, witnesses :: [Dependency]
|
||||
, condition :: String
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
data Decomposition = Decomposition
|
||||
{ relations :: [Attributes]
|
||||
, losslessJoin :: Verdict
|
||||
, dependencyPreserving :: Verdict
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
data Analysis = Analysis
|
||||
{ candidateKeys :: [Attributes]
|
||||
, findings :: [Finding]
|
||||
, suggestions :: [Decomposition]
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- 规范化属性集合。
|
||||
canonical :: Attributes -> Attributes
|
||||
canonical = sort . nub
|
||||
|
||||
-- 判断属性集合包含关系。
|
||||
subset :: Attributes -> Attributes -> Bool
|
||||
subset xs ys = all (`elem` ys) xs
|
||||
|
||||
-- 用自反、增广和传递规则求闭包。
|
||||
attributeClosure :: [Dependency] -> Attributes -> Attributes
|
||||
attributeClosure f seed = fixed (canonical seed)
|
||||
where
|
||||
-- 迭代加入已蕴含的属性。
|
||||
fixed xs =
|
||||
let ys = canonical (xs ++ concat [b | Dependency a b <- f, subset a xs])
|
||||
in if xs == ys then xs else fixed ys
|
||||
|
||||
-- 判断声明是否蕴含依赖。
|
||||
implies :: [Dependency] -> Dependency -> Bool
|
||||
implies f (Dependency a b) = subset b (attributeClosure f a)
|
||||
|
||||
-- 枚举最小超键。
|
||||
keysOf :: Attributes -> [Dependency] -> [Attributes]
|
||||
keysOf attrs f =
|
||||
[ x
|
||||
| x <- subsequences attrs
|
||||
, super x
|
||||
, (not . any super) [x \\ [a] | a <- x]
|
||||
]
|
||||
where
|
||||
-- 判断闭包是否覆盖关系。
|
||||
super x = subset attrs (attributeClosure f x)
|
||||
|
||||
-- 投影关系上的全部非平凡依赖。
|
||||
projectDependencies :: [Dependency] -> Attributes -> [Dependency]
|
||||
projectDependencies f attrs =
|
||||
[ Dependency x [a]
|
||||
| x <- subsequences attrs
|
||||
, a <- attributeClosure f x
|
||||
, a `elem` attrs
|
||||
, a `notElem` x
|
||||
]
|
||||
|
||||
-- 验证声明并生成只读范式报告。
|
||||
analyzeNormalization :: [(String, Column)] -> Declaration -> Either String Analysis
|
||||
analyzeNormalization schema declaration
|
||||
| null attrs = Left "normalization: empty schema"
|
||||
| length attrs /= length schema = Left "normalization: duplicate columns"
|
||||
| length attrs > 12 = Left "normalization: exhaustive analysis supports at most 12 columns"
|
||||
| any invalidDependency supplied = Left "normalization: unknown or duplicate dependency attributes"
|
||||
| any invalidKey rawKeys = Left "normalization: unknown or duplicate key attributes"
|
||||
| any (`notElem` keys) normalizedKeys = Left "normalization: declared candidate key is not minimal"
|
||||
| otherwise = Right (Analysis keys results decompositions)
|
||||
where
|
||||
attrs = canonical (map fst schema)
|
||||
supplied = dependencies declaration
|
||||
rawKeys = declaredKeys declaration
|
||||
normalizedKeys = map canonical rawKeys
|
||||
f = supplied ++ [Dependency k attrs | k <- normalizedKeys]
|
||||
keys = keysOf attrs f
|
||||
prime = nub (concat keys)
|
||||
complete = dependenciesComplete declaration
|
||||
atomic = case atomicAttributes declaration of
|
||||
Just True -> Satisfied
|
||||
Just False -> Violated
|
||||
Nothing -> Insufficient
|
||||
allFDs = projectDependencies f attrs
|
||||
partial =
|
||||
[ d
|
||||
| d@(Dependency x [a]) <- allFDs
|
||||
, a `notElem` prime
|
||||
, any (\k -> x /= k && subset x k) keys
|
||||
]
|
||||
third =
|
||||
[ d
|
||||
| d@(Dependency x [a]) <- allFDs
|
||||
, a `notElem` prime
|
||||
, not (subset attrs (attributeClosure f x))
|
||||
]
|
||||
boyce =
|
||||
[ d
|
||||
| d@(Dependency x _) <- allFDs
|
||||
, not (subset attrs (attributeClosure f x))
|
||||
]
|
||||
results =
|
||||
Finding NF1 atomic [] "attributes must have atomic domains; requires an explicit declaration"
|
||||
: [classify NF2 partial, classify NF3 third, classify BCNF boyce]
|
||||
decompositions = [split d | complete, atomic == Satisfied, d <- take 1 boyce]
|
||||
-- 校验字段集合。
|
||||
valid xs = length xs == length (canonical xs) && subset xs attrs
|
||||
-- 校验依赖声明。
|
||||
invalidDependency (Dependency a b) = not (valid a && valid b) || null b
|
||||
-- 校验候选键声明。
|
||||
invalidKey k = not (valid k)
|
||||
-- 结合声明完整性判定范式。
|
||||
classify nf ds = Finding nf status (if complete then ds else []) (rule nf)
|
||||
where
|
||||
status
|
||||
| atomic == Violated = Violated
|
||||
| atomic == Insufficient || not complete = Insufficient
|
||||
| null ds = Satisfied
|
||||
| otherwise = Violated
|
||||
-- 说明各范式的必要条件。
|
||||
rule NF1 = "attributes must have atomic domains"
|
||||
rule NF2 = "no nonprime attribute depends on a proper subset of any candidate key"
|
||||
rule NF3 = "each nontrivial dependency has a superkey determinant or a prime dependent"
|
||||
rule BCNF = "each nontrivial dependency has a superkey determinant"
|
||||
-- 按违反依赖生成一次无损分解。
|
||||
split (Dependency x y) = Decomposition parts Satisfied preservation
|
||||
where
|
||||
parts = [canonical (x ++ y), attrs \\ (y \\ x)]
|
||||
projected = concatMap (projectDependencies f) parts
|
||||
preservation = if all (implies projected) f then Satisfied else Violated
|
||||
@@ -0,0 +1,73 @@
|
||||
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
|
||||
@@ -0,0 +1,177 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Binding
|
||||
( Expression (..), TypedExpression, expressionType, bindExpression, evaluateExpression
|
||||
, Plan (..), TypedPlan, planSchema, bindPlan, executePlan
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import ChuSQL.Core.Engine.Runtime.Functions
|
||||
import Control.Monad (filterM)
|
||||
import Data.List (nub, sort)
|
||||
|
||||
-- 仅依据 schema 绑定表达式与查询，执行已解析的类型和函数身份。
|
||||
|
||||
-- | 表达未绑定的类型化语言
|
||||
data Expression = Literal TypeExpr RuntimeValue | Reference String | Apply String [Expression]
|
||||
| ListLiteral TypeExpr [Expression] | NothingLiteral TypeExpr | JustLiteral Expression
|
||||
| TupleLiteral [Expression] deriving (Show, Eq)
|
||||
|
||||
-- | 保存绑定后的表达式节点
|
||||
data ExpressionNode = Constant RuntimeValue | BoundReference Int String | BoundApply FunctionId [TypedExpression]
|
||||
| BoundList [TypedExpression] | BoundNothing | BoundJust TypedExpression | BoundTuple [TypedExpression]
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 保存表达式的确定类型
|
||||
data TypedExpression = TypedExpression TypeId ExpressionNode deriving (Show, Eq)
|
||||
|
||||
-- | 提取表达式类型身份
|
||||
expressionType :: TypedExpression -> TypeId
|
||||
expressionType (TypedExpression tid _) = tid
|
||||
|
||||
-- | 绑定类型、列与函数身份
|
||||
bindExpression :: TypeRegistry -> FunctionRegistry -> [(String, TypeId)] -> Expression -> Either String TypedExpression
|
||||
bindExpression types functions env expression = case expression of
|
||||
Literal ty value -> do
|
||||
tid <- descriptorId <$> resolveType types ty
|
||||
validateValue types tid value
|
||||
Right (TypedExpression tid (Constant value))
|
||||
Reference name -> case [(slot, tid) | (slot, (key, tid)) <- zip [0 ..] env, key == name] of
|
||||
[(slot, tid)] -> describeType types tid >> Right (TypedExpression tid (BoundReference slot name))
|
||||
[] -> Left ("unknown column: " ++ name)
|
||||
_ -> Left ("ambiguous column: " ++ name)
|
||||
Apply name arguments -> do
|
||||
bound <- mapM bind arguments
|
||||
sig <- resolveFunction functions name (map expressionType bound)
|
||||
Right (TypedExpression (signatureResult sig) (BoundApply (signatureId sig) bound))
|
||||
ListLiteral child arguments -> do
|
||||
childId <- descriptorId <$> resolveType types child
|
||||
bound <- mapM bind arguments
|
||||
if all ((== childId) . expressionType) bound
|
||||
then compound (listType child) (BoundList bound)
|
||||
else Left "list element type mismatch"
|
||||
NothingLiteral child -> compound (maybeType child) BoundNothing
|
||||
JustLiteral argument -> do
|
||||
bound <- bind argument
|
||||
compound (maybeType (typeExpression (expressionType bound))) (BoundJust bound)
|
||||
TupleLiteral arguments -> do
|
||||
bound <- mapM bind arguments
|
||||
compound (tupleType (map (typeExpression . expressionType) bound)) (BoundTuple bound)
|
||||
where
|
||||
-- | 绑定当前作用域的子表达式
|
||||
bind = bindExpression types functions env
|
||||
-- | 校验并构造复合表达式
|
||||
compound ty node = do
|
||||
tid <- descriptorId <$> resolveType types ty
|
||||
Right (TypedExpression tid node)
|
||||
|
||||
-- | 执行已绑定表达式并校验输出
|
||||
evaluateExpression :: TypeRegistry -> FunctionRegistry -> [(String, RuntimeValue)] -> TypedExpression -> Either String RuntimeValue
|
||||
evaluateExpression types functions row (TypedExpression tid node) = do
|
||||
value <- case node of
|
||||
Constant v -> Right v
|
||||
BoundReference slot name -> case drop slot row of
|
||||
(key, value) : _ | key == name -> Right value
|
||||
[] -> Left ("missing bound column: " ++ name)
|
||||
_ -> Left ("bound column position mismatch: " ++ name)
|
||||
BoundApply fid arguments -> mapM evaluate arguments >>= invokeFunction types functions fid
|
||||
BoundList arguments -> RList <$> mapM evaluate arguments
|
||||
BoundNothing -> Right (RMaybe Nothing)
|
||||
BoundJust argument -> RMaybe . Just <$> evaluate argument
|
||||
BoundTuple arguments -> RTuple <$> mapM evaluate arguments
|
||||
validateValue types tid value
|
||||
Right value
|
||||
where
|
||||
-- | 执行当前行的子表达式
|
||||
evaluate = evaluateExpression types functions row
|
||||
|
||||
-- | 表达未绑定的关系计划
|
||||
data Plan = TableScan String | SingleRow | Projection [(String, Expression)] Plan
|
||||
| Selection Expression Plan deriving (Show, Eq)
|
||||
|
||||
-- | 保存绑定后的关系节点
|
||||
data PlanNode = BoundScan String | BoundSingleRow | BoundProjection [(String, TypedExpression)] TypedPlan
|
||||
| BoundSelection TypedExpression TypedPlan deriving (Show, Eq)
|
||||
|
||||
-- | 保存输出 schema 和关系节点
|
||||
data TypedPlan = TypedPlan [(String, TypeId)] PlanNode deriving (Show, Eq)
|
||||
|
||||
-- | 提取计划的输出 schema
|
||||
planSchema :: TypedPlan -> [(String, TypeId)]
|
||||
planSchema (TypedPlan output _) = output
|
||||
|
||||
-- | 使用目录 schema 绑定查询计划
|
||||
bindPlan :: TypeRegistry -> FunctionRegistry -> [(String, [(String, TypeExpr)])] -> Plan -> Either String TypedPlan
|
||||
bindPlan types functions catalog plan = case plan of
|
||||
TableScan name -> case [columns | (key, columns) <- catalog, key == name] of
|
||||
[columns] -> do
|
||||
uniqueNames (map fst columns)
|
||||
bound <- mapM bindColumn columns
|
||||
Right (TypedPlan bound (BoundScan name))
|
||||
[] -> Left ("unknown table: " ++ name)
|
||||
_ -> Left ("ambiguous table: " ++ name)
|
||||
SingleRow -> Right (TypedPlan [] BoundSingleRow)
|
||||
Projection items source -> do
|
||||
child <- bind source
|
||||
uniqueNames (map fst items)
|
||||
bound <- mapM (bindItem (planSchema child)) items
|
||||
Right (TypedPlan [(name, expressionType value) | (name, value) <- bound] (BoundProjection bound child))
|
||||
Selection condition source -> do
|
||||
child <- bind source
|
||||
predicate <- bindExpression types functions (planSchema child) condition
|
||||
bool <- descriptorId <$> resolveType types boolType
|
||||
if expressionType predicate == bool
|
||||
then Right (TypedPlan (planSchema child) (BoundSelection predicate child))
|
||||
else Left "selection predicate must be Bool"
|
||||
where
|
||||
-- | 绑定子计划
|
||||
bind = bindPlan types functions catalog
|
||||
-- | 解析 schema 列的类型身份
|
||||
bindColumn (name, ty) = do
|
||||
tid <- descriptorId <$> resolveType types ty
|
||||
Right (name, tid)
|
||||
-- | 绑定投影项
|
||||
bindItem env (name, value) = do
|
||||
bound <- bindExpression types functions env value
|
||||
Right (name, bound)
|
||||
|
||||
-- | 拒绝重复输出列
|
||||
uniqueNames :: [String] -> Either String ()
|
||||
uniqueNames names
|
||||
| nub names == names = Right ()
|
||||
| otherwise = Left "duplicate schema column"
|
||||
|
||||
-- | 执行绑定计划并校验存储返回值
|
||||
executePlan :: TypeRegistry -> FunctionRegistry -> (String -> Either String [[(String, RuntimeValue)]])
|
||||
-> TypedPlan -> Either String [[(String, RuntimeValue)]]
|
||||
executePlan types functions scan (TypedPlan output node) = do
|
||||
rows <- case node of
|
||||
BoundScan name -> scan name
|
||||
BoundSingleRow -> Right [[]]
|
||||
BoundProjection items child -> do
|
||||
input <- executePlan types functions scan child
|
||||
mapM (project items) input
|
||||
BoundSelection condition child -> do
|
||||
input <- executePlan types functions scan child
|
||||
filterM (keep condition) input
|
||||
mapM_ (validateRow output) rows
|
||||
Right [[(name, value) | (name, _) <- output, Just value <- [lookup name row]] | row <- rows]
|
||||
where
|
||||
-- | 计算一行的投影项
|
||||
project items row = mapM (projectItem row) items
|
||||
-- | 计算命名输出项
|
||||
projectItem row (name, expression) = do
|
||||
value <- evaluateExpression types functions row expression
|
||||
Right (name, value)
|
||||
-- | 计算选择条件
|
||||
keep condition row = do
|
||||
value <- evaluateExpression types functions row condition
|
||||
case value of
|
||||
RBool result -> Right result
|
||||
_ -> Left "bound predicate returned a non-Bool value"
|
||||
-- | 校验存储行的完整 schema
|
||||
validateRow columns row
|
||||
| sort (map fst row) /= sort (map fst columns) = Left "storage row schema mismatch"
|
||||
| otherwise = mapM_ (validateColumn row) columns
|
||||
-- | 按列名校验返回值的类型
|
||||
validateColumn row (name, tid) = case lookup name row of
|
||||
Just value -> validateValue types tid value
|
||||
Nothing -> Left ("missing bound column: " ++ name)
|
||||
@@ -0,0 +1,111 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, typeDependencies, validateDependencies) where
|
||||
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Model (Database, ColumnType (..), columnType, tableCols, tableIdentity, tableSchemaVersion, domainTableName, lastTablePart)
|
||||
import Data.List (nub)
|
||||
|
||||
-- 收集读写语句及嵌套表达式的表依赖，供执行期校验目录。
|
||||
|
||||
-- | 复查绑定依赖的身份、版本及列定义
|
||||
validateDependencies :: Database -> Database -> Either String ()
|
||||
validateDependencies expected current = mapM_ validate expected
|
||||
where
|
||||
-- | 数据和统计变化不使结构绑定失效
|
||||
validate (name, table) = case lookup name current of
|
||||
Just actual | tableIdentity actual /= tableIdentity table -> Left ("bound query object changed: " ++ name)
|
||||
Just actual | tableSchemaVersion actual /= tableSchemaVersion table -> Left ("bound query schema changed: " ++ name)
|
||||
Just actual | tableCols actual == tableCols table -> Right ()
|
||||
_ -> Left ("bound query schema changed: " ++ name)
|
||||
|
||||
-- | 收集读写目标、来源及子查询依赖
|
||||
queryTables :: Statement -> [String]
|
||||
queryTables statement = nub (case statement of
|
||||
SelectDistinct child -> queryTables child
|
||||
Select items source condition _ having ordering _ -> sourceTables source
|
||||
++ concatMap (expressionTables . snd) items ++ concatMap expressionTables condition
|
||||
++ concatMap expressionTables having
|
||||
++ concatMap (maybe [] expressionTables . orderKeyExpression . fst) ordering
|
||||
Insert target _ rows -> target : concatMap (concatMap expressionTables) rows
|
||||
Update target assignments condition -> target : concatMap (expressionTables . snd) assignments
|
||||
++ concatMap expressionTables condition
|
||||
Delete target condition -> target : concatMap expressionTables condition
|
||||
DropTable target -> [target]
|
||||
CreateIndex target _ -> [target]
|
||||
DropIndex target _ -> [target]
|
||||
DropColumn target _ -> [target]
|
||||
AddColumn target _ -> [target]
|
||||
RenameColumn target _ _ -> [target]
|
||||
AlterColumnType target _ _ -> [target]
|
||||
AlterColumnDefault target _ _ -> [target]
|
||||
AlterColumnNull target _ _ -> [target]
|
||||
_ -> [])
|
||||
|
||||
-- | 收集来源列依赖的领域定义
|
||||
domainDependencies :: Database -> [String] -> [String]
|
||||
domainDependencies catalog sources = typeDependencies catalog
|
||||
[columnType column | (name, table) <- catalog, name `elem` sources
|
||||
, (_, column) <- tableCols table]
|
||||
|
||||
-- | 收集声明类型依赖的领域目录
|
||||
typeDependencies :: Database -> [ColumnType] -> [String]
|
||||
typeDependencies catalog types = collect [] (concatMap typeDomains types)
|
||||
where
|
||||
-- | 递归展开定义并防止重复访问
|
||||
collect seen [] = seen
|
||||
collect seen (domain : remaining) =
|
||||
let definitions = [(name, table) | (name, table) <- catalog
|
||||
, lastTablePart name == domainTableName domain, name `notElem` seen]
|
||||
names = map fst definitions
|
||||
nested = [child | (_, table) <- definitions, (_, column) <- tableCols table
|
||||
, child <- typeDomains (columnType column)]
|
||||
in collect (seen ++ names) (remaining ++ nested)
|
||||
-- | 保留嵌套领域的每层依赖
|
||||
typeDomains (CDomain name base) = name : typeDomains base
|
||||
typeDomains _ = []
|
||||
|
||||
-- | 收集来源树与连接条件依赖
|
||||
sourceTables :: FromClause -> [String]
|
||||
sourceTables source = case source of
|
||||
FromTable _ name -> [name]
|
||||
FromSubquery _ statement -> queryTables statement
|
||||
FromJoin _ left right condition -> sourceTables left ++ sourceTables right ++ expressionTables condition
|
||||
FromUnit -> []
|
||||
|
||||
-- | 收集表达式内嵌套子查询依赖
|
||||
expressionTables :: Expr -> [String]
|
||||
expressionTables expression = case expression of
|
||||
ScalarSub query -> queryTables (subqueryStatement query)
|
||||
ExistsSub query _ -> queryTables (subqueryStatement query)
|
||||
InSub value query _ -> expressionTables value ++ queryTables (subqueryStatement query)
|
||||
QuantCmp _ value query _ -> expressionTables value ++ queryTables (subqueryStatement query)
|
||||
_ -> concatMap expressionTables (children expression)
|
||||
|
||||
-- | 列出当前表达式的直接子节点
|
||||
children :: Expr -> [Expr]
|
||||
children expression = case expression of
|
||||
FunctionCall _ arguments -> arguments
|
||||
BoundFunction _ _ arguments -> arguments
|
||||
Construct _ arguments -> arguments
|
||||
BoundConstruct _ arguments -> arguments
|
||||
InList value arguments _ -> value : arguments
|
||||
Add a b -> [a, b]
|
||||
Sub a b -> [a, b]
|
||||
Mul a b -> [a, b]
|
||||
Div a b -> [a, b]
|
||||
Gt a b -> [a, b]
|
||||
Lt a b -> [a, b]
|
||||
Eq a b -> [a, b]
|
||||
GtE a b -> [a, b]
|
||||
LtE a b -> [a, b]
|
||||
NotEq a b -> [a, b]
|
||||
And a b -> [a, b]
|
||||
Or a b -> [a, b]
|
||||
Neg a -> [a]
|
||||
IsNull a -> [a]
|
||||
IsNotNull a -> [a]
|
||||
CountOf a -> [a]
|
||||
SumOf a -> [a]
|
||||
AvgOf a -> [a]
|
||||
MinOf a -> [a]
|
||||
MaxOf a -> [a]
|
||||
_ -> []
|
||||
@@ -0,0 +1,80 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Functions
|
||||
( FunctionId (..), FunctionSignature (..), FunctionRegistry
|
||||
, builtinFunctions, resolveFunction, resolveNullableFunction, functionSignature, invokeFunction
|
||||
) where
|
||||
|
||||
import Control.Monad (zipWithM_)
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import Data.Char (toLower)
|
||||
|
||||
-- 内建函数的固定身份、签名解析和类型化调用。
|
||||
|
||||
-- | 标识稳定的内建函数
|
||||
newtype FunctionId = FunctionId Int deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 描述已解析的函数签名
|
||||
data FunctionSignature = FunctionSignature
|
||||
{ signatureId :: FunctionId, signatureName :: String
|
||||
, signatureArguments :: [TypeId], signatureResult :: TypeId
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | 保存函数签名和实现
|
||||
newtype FunctionRegistry = FunctionRegistry [(FunctionSignature, [RuntimeValue] -> Either String RuntimeValue)]
|
||||
|
||||
-- | 从内建元数据恢复函数注册表
|
||||
builtinFunctions :: TypeRegistry -> Either String FunctionRegistry
|
||||
builtinFunctions types = do
|
||||
int <- descriptorId <$> resolveType types intType
|
||||
bool <- descriptorId <$> resolveType types boolType
|
||||
string <- descriptorId <$> resolveType types stringType
|
||||
Right (FunctionRegistry
|
||||
[(FunctionSignature (FunctionId 1) "length" [string] int, stringLength)
|
||||
,(FunctionSignature (FunctionId 2) "not" [bool] bool, booleanNot)])
|
||||
|
||||
-- | 按名称和完整参数类型解析函数
|
||||
resolveFunction :: FunctionRegistry -> String -> [TypeId] -> Either String FunctionSignature
|
||||
resolveFunction registry name arguments = resolveNullableFunction registry name (map Just arguments)
|
||||
|
||||
-- | 按可空 SQL 参数解析确定签名
|
||||
resolveNullableFunction :: FunctionRegistry -> String -> [Maybe TypeId] -> Either String FunctionSignature
|
||||
resolveNullableFunction (FunctionRegistry functions) name arguments =
|
||||
case [sig | (sig, _) <- functions, map toLower (signatureName sig) == map toLower name
|
||||
, length arguments == length (signatureArguments sig)
|
||||
, and (zipWith matches arguments (signatureArguments sig))] of
|
||||
[sig] -> Right sig
|
||||
[] -> Left ("no matching function signature: " ++ name)
|
||||
_ -> Left ("ambiguous function signature: " ++ name)
|
||||
where
|
||||
-- | 匹配具体参数或未定型 NULL
|
||||
matches Nothing _ = True
|
||||
matches (Just supplied) expected = supplied == expected
|
||||
|
||||
-- | 按固定身份查找函数签名
|
||||
functionSignature :: FunctionRegistry -> FunctionId -> Either String FunctionSignature
|
||||
functionSignature (FunctionRegistry functions) fid = case [sig | (sig, _) <- functions, signatureId sig == fid] of
|
||||
[sig] -> Right sig
|
||||
_ -> Left ("unknown function identity: " ++ show fid)
|
||||
|
||||
-- | 校验参数并执行已解析的函数
|
||||
invokeFunction :: TypeRegistry -> FunctionRegistry -> FunctionId -> [RuntimeValue] -> Either String RuntimeValue
|
||||
invokeFunction types (FunctionRegistry functions) fid values =
|
||||
case [(sig, implementation) | (sig, implementation) <- functions, signatureId sig == fid] of
|
||||
[(sig, implementation)]
|
||||
| length values == length (signatureArguments sig) -> do
|
||||
zipWithM_
|
||||
(validateValue types) (signatureArguments sig) values
|
||||
result <- implementation values
|
||||
validateValue types (signatureResult sig) result
|
||||
Right result
|
||||
| otherwise -> Left "function argument count mismatch"
|
||||
_ -> Left ("unknown function identity: " ++ show fid)
|
||||
|
||||
-- | 计算字符串字符个数
|
||||
stringLength :: [RuntimeValue] -> Either String RuntimeValue
|
||||
stringLength [RString text] = Right (RInt (length text))
|
||||
stringLength _ = Left "length expects String"
|
||||
|
||||
-- | 计算布尔取反
|
||||
booleanNot :: [RuntimeValue] -> Either String RuntimeValue
|
||||
booleanNot [RBool value] = Right (RBool (not value))
|
||||
booleanNot _ = Left "not expects Bool"
|
||||
@@ -0,0 +1,76 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Query
|
||||
( BoundQuery, QueryType (..), queryTypes, bindQuery, executeQueryM
|
||||
) where
|
||||
|
||||
import ChuSQL.Core.Engine.Algebra.Eval (evalRelOpM)
|
||||
import ChuSQL.Core.Engine.Algebra.Op (RelOp)
|
||||
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
|
||||
import ChuSQL.Core.Engine.Algebra.Planner (translate)
|
||||
import ChuSQL.Core.Engine.Semantic (prepare, querySchema)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Statement)
|
||||
import ChuSQL.Core.Engine.Storage (MonadStorage (schema, withSchemaGuard))
|
||||
import ChuSQL.Core.Engine.Runtime.SQL (sqlType)
|
||||
import ChuSQL.Core.Engine.Runtime.Types (TypeId)
|
||||
import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns)
|
||||
import ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, validateDependencies)
|
||||
import ChuSQL.Core.Model
|
||||
|
||||
-- SQL 查询绑定边界：保存解析后的类型、函数身份及输出 schema。
|
||||
|
||||
-- | 保存运行时或兼容列类型
|
||||
data QueryType = RuntimeType TypeId | CompatibilityType ColumnType
|
||||
| DomainType String QueryType | NullType deriving (Show, Eq)
|
||||
|
||||
-- | 保存仅由 schema 绑定的执行计划
|
||||
data BoundQuery = BoundQuery Database [String] [(String, Column)] [(String, QueryType)] RelOp
|
||||
|
||||
-- | 查询绑定计划的输出类型身份
|
||||
queryTypes :: BoundQuery -> [(String, QueryType)]
|
||||
queryTypes (BoundQuery _ _ _ types _) = types
|
||||
|
||||
-- | 绑定 SQL 查询并优化确定的计划
|
||||
bindQuery :: Database -> Statement -> Either String BoundQuery
|
||||
bindQuery catalog statement = do
|
||||
let schemaOnly = [(name, table {tableRows = []}) | (name, table) <- catalog]
|
||||
resolved <- prepare schemaOnly statement
|
||||
columns <- querySchema schemaOnly resolved
|
||||
plan <- translate resolved
|
||||
types <- mapM typeOf columns
|
||||
bound <- bindRelOpColumns schemaOnly [] (optimize schemaOnly plan)
|
||||
let sources = queryTables resolved
|
||||
dependencies = sources ++ domainDependencies schemaOnly sources
|
||||
Right (BoundQuery schemaOnly dependencies columns types bound)
|
||||
where
|
||||
-- | 解析输出列的运行时身份
|
||||
typeOf (name, column) = do
|
||||
ty <- bindingType (columnType column)
|
||||
Right (name, ty)
|
||||
-- | 保留阶段外类型的兼容表示
|
||||
bindingType CNull = Right NullType
|
||||
bindingType (CDomain name base) = DomainType name <$> bindingType base
|
||||
bindingType CDate = Right (CompatibilityType CDate)
|
||||
bindingType CTimestamp = Right (CompatibilityType CTimestamp)
|
||||
bindingType CBlob = Right (CompatibilityType CBlob)
|
||||
bindingType ty = RuntimeType <$> sqlType ty
|
||||
|
||||
-- | 执行绑定查询并校验输出类型
|
||||
executeQueryM :: MonadStorage m => BoundQuery -> m (Either String [Row])
|
||||
executeQueryM (BoundQuery catalog dependencies columns _ plan) = do
|
||||
current <- schema
|
||||
case current >>= validateDependencies guardedTables of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> do
|
||||
result <- withSchemaGuard guardedTables
|
||||
(evalRelOpM catalog plan)
|
||||
pure (result >>= mapM validateRow)
|
||||
where
|
||||
guardedTables = [(name, table) | (name, table) <- catalog, name `elem` dependencies]
|
||||
-- | 校验完整输出行而不重新解析函数
|
||||
validateRow row
|
||||
| map fst row /= map fst columns = Left "bound query output schema mismatch"
|
||||
| otherwise = mapM validateColumn (zip columns row)
|
||||
-- | 校验输出列的物理值
|
||||
validateColumn ((name, column), (_, value))
|
||||
| columnType column == CNull, value == VNull = Right (name, value)
|
||||
| valueFits (columnType column) value = Right (name, value)
|
||||
| otherwise = Left ("bound query output type mismatch: " ++ name)
|
||||
@@ -0,0 +1,152 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns, bindWriteColumns, bindSlots, orderRow) where
|
||||
|
||||
import ChuSQL.Core.Engine.Algebra.Op
|
||||
import ChuSQL.Core.Engine.Syntax.AST
|
||||
import ChuSQL.Core.Model (Database, Row, lookupTable, tableCols)
|
||||
|
||||
-- 按关系或写语句的输入布局绑定列槽位，并排列存储返回行。
|
||||
|
||||
-- | 按目标表布局绑定写入表达式
|
||||
bindWriteColumns :: Database -> Statement -> Either String Statement
|
||||
bindWriteColumns db statement = case statement of
|
||||
Insert table columns rows -> Insert table columns <$> mapM (mapM (bindSlots [] [])) rows
|
||||
Update table assignments condition -> do
|
||||
columns <- map fst . tableCols <$> lookupTable db table
|
||||
bound <- mapM (bindItem columns) assignments
|
||||
predicate <- mapM (bindSlots columns []) condition
|
||||
Right (Update table bound predicate)
|
||||
Delete table condition -> do
|
||||
columns <- map fst . tableCols <$> lookupTable db table
|
||||
Delete table <$> mapM (bindSlots columns []) condition
|
||||
_ -> Right statement
|
||||
where
|
||||
-- | 保留写入目标并绑定右侧表达式
|
||||
bindItem columns (name, expression) = (,) name <$> bindSlots columns [] expression
|
||||
|
||||
-- | 按绑定布局排列一行并拒绝缺列
|
||||
orderRow :: [String] -> Row -> Either String Row
|
||||
orderRow columns row = mapM column columns
|
||||
where
|
||||
-- | 保留列名并取得物理值
|
||||
column name = case lookup name row of
|
||||
Just value -> Right (name, value)
|
||||
Nothing -> Left ("missing bound column: " ++ name)
|
||||
|
||||
-- | 绑定关系算子的输入列位置
|
||||
bindRelOpColumns :: Database -> [String] -> RelOp -> Either String RelOp
|
||||
bindRelOpColumns db outer = bind
|
||||
where
|
||||
-- \| 递归绑定每个算子的输入布局
|
||||
bind op = case op of
|
||||
Filter expression child -> Filter <$> expressionIn child expression <*> bind child
|
||||
Compute items child -> Compute <$> mapM (itemIn child) items <*> bind child
|
||||
Aggregate keys items child -> bind (BoundAggregate [(name, Col name) | name <- keys] items child)
|
||||
BoundAggregate keys items child ->
|
||||
BoundAggregate
|
||||
<$> mapM (itemIn child) keys
|
||||
<*> mapM (itemIn child) items
|
||||
<*> bind child
|
||||
Join kind left right condition ->
|
||||
Join kind
|
||||
<$> bind left
|
||||
<*> bind right
|
||||
<*> bindSlots (relOpCols db left ++ relOpCols db right) outer condition
|
||||
SemiJoin kind leftKey rightKey left right query ->
|
||||
SemiJoin kind
|
||||
<$> expressionIn left leftKey
|
||||
<*> expressionIn right rightKey
|
||||
<*> bind left
|
||||
<*> bind right
|
||||
<*> pure query
|
||||
Project columns child -> do
|
||||
let names = if columns == ["*"] then relOpCols db child else columns
|
||||
items <- mapM (itemIn child) [(name, Col name) | name <- names]
|
||||
Compute items <$> bind child
|
||||
Distinct child -> Distinct <$> bind child
|
||||
Sort ordering child -> bind (BoundSort [(Col name, direction) | (name, direction) <- ordering] child)
|
||||
BoundSort ordering child -> BoundSort <$> mapM (sortIn child) ordering <*> bind child
|
||||
Limit count child -> Limit count <$> bind child
|
||||
Derived alias child -> Derived alias <$> bind child
|
||||
_ -> Right op
|
||||
-- \| 使用子计划输出布局绑定表达式
|
||||
expressionIn child = bindSlots (relOpCols db child) outer
|
||||
-- \| 保留输出标签并绑定计算项
|
||||
itemIn child (name, expression) = (,) name <$> expressionIn child expression
|
||||
-- \| 绑定排序键并保留方向
|
||||
sortIn child (expression, direction) = (,) <$> expressionIn child expression <*> pure direction
|
||||
|
||||
-- | 绑定当前表达式的列引用
|
||||
bindSlots :: [String] -> [String] -> Expr -> Either String Expr
|
||||
bindSlots columns outer expression = case expression of
|
||||
Col name -> case slots columns name of
|
||||
slot : _ -> Right (ColumnSlot slot name)
|
||||
[] -> outerReference name
|
||||
ColumnSlot slot name -> ColumnSlot <$> rebindSlot columns slot name "unknown local column: " <*> pure name
|
||||
OuterColumnSlot width slot name
|
||||
| width < 0 -> Left ("bound column position mismatch: " ++ name)
|
||||
| otherwise -> OuterColumnSlot (length columns)
|
||||
<$> rebindSlot outer slot name "unknown column: " <*> pure name
|
||||
FunctionCall name arguments -> FunctionCall name <$> mapM bind arguments
|
||||
BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM bind arguments
|
||||
Construct ty arguments -> Construct ty <$> mapM bind arguments
|
||||
BoundConstruct tid arguments -> BoundConstruct tid <$> mapM bind arguments
|
||||
Add a b -> binary Add a b
|
||||
Sub a b -> binary Sub a b
|
||||
Mul a b -> binary Mul a b
|
||||
Div a b -> binary Div a b
|
||||
Neg a -> Neg <$> bind a
|
||||
Gt a b -> binary Gt a b
|
||||
Lt a b -> binary Lt a b
|
||||
Eq a b -> binary Eq a b
|
||||
GtE a b -> binary GtE a b
|
||||
LtE a b -> binary LtE a b
|
||||
NotEq a b -> binary NotEq a b
|
||||
And a b -> binary And a b
|
||||
Or a b -> binary Or a b
|
||||
IsNull a -> IsNull <$> bind a
|
||||
IsNotNull a -> IsNotNull <$> bind a
|
||||
CountOf a -> CountOf <$> bind a
|
||||
SumOf a -> SumOf <$> bind a
|
||||
AvgOf a -> AvgOf <$> bind a
|
||||
MinOf a -> MinOf <$> bind a
|
||||
MaxOf a -> MaxOf <$> bind a
|
||||
ScalarSub query -> ScalarSub <$> bindSubquery query
|
||||
InSub a query negated -> InSub <$> bind a <*> bindSubquery query <*> pure negated
|
||||
InList a values negated -> InList <$> bind a <*> mapM bind values <*> pure negated
|
||||
ExistsSub query negated -> ExistsSub <$> bindSubquery query <*> pure negated
|
||||
QuantCmp op a query quantifier -> QuantCmp op <$> bind a <*> bindSubquery query <*> pure quantifier
|
||||
_ -> Right expression
|
||||
where
|
||||
-- \| 绑定当前布局的子表达式
|
||||
bind = bindSlots columns outer
|
||||
-- \| 查找布局中首次出现的列
|
||||
slots names name = [slot | (slot, key) <- zip [0 ..] names, key == name]
|
||||
-- | 保留有效位置，仅允许唯一列重定位
|
||||
rebindSlot names slot name missing
|
||||
| slot < 0 = Left ("bound column position mismatch: " ++ name)
|
||||
| take 1 (drop slot names) == [name] = Right slot
|
||||
| otherwise = case slots names name of
|
||||
[position] -> Right position
|
||||
[] -> Left (missing ++ name)
|
||||
_ -> Left ("ambiguous bound column: " ++ name)
|
||||
-- \| 在外层布局绑定并保留作用域
|
||||
outerReference name = case slots outer name of
|
||||
slot : _ -> Right (OuterColumnSlot (length columns) slot name)
|
||||
[] -> Left ("unknown column: " ++ name)
|
||||
-- | 将子查询自由变量绑定到父输入布局
|
||||
bindSubquery query = do
|
||||
references <- case query of
|
||||
Subquery _ names -> mapM reference names
|
||||
BoundSubquery _ names references
|
||||
| map fst references == names -> mapM rebind references
|
||||
| otherwise -> Left "bound subquery references mismatch"
|
||||
Right (BoundSubquery (subqueryStatement query) (subqueryRefs query) references)
|
||||
-- | 补回限定名之前先绑定真实物理列
|
||||
reference name = do
|
||||
let physical = if name `elem` (columns ++ outer) then name else reverse (takeWhile (/= '.') (reverse name))
|
||||
boundReference <- bind (Col physical)
|
||||
Right (name, boundReference)
|
||||
-- | 重绑定时保留局部或外层身份
|
||||
rebind (name, boundReference) = (,) name <$> bind boundReference
|
||||
-- \| 绑定两个操作数
|
||||
binary constructor a b = constructor <$> bind a <*> bind b
|
||||
@@ -0,0 +1,99 @@
|
||||
module ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, invokeSQLFunction, sqlType, constructSQLValue) where
|
||||
|
||||
import Control.Monad (zipWithM_)
|
||||
import ChuSQL.Core.Engine.Runtime.Functions
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import ChuSQL.Core.Model (ColumnType (..), Value (..))
|
||||
|
||||
-- SQL 现有标量表示与已解析运行时函数之间的类型边界。
|
||||
|
||||
-- | 解析 SQL 标量调用的固定签名
|
||||
resolveSQLFunction :: String -> [Maybe ColumnType] -> Either String FunctionSignature
|
||||
resolveSQLFunction name arguments = do
|
||||
functions <- builtinFunctions builtinTypes
|
||||
types <- mapM (traverse sqlType) arguments
|
||||
resolveNullableFunction functions name types
|
||||
|
||||
-- | 解析现有标量列的逻辑类型
|
||||
sqlType :: ColumnType -> Either String TypeId
|
||||
sqlType (CDomain _ base) = sqlType base
|
||||
sqlType (CRuntime tid) = describeType builtinTypes tid >> Right tid
|
||||
sqlType ty = do
|
||||
expression <- case ty of
|
||||
CInt -> Right intType
|
||||
CBigInt -> Right intType
|
||||
CSmallInt -> Right intType
|
||||
CFloat -> Right doubleType
|
||||
CDouble -> Right doubleType
|
||||
CDecimal{} -> Right doubleType
|
||||
CBool -> Right boolType
|
||||
CStr -> Right stringType
|
||||
CVarchar{} -> Right stringType
|
||||
CChar{} -> Right stringType
|
||||
_ -> Left ("unsupported runtime function argument type: " ++ show ty)
|
||||
descriptorId <$> resolveType builtinTypes expression
|
||||
|
||||
-- | 将函数输出类型映射为 SQL schema
|
||||
sqlResultType :: TypeId -> Either String ColumnType
|
||||
sqlResultType tid
|
||||
| typeExpression tid == intType = Right CInt
|
||||
| typeExpression tid == doubleType = Right CDouble
|
||||
| typeExpression tid == boolType = Right CBool
|
||||
| typeExpression tid == stringType = Right CStr
|
||||
| otherwise = Left "runtime function result needs a composite SQL representation"
|
||||
|
||||
-- | 执行固定身份的 SQL 标量函数
|
||||
invokeSQLFunction :: FunctionId -> TypeId -> [Value] -> Either String Value
|
||||
invokeSQLFunction fid expected values = do
|
||||
functions <- builtinFunctions builtinTypes
|
||||
sig <- functionSignature functions fid
|
||||
if signatureResult sig /= expected
|
||||
then Left "bound function result identity mismatch"
|
||||
else
|
||||
if length values /= length (signatureArguments sig)
|
||||
then Left "function argument count mismatch"
|
||||
else do
|
||||
zipWithM_
|
||||
validateArgument (signatureArguments sig) values
|
||||
if VNull `elem` values
|
||||
then Right VNull
|
||||
else do
|
||||
arguments <- mapM runtimeValue values
|
||||
result <- invokeFunction builtinTypes functions fid arguments
|
||||
sqlValue result
|
||||
where
|
||||
-- \| 校验具体参数并保留 SQL NULL
|
||||
validateArgument _ VNull = Right ()
|
||||
validateArgument tid value = runtimeValue value >>= validateValue builtinTypes tid
|
||||
|
||||
-- | 转换现有 SQL 标量值
|
||||
runtimeValue :: Value -> Either String RuntimeValue
|
||||
runtimeValue (VInt n) = Right (RInt n)
|
||||
runtimeValue (VFloat n) = Right (RDouble n)
|
||||
runtimeValue (VBool b) = Right (RBool b)
|
||||
runtimeValue (VStr text) = Right (RString text)
|
||||
runtimeValue (VRuntime tid value) = validateValue builtinTypes tid value >> Right value
|
||||
runtimeValue VNull = Left "untyped SQL NULL has no runtime scalar value"
|
||||
|
||||
-- | 转换运行时标量结果
|
||||
sqlValue :: RuntimeValue -> Either String Value
|
||||
sqlValue (RInt n) = Right (VInt n)
|
||||
sqlValue (RDouble n) = Right (VFloat n)
|
||||
sqlValue (RBool b) = Right (VBool b)
|
||||
sqlValue (RString text) = Right (VStr text)
|
||||
sqlValue _ = Left "composite runtime result has no SQL scalar representation"
|
||||
|
||||
-- | 按已解析构造器生成类型化值
|
||||
constructSQLValue :: TypeId -> [Value] -> Either String Value
|
||||
constructSQLValue tid values = do
|
||||
arguments <- mapM runtimeValue values
|
||||
value <- case typeExpression tid of
|
||||
TypeApply (TypeConstructorId 5) [_] -> Right (RList arguments)
|
||||
TypeApply (TypeConstructorId 6) [_] -> case arguments of
|
||||
[] -> Right (RMaybe Nothing)
|
||||
[argument] -> Right (RMaybe (Just argument))
|
||||
_ -> Left "Maybe constructor expects zero or one argument"
|
||||
TypeApply (TypeConstructorId 7) _ -> Right (RTuple arguments)
|
||||
_ -> Left "type is not a composite constructor"
|
||||
validateValue builtinTypes tid value
|
||||
Right (VRuntime tid value)
|
||||
@@ -0,0 +1,5 @@
|
||||
module ChuSQL.Core.Engine.Runtime.Types (module ChuSQL.Core.Runtime) where
|
||||
|
||||
import ChuSQL.Core.Runtime
|
||||
|
||||
-- 导出共享的运行时类型身份和物理编码契约。
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,129 @@
|
||||
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 = []})
|
||||
@@ -0,0 +1,113 @@
|
||||
{-# 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))
|
||||
@@ -0,0 +1,472 @@
|
||||
{-# 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))
|
||||
@@ -0,0 +1,128 @@
|
||||
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))
|
||||
@@ -0,0 +1,236 @@
|
||||
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
|
||||
@@ -0,0 +1,949 @@
|
||||
{-# 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)
|
||||
@@ -0,0 +1,8 @@
|
||||
resolver: lts-24.59
|
||||
|
||||
extra-lib-dirs:
|
||||
- ../storage/target/release
|
||||
|
||||
packages:
|
||||
- .
|
||||
- ../model
|
||||
@@ -0,0 +1,12 @@
|
||||
# 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
|
||||
@@ -0,0 +1,68 @@
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module NormalizationSpec (spec) where
|
||||
|
||||
import ChuSQL.Core.Engine.Normalization
|
||||
import ChuSQL.Core.Model (pattern TInt)
|
||||
import Test.Hspec
|
||||
|
||||
-- 范式分析回归：公理闭包、候选键、信息不足与分解性质。
|
||||
|
||||
-- 执行范式检查回归。
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Armstrong normalization" $ do
|
||||
it "computes reflexivity, augmentation and transitivity" $ do
|
||||
attributeClosure [Dependency ["a"] ["b"], Dependency ["b"] ["c"]] ["a"]
|
||||
`shouldBe` ["a", "b", "c"]
|
||||
implies [Dependency ["a"] ["b"]] (Dependency ["a", "c"] ["b", "c"])
|
||||
`shouldBe` True
|
||||
attributeClosure [] ["a"] `shouldBe` ["a"]
|
||||
it "accepts BCNF with a declared key" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a"]] [] True (Just True)))
|
||||
`shouldBe` Right (replicate 4 Satisfied)
|
||||
it "detects partial dependencies of composite keys" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a", "b"]] [Dependency ["a"] ["c"]] True (Just True)))
|
||||
`shouldBe` Right [Satisfied, Violated, Violated, Violated]
|
||||
it "detects transitive dependencies and a preserving split" $ do
|
||||
let analysis = analyzeNormalization schema
|
||||
(Declaration [["a"]] [Dependency ["b"] ["c"]] True (Just True))
|
||||
fmap (map verdict . findings) analysis
|
||||
`shouldBe` Right [Satisfied, Satisfied, Violated, Violated]
|
||||
fmap suggestions analysis
|
||||
`shouldBe` Right [Decomposition [["b", "c"], ["a", "b"]] Satisfied Satisfied]
|
||||
it "distinguishes 3NF from BCNF and detects dependency loss" $ do
|
||||
let analysis = analyzeNormalization schema
|
||||
(Declaration [["a", "b"]] [Dependency ["c"] ["b"]] True (Just True))
|
||||
fmap (map verdict . findings) analysis
|
||||
`shouldBe` Right [Satisfied, Satisfied, Satisfied, Violated]
|
||||
fmap suggestions analysis
|
||||
`shouldBe` Right [Decomposition [["b", "c"], ["a", "c"]] Satisfied Violated]
|
||||
it "does not certify incomplete dependencies" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [["a"]] [] False (Just True)))
|
||||
`shouldBe` Right [Satisfied, Insufficient, Insufficient, Insufficient]
|
||||
it "requires an atomicity declaration" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [] [] True Nothing)) `shouldBe` Right (replicate 4 Insufficient)
|
||||
it "propagates a declared 1NF violation" $ do
|
||||
fmap (map verdict . findings) (analyzeNormalization schema
|
||||
(Declaration [] [] True (Just False))) `shouldBe` Right (replicate 4 Violated)
|
||||
it "rejects unknown attributes" $ do
|
||||
analyzeNormalization schema (Declaration [] [Dependency ["z"] ["a"]] True (Just True))
|
||||
`shouldBe` Left "normalization: unknown or duplicate dependency attributes"
|
||||
it "rejects nonminimal declared candidate keys" $ do
|
||||
analyzeNormalization schema (Declaration [["a", "b"]]
|
||||
[Dependency ["a"] ["b", "c"]] True (Just True))
|
||||
`shouldBe` Left "normalization: declared candidate key is not minimal"
|
||||
it "includes the empty candidate key for constant relations" $ do
|
||||
fmap candidateKeys (analyzeNormalization schema
|
||||
(Declaration [] [Dependency [] ["a", "b", "c"]] True (Just True))) `shouldBe` Right [[]]
|
||||
it "rejects excessive exhaustive searches" $ do
|
||||
analyzeNormalization [(show n, TInt) | n <- [1 :: Int .. 13]]
|
||||
(Declaration [] [] True (Just True))
|
||||
`shouldBe` Left "normalization: exhaustive analysis supports at most 12 columns"
|
||||
where
|
||||
schema = [("a", TInt), ("b", TInt), ("c", TInt)]
|
||||
@@ -0,0 +1,870 @@
|
||||
module RuntimeSpec (spec) where
|
||||
|
||||
import ChuSQL.Core.Engine.Runtime.Types
|
||||
import ChuSQL.Core.Engine.Runtime.Functions
|
||||
import ChuSQL.Core.Engine.Runtime.Binding
|
||||
import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns, bindWriteColumns)
|
||||
import qualified ChuSQL.Core.Engine.Algebra.Op as Rel
|
||||
import ChuSQL.Core.Engine.Algebra.Expr (evalExpr, subquerySlotsIn)
|
||||
import ChuSQL.Core.Engine.Algebra.Eval (evalRelOp)
|
||||
import ChuSQL.Core.Engine.Algebra.Sort (sortBoundRows)
|
||||
import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage)
|
||||
import qualified ChuSQL.Core.Engine.Runtime.Query as Query
|
||||
import ChuSQL.Core.Engine (rowsOf, runStatement, runStatementM, bindWrite, executeWriteM)
|
||||
import ChuSQL.Core.Engine.Semantic (prepare, prepareRowExpression)
|
||||
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
|
||||
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), Statement (..), Subquery (..), FromClause (..), SortDir (..))
|
||||
import qualified ChuSQL.Core.Model as SQL
|
||||
import ChuSQL.Core.Protocol (valueToJSON, valueFromJSON, TableInfo (..))
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Word (Word64)
|
||||
import Data.Aeson.Types (parseEither)
|
||||
import Data.Hashable (hash)
|
||||
import Control.Monad (foldM)
|
||||
import qualified Data.ByteString.Lazy.Char8 as BS
|
||||
import Data.List (isInfixOf)
|
||||
import Data.Bifunctor (second)
|
||||
import Test.Hspec
|
||||
|
||||
-- 运行时类型、函数绑定、物理编码和类型化查询测试。
|
||||
|
||||
-- | 执行语句建立测试目录
|
||||
sqlCatalog :: [String] -> Either String SQL.Database
|
||||
sqlCatalog = foldM apply []
|
||||
where
|
||||
-- | 更新当前测试数据库
|
||||
apply db source = do
|
||||
statement <- parseStatement source
|
||||
fst <$> runStatement db statement
|
||||
|
||||
-- | 检查运行时类型基础契约
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "bound write plans" $ do
|
||||
it "reuses INSERT targets and constraints while refreshing the auto counter" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN cached_quantity AS INT"
|
||||
, "CREATE TABLE cached_insert (id INT AUTO_INCREMENT PRIMARY KEY, qty cached_quantity DEFAULT 2, tag TEXT CHECK (length(tag) > 1))"]
|
||||
statement <- parseStatement "INSERT INTO cached_insert (tag) VALUES ('abc')"
|
||||
bound <- bindWrite db statement
|
||||
(first, inserted) <- runMemoryStorage (executeWriteM bound) db
|
||||
first
|
||||
let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- inserted]
|
||||
(secondResult, final) <- runMemoryStorage (executeWriteM bound) reversed
|
||||
secondResult
|
||||
select <- parseStatement "SELECT id, qty, tag FROM cached_insert"
|
||||
map (map snd) <$> rowsOf (runStatement final select)
|
||||
result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 2, SQL.VStr "abc"], [SQL.VInt 2, SQL.VInt 2, SQL.VStr "abc"]]
|
||||
it "reuses ordered UPDATE targets and final-row uniqueness checks" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE cached_update (id INT PRIMARY KEY, qty INT NOT NULL UNIQUE CHECK (qty < 10))"
|
||||
, "INSERT INTO cached_update (id, qty) VALUES (1, 1), (2, 8)"]
|
||||
statement <- parseStatement "UPDATE cached_update SET qty = qty + 1, qty = qty + id WHERE id = 1"
|
||||
bound <- bindWrite db statement
|
||||
duplicate <- parseStatement "UPDATE cached_update SET qty = 8 WHERE id = 1" >>= bindWrite db
|
||||
(first, updated) <- runMemoryStorage (executeWriteM bound) db
|
||||
first
|
||||
(secondResult, twice) <- runMemoryStorage (executeWriteM bound) updated
|
||||
secondResult
|
||||
(rejected, unchanged) <- runMemoryStorage (executeWriteM duplicate) twice
|
||||
Right (SQL.tableRows <$> lookup "cached_update" twice, rejected
|
||||
, SQL.tableRows <$> lookup "cached_update" unchanged)
|
||||
rows = Just [[("id", SQL.VInt 1), ("qty", SQL.VInt 5)], [("id", SQL.VInt 2), ("qty", SQL.VInt 8)]]
|
||||
result `shouldBe` Right (rows, Left "UNIQUE: duplicate value in column qty", rows)
|
||||
it "defers assignment errors until a reused plan matches a current row" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE deferred_write (id INT, qty INT CHECK (qty > 0))"]
|
||||
statement <- parseStatement "UPDATE deferred_write SET qty = 1 / 0 WHERE id = 9"
|
||||
bound <- bindWrite db statement
|
||||
(empty, initial) <- runMemoryStorage (executeWriteM bound) db
|
||||
empty
|
||||
inserted <- parseStatement "INSERT INTO deferred_write (id, qty) VALUES (9, 5)" >>= runStatement initial
|
||||
(rejected, final) <- runMemoryStorage (executeWriteM bound) (fst inserted)
|
||||
Right (rejected, SQL.tableRows <$> lookup "deferred_write" final)
|
||||
result `shouldBe` Right (Left "division by zero", Just [[("id", SQL.VInt 9), ("qty", SQL.VInt 5)]])
|
||||
it "rejects stale INSERT UPDATE and DELETE plans before changing rows" $ do
|
||||
mapM_ (\source -> do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE saved_write (id INT, qty INT)", "INSERT INTO saved_write (id, qty) VALUES (1, 5)"]
|
||||
statement <- parseStatement source
|
||||
bound <- bindWrite db statement
|
||||
added <- parseStatement "ALTER TABLE saved_write ADD COLUMN extra TEXT" >>= runStatement db
|
||||
restored <- parseStatement "ALTER TABLE saved_write DROP COLUMN extra" >>= runStatement (fst added)
|
||||
(rejected, final) <- runMemoryStorage (executeWriteM bound) (fst restored)
|
||||
Right (rejected, SQL.tableRows <$> lookup "saved_write" final)
|
||||
result `shouldBe` Right (Left "bound query schema changed: saved_write", Just [[("id", SQL.VInt 1), ("qty", SQL.VInt 5)]]))
|
||||
[ "INSERT INTO saved_write (id, qty) VALUES (2, 8)"
|
||||
, "UPDATE saved_write SET qty = qty + 1"
|
||||
, "DELETE FROM saved_write WHERE id = 1"
|
||||
]
|
||||
it "reuses a write plan across data and unrelated schema changes" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE reusable_write (id INT, qty INT)", "CREATE TABLE unrelated_write (id INT)", "INSERT INTO reusable_write (id, qty) VALUES (1, 5)"]
|
||||
statement <- parseStatement "UPDATE reusable_write SET qty = qty + 1 WHERE id = 1"
|
||||
bound <- bindWrite db statement
|
||||
changed <- parseStatement "INSERT INTO reusable_write (id, qty) VALUES (2, 9)" >>= runStatement db
|
||||
unrelated <- parseStatement "ALTER TABLE unrelated_write ADD COLUMN extra TEXT" >>= runStatement (fst changed)
|
||||
(first, updated) <- runMemoryStorage (executeWriteM bound) (fst unrelated)
|
||||
first
|
||||
(secondResult, final) <- runMemoryStorage (executeWriteM bound) updated
|
||||
secondResult
|
||||
Right (SQL.tableRows <$> lookup "reusable_write" final)
|
||||
result `shouldBe` Right (Just [[("id", SQL.VInt 1), ("qty", SQL.VInt 7)], [("id", SQL.VInt 2), ("qty", SQL.VInt 9)]])
|
||||
it "rejects replaced targets and changed subquery or DOMAIN dependencies" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN quantity AS INT", "CREATE TABLE dependent_write (id quantity)", "CREATE TABLE source_write (id INT)"]
|
||||
statement <- parseStatement "UPDATE dependent_write SET id = (SELECT MAX(id) FROM source_write)"
|
||||
let identified = [(name, table {SQL.tableIdentity = Just (SQL.TableIdentity 1 1)}) | (name, table) <- db]
|
||||
bound <- bindWrite identified statement
|
||||
let replaced = [(name, if name == "dependent_write" then table {SQL.tableIdentity = Just (SQL.TableIdentity 1 2)} else table) | (name, table) <- identified]
|
||||
domainChanged = [(name, if name == SQL.domainTableName "quantity" then table {SQL.tableSchemaVersion = Just 2} else table) | (name, table) <- identified]
|
||||
changed <- parseStatement "ALTER TABLE source_write ADD COLUMN extra TEXT" >>= runStatement identified
|
||||
target <- fst <$> runMemoryStorage (executeWriteM bound) replaced
|
||||
dependency <- fst <$> runMemoryStorage (executeWriteM bound) (fst changed)
|
||||
domain <- fst <$> runMemoryStorage (executeWriteM bound) domainChanged
|
||||
Right (target, dependency, domain)
|
||||
result `shouldBe` Right (Left "bound query object changed: dependent_write", Left "bound query schema changed: source_write", Left "bound query schema changed: __system_domain_quantity")
|
||||
describe "runtime type registry" $ do
|
||||
it "keeps a fixed identity encoding across releases" $ withType (listType intType) $ \tid ->
|
||||
encodeType tid `shouldBe` BS.pack "[1,[5,[[1,[]]]]]"
|
||||
it "parses nested Haskell-style type expressions" $
|
||||
parseTypeExpr "(Int, [Maybe String])" `shouldBe` Right (tupleType [intType, listType (maybeType stringType)])
|
||||
it "rejects constructor names without a token boundary" $
|
||||
parseTypeExpr "MaybeInt" `shouldSatisfy` isFailure
|
||||
it "restores stable nested identities from bootstrap metadata" $ do
|
||||
let ty = tupleType [listType intType, maybeType stringType]
|
||||
fmap descriptorPhysical (resolveType builtinTypes ty)
|
||||
`shouldBe` Right (Product [Sequence SignedInteger, Optional Utf8])
|
||||
it "distinguishes logical String from List Int" $
|
||||
fmap descriptorId (resolveType builtinTypes stringType)
|
||||
`shouldNotBe` fmap descriptorId (resolveType builtinTypes (listType intType))
|
||||
it "rejects unknown constructors" $
|
||||
resolveType builtinTypes (TypeApply (TypeConstructorId 99) []) `shouldSatisfy` isFailure
|
||||
it "rejects unapplied List" $
|
||||
resolveType builtinTypes (TypeApply (TypeConstructorId 5) []) `shouldSatisfy` isFailure
|
||||
it "rejects arguments to Int" $
|
||||
resolveType builtinTypes (TypeApply (TypeConstructorId 1) [intType]) `shouldSatisfy` isFailure
|
||||
describe "bound write expressions" $ do
|
||||
it "rejects missing existing key columns instead of skipping uniqueness checks" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE constraint_slots (id INT PRIMARY KEY, qty INT UNIQUE)"]
|
||||
insert <- parseStatement "INSERT INTO constraint_slots (id, qty) VALUES (2, 3)"
|
||||
let damaged = [(name, table {SQL.tableRows = [[("qty", SQL.VInt 9)]]}) | (name, table) <- db]
|
||||
Right (runStatement damaged insert)
|
||||
case result of
|
||||
Right rejected -> rejected `shouldSatisfy` either (isInfixOf "missing bound column: id") (const False)
|
||||
Left err -> expectationFailure err
|
||||
it "checks existing INSERT keys and ALTER constraints with reversed physical columns" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE constraint_order (id INT PRIMARY KEY, qty INT UNIQUE)"
|
||||
, "INSERT INTO constraint_order (id, qty) VALUES (1, 2), (2, 3)"]
|
||||
let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
|
||||
insert <- parseStatement "INSERT INTO constraint_order (qty, id) VALUES (4, 3)"
|
||||
(inserted, _) <- runStatement reversed insert
|
||||
alter <- parseStatement "ALTER TABLE constraint_order ALTER COLUMN qty SET NOT NULL"
|
||||
(altered, _) <- runStatement inserted alter
|
||||
select <- parseStatement "SELECT id, qty FROM constraint_order"
|
||||
map (map snd) <$> rowsOf (runStatement altered select)
|
||||
result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 2], [SQL.VInt 2, SQL.VInt 3], [SQL.VInt 3, SQL.VInt 4]]
|
||||
it "rejects missing ALTER input before evaluating bound constraints" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE altered_missing (id INT, qty INT UNIQUE)"]
|
||||
alter <- parseStatement "ALTER TABLE altered_missing ALTER COLUMN qty SET NOT NULL"
|
||||
let damaged = [(name, table {SQL.tableRows = [[("id", SQL.VInt 1)]]}) | (name, table) <- db]
|
||||
Right (runStatement damaged alter)
|
||||
case result of
|
||||
Right rejected -> rejected `shouldSatisfy` either (isInfixOf "missing bound column: qty") (const False)
|
||||
Left err -> expectationFailure err
|
||||
it "rejects UPDATE nullability and final-row uniqueness violations" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE update_constraints (id INT PRIMARY KEY, qty INT NOT NULL UNIQUE)"
|
||||
, "INSERT INTO update_constraints (id, qty) VALUES (1, 2), (2, 3)"]
|
||||
nullable <- parseStatement "UPDATE update_constraints SET qty = NULL WHERE id = 1"
|
||||
duplicate <- parseStatement "UPDATE update_constraints SET qty = 3 WHERE id = 1"
|
||||
primary <- parseStatement "UPDATE update_constraints SET id = 2 WHERE id = 1"
|
||||
Right (db, [(nullable, "NOT NULL"), (duplicate, "UNIQUE"), (primary, "UNIQUE")])
|
||||
case result of
|
||||
Right (db, statements) -> mapM_ (\(statement, marker) ->
|
||||
case runMemoryStorage (runStatementM statement) db of
|
||||
Right (Left err, unchanged) -> do
|
||||
err `shouldSatisfy` isInfixOf marker
|
||||
map (second SQL.tableRows) unchanged
|
||||
`shouldBe` map (second SQL.tableRows) db
|
||||
other -> expectationFailure (show other)) statements
|
||||
Left err -> expectationFailure err
|
||||
it "checks UPDATE uniqueness after all rows rather than each replacement" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE update_unique (id INT PRIMARY KEY, qty INT UNIQUE)"
|
||||
, "INSERT INTO update_unique (id, qty) VALUES (1, 2), (2, 3), (3, NULL), (4, NULL)"
|
||||
, "UPDATE update_unique SET qty = qty + 1 WHERE id < 3"]
|
||||
select <- parseStatement "SELECT id, qty FROM update_unique"
|
||||
map (map snd) <$> rowsOf (runStatement db select)
|
||||
result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 3], [SQL.VInt 2, SQL.VInt 4]
|
||||
, [SQL.VInt 3, SQL.VNull], [SQL.VInt 4, SQL.VNull]]
|
||||
it "rejects repeated INSERT targets instead of discarding later values" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE insert_targets (id INT, qty INT)"]
|
||||
statement <- parseStatement "INSERT INTO insert_targets (id, qty, qty) VALUES (1, 2, 9)"
|
||||
runStatement db statement
|
||||
result `shouldSatisfy` either (isInfixOf "INSERT: duplicate target column: qty") (const False)
|
||||
it "binds reordered INSERT inputs while retaining defaults, NULL and auto numbering" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN insert_label AS VARCHAR(4)"
|
||||
, "CREATE TABLE insert_slots (id INT AUTO_INCREMENT PRIMARY KEY, label insert_label DEFAULT 'ok', qty INT DEFAULT 7)"
|
||||
, "INSERT INTO insert_slots (qty, label, id) VALUES (NULL, 'ab', 10), (3, 'cd', NULL), (4, 'ef', 2)"
|
||||
, "INSERT INTO insert_slots (label) VALUES ('gh')"
|
||||
, "INSERT INTO insert_slots (qty) VALUES (8)"]
|
||||
select <- parseStatement "SELECT id, label, qty FROM insert_slots"
|
||||
map (map snd) <$> rowsOf (runStatement db select)
|
||||
result `shouldBe` Right [[SQL.VInt 10, SQL.VStr "ab", SQL.VNull]
|
||||
, [SQL.VInt 11, SQL.VStr "cd", SQL.VInt 3]
|
||||
, [SQL.VInt 2, SQL.VStr "ef", SQL.VInt 4]
|
||||
, [SQL.VInt 12, SQL.VStr "gh", SQL.VInt 7]
|
||||
, [SQL.VInt 13, SQL.VStr "ok", SQL.VInt 8]]
|
||||
it "binds write predicates and assignments to target schema positions" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE write_slots (id INT, qty INT)"]
|
||||
statement <- parseStatement "UPDATE write_slots SET qty = qty + id WHERE id = 1"
|
||||
prepare db statement >>= bindWriteColumns db
|
||||
result `shouldBe` Right (Update "write_slots"
|
||||
[("qty", Add (ColumnSlot 1 "qty") (ColumnSlot 0 "id"))]
|
||||
(Just (Eq (ColumnSlot 0 "id") (LitInt 1))))
|
||||
it "binds CHECK columns inside resolved function calls" $ do
|
||||
let columns = [("id", SQL.plainColumn SQL.CInt), ("name", SQL.plainColumn SQL.CStr)]
|
||||
result = prepareRowExpression columns (Gt (FunctionCall "length" [Col "name"]) (LitInt 1))
|
||||
case result of
|
||||
Right (Gt (BoundFunction (FunctionId 1) _ [ColumnSlot 1 "name"]) (LitInt 1)) -> pure ()
|
||||
_ -> expectationFailure (show result)
|
||||
it "preserves sequential updates and row order with reversed physical columns" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE write_slots (id INT, qty INT CHECK (qty >= 0))"
|
||||
, "INSERT INTO write_slots (id, qty) VALUES (1, 2), (2, 10), (3, 5)"]
|
||||
let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
|
||||
update <- parseStatement "UPDATE write_slots SET qty = qty + 1, qty = qty + id WHERE id = 1"
|
||||
(updated, _) <- runStatement reversed update
|
||||
delete <- parseStatement "DELETE FROM write_slots WHERE qty = 10"
|
||||
(remaining, _) <- runStatement updated delete
|
||||
select <- parseStatement "SELECT id, qty FROM write_slots"
|
||||
map (map snd) <$> rowsOf (runStatement remaining select)
|
||||
result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 4], [SQL.VInt 3, SQL.VInt 5]]
|
||||
it "keeps nested DOMAIN coercion, defaults and nullable writes" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN short_label AS VARCHAR(4)", "CREATE DOMAIN label AS short_label"
|
||||
, "CREATE TABLE write_domains (id INT, name label CHECK (length(name) > 1), qty INT DEFAULT 2)"
|
||||
, "INSERT INTO write_domains (id, name) VALUES (1, 'abc')"]
|
||||
select <- parseStatement "SELECT id, name, qty FROM write_domains"
|
||||
original <- map (map snd) <$> rowsOf (runStatement db select)
|
||||
update <- parseStatement "UPDATE write_domains SET qty = NULL WHERE id = 1"
|
||||
(updated, _) <- runStatement db update
|
||||
rejected <- parseStatement "UPDATE write_domains SET name = 'abcde' WHERE id = 1"
|
||||
rows <- map (map snd) <$> rowsOf (runStatement updated select)
|
||||
Right (original, rows, runStatement updated rejected)
|
||||
case result of
|
||||
Right (original, rows, rejected) -> do
|
||||
original `shouldBe` [[SQL.VInt 1, SQL.VStr "abc", SQL.VInt 2]]
|
||||
rows `shouldBe` [[SQL.VInt 1, SQL.VStr "abc", SQL.VNull]]
|
||||
rejected `shouldSatisfy` isFailure
|
||||
Left err -> expectationFailure err
|
||||
it "keeps correlated subqueries in bound assignments and DELETE predicates" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE write_outer (id INT, qty INT)"
|
||||
, "CREATE TABLE write_inner (id INT)"
|
||||
, "INSERT INTO write_outer (id, qty) VALUES (1, 2), (2, 10)"
|
||||
, "INSERT INTO write_inner (id) VALUES (2)"]
|
||||
update <- parseStatement "UPDATE write_outer SET qty = qty + (SELECT i.id FROM write_inner i WHERE i.id = qty) WHERE id = 1"
|
||||
(updated, _) <- runStatement db update
|
||||
select <- parseStatement "SELECT id, qty FROM write_outer"
|
||||
changed <- map (map snd) <$> rowsOf (runStatement updated select)
|
||||
delete <- parseStatement "DELETE FROM write_outer WHERE EXISTS (SELECT i.id FROM write_inner i WHERE i.id = qty - 2)"
|
||||
(remaining, _) <- runStatement updated delete
|
||||
kept <- map (map snd) <$> rowsOf (runStatement remaining select)
|
||||
Right (changed, kept)
|
||||
result `shouldBe` Right ([[SQL.VInt 1, SQL.VInt 4], [SQL.VInt 2, SQL.VInt 10]]
|
||||
, [[SQL.VInt 2, SQL.VInt 10]])
|
||||
it "checks altered rows using schema order and keeps CHECK failures explicit" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE write_checks (id INT, qty INT CHECK (qty > id))"
|
||||
, "INSERT INTO write_checks (id, qty) VALUES (1, 3)"]
|
||||
let reversed = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
|
||||
alter <- parseStatement "ALTER TABLE write_checks ADD COLUMN note TEXT DEFAULT 'ok'"
|
||||
(altered, _) <- runStatement reversed alter
|
||||
invalid <- parseStatement "UPDATE write_checks SET qty = 0 WHERE id = 1"
|
||||
Right (runStatement altered invalid)
|
||||
case result of
|
||||
Right (Left err) -> err `shouldSatisfy` isInfixOf "CHECK on qty failed"
|
||||
other -> expectationFailure (show other)
|
||||
it "does not evaluate skipped assignments or empty DELETE predicates" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE write_lazy (id INT, qty INT)"
|
||||
, "INSERT INTO write_lazy (id, qty) VALUES (1, 2)"]
|
||||
update <- parseStatement "UPDATE write_lazy SET qty = 1 / 0 WHERE id = 99"
|
||||
(updated, _) <- runStatement db update
|
||||
delete <- parseStatement "DELETE FROM write_lazy"
|
||||
(empty, _) <- runStatement updated delete
|
||||
invalid <- parseStatement "DELETE FROM write_lazy WHERE 1 / 0 = 1"
|
||||
runStatement empty invalid
|
||||
result `shouldSatisfy` either (const False) (const True)
|
||||
it "rejects missing physical columns before a write" $ do
|
||||
let db = [("write_missing", SQL.Table "write_missing"
|
||||
[("id", SQL.plainColumn SQL.CInt), ("qty", SQL.plainColumn SQL.CInt)]
|
||||
[[("id", SQL.VInt 1)]] Nothing Nothing Nothing)]
|
||||
mapM_ (\source -> rowsOf (parseStatement source >>= runStatement db)
|
||||
`shouldBe` Left "missing bound column: qty")
|
||||
["UPDATE write_missing SET id = 2", "DELETE FROM write_missing WHERE id = 1"]
|
||||
describe "runtime encoding" $ do
|
||||
it "round trips nested lists, optional values and tuples" $ do
|
||||
let ty = tupleType [listType (maybeType intType), stringType, doubleType, boolType]
|
||||
value = RTuple [RList [RMaybe Nothing, RMaybe (Just (RInt 42))], RString "你好", RDouble 1.25, RBool True]
|
||||
withType ty $ \tid -> do
|
||||
(encodeValue builtinTypes tid value >>= decodeValue builtinTypes tid) `shouldBe` Right value
|
||||
decodeType builtinTypes (encodeType tid) `shouldBe` Right tid
|
||||
it "round trips the empty tuple" $ withType (tupleType []) $ \tid ->
|
||||
(encodeValue builtinTypes tid (RTuple []) >>= decodeValue builtinTypes tid) `shouldBe` Right (RTuple [])
|
||||
it "rejects mismatched list elements" $ withType (listType intType) $ \tid ->
|
||||
encodeValue builtinTypes tid (RList [RString "bad"]) `shouldSatisfy` isFailure
|
||||
it "rejects tuple arity mismatch" $ withType (tupleType [intType]) $ \tid ->
|
||||
encodeValue builtinTypes tid (RTuple []) `shouldSatisfy` isFailure
|
||||
it "rejects non-finite floating point values" $ withType doubleType $ \tid ->
|
||||
encodeValue builtinTypes tid (RDouble (1 / 0)) `shouldSatisfy` isFailure
|
||||
it "rejects unsupported type encoding versions" $
|
||||
decodeType builtinTypes (BS.pack "[2,[1,[]]]") `shouldSatisfy` isFailure
|
||||
it "rejects overflowed constructor identities" $
|
||||
decodeType builtinTypes (BS.pack "[1,[18446744073709551617,[]]]") `shouldSatisfy` isFailure
|
||||
it "rejects fractional integer payloads" $ withType intType $ \tid ->
|
||||
decodeValue builtinTypes tid (BS.pack "[1,[1,[]],1.5]") `shouldSatisfy` isFailure
|
||||
it "rejects encoded identity mismatch" $ withType intType $ \tid ->
|
||||
decodeValue builtinTypes tid (BS.pack "[1,[4,[]],\"x\"]") `shouldSatisfy` isFailure
|
||||
describe "runtime binder and executor" $ do
|
||||
it "resolves case-insensitive length to a stable FunctionId" $ withFunctions $ \functions ->
|
||||
withType stringType $ \string -> withType intType $ \int ->
|
||||
resolveFunction functions "LENGTH" [string]
|
||||
`shouldBe` Right (FunctionSignature (FunctionId 1) "length" [string] int)
|
||||
it "binds and executes nested calls" $ withFunctions $ \functions -> do
|
||||
let expression = Apply "not" [Apply "not" [Literal boolType (RBool True)]]
|
||||
(bindExpression builtinTypes functions [] expression >>= evaluateExpression builtinTypes functions [])
|
||||
`shouldBe` Right (RBool True)
|
||||
it "uses the bound column slot and rejects reordered expression input" $ withFunctions $ \functions ->
|
||||
withType intType $ \int -> withType stringType $ \string -> do
|
||||
let bound = bindExpression builtinTypes functions [("count", int), ("name", string)]
|
||||
(Apply "length" [Reference "name"])
|
||||
(bound >>= evaluateExpression builtinTypes functions [("count", RInt 1), ("name", RString "abc")])
|
||||
`shouldBe` Right (RInt 3)
|
||||
(bound >>= evaluateExpression builtinTypes functions [("name", RString "abc"), ("count", RInt 1)])
|
||||
`shouldBe` Left "bound column position mismatch: name"
|
||||
(bound >>= evaluateExpression builtinTypes functions [("count", RInt 1)])
|
||||
`shouldBe` Left "missing bound column: name"
|
||||
it "rejects ambiguous references before binding a slot" $ withFunctions $ \functions ->
|
||||
withType intType $ \int ->
|
||||
bindExpression builtinTypes functions [("id", int), ("id", int)] (Reference "id")
|
||||
`shouldSatisfy` isFailure
|
||||
it "normalizes storage order at scan boundaries before evaluating slots" $ withFunctions $ \functions -> do
|
||||
let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
|
||||
query = Projection [("size", Apply "length" [Reference "name"])]
|
||||
(Selection (Reference "enabled") (TableScan "items"))
|
||||
scan _ = Right [[("enabled", RBool True), ("name", RString "abc")]]
|
||||
(bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
|
||||
`shouldBe` Right [[("size", RInt 3)]]
|
||||
it "rebinds slots to each projection output schema" $ withFunctions $ \functions -> do
|
||||
let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
|
||||
source = Projection [("enabled", Reference "enabled"), ("label", Reference "name")]
|
||||
(TableScan "items")
|
||||
query = Projection [("size", Apply "length" [Reference "label"])] source
|
||||
scan _ = Right [[("name", RString "abc"), ("enabled", RBool True)]]
|
||||
(bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
|
||||
`shouldBe` Right [[("size", RInt 3)]]
|
||||
it "rejects a wrong function argument type during binding" $ withFunctions $ \functions ->
|
||||
bindExpression builtinTypes functions [] (Apply "length" [Literal intType (RInt 1)]) `shouldSatisfy` isFailure
|
||||
it "rejects unknown function identities" $ withFunctions $ \functions ->
|
||||
invokeFunction builtinTypes functions (FunctionId 99) [] `shouldSatisfy` isFailure
|
||||
it "rejects wrong runtime argument types" $ withFunctions $ \functions ->
|
||||
invokeFunction builtinTypes functions (FunctionId 1) [RInt 1] `shouldSatisfy` isFailure
|
||||
it "binds empty List and Nothing using explicit element types" $ withFunctions $ \functions -> do
|
||||
let expression = TupleLiteral [ListLiteral intType [], NothingLiteral stringType]
|
||||
(bindExpression builtinTypes functions [] expression >>= evaluateExpression builtinTypes functions [])
|
||||
`shouldBe` Right (RTuple [RList [], RMaybe Nothing])
|
||||
it "rejects mixed logical list types" $ withFunctions $ \functions ->
|
||||
bindExpression builtinTypes functions [] (ListLiteral intType [Literal doubleType (RDouble 1)]) `shouldSatisfy` isFailure
|
||||
it "binds queries using schema without reading storage" $ withFunctions $ \functions -> do
|
||||
let catalog = [("items", [("name", stringType), ("enabled", boolType)])]
|
||||
query = Projection [("size", Apply "length" [Reference "name"])]
|
||||
(Selection (Reference "enabled") (TableScan "items"))
|
||||
scan name = if name == "items" then Right
|
||||
[[("name", RString "甲乙"), ("enabled", RBool True)]
|
||||
,[("name", RString "hidden"), ("enabled", RBool False)]] else Left "unknown storage table"
|
||||
(bindPlan builtinTypes functions catalog query >>= executePlan builtinTypes functions scan)
|
||||
`shouldBe` Right [[("size", RInt 2)]]
|
||||
it "uses catalog existence even when storage could return rows" $ withFunctions $ \functions ->
|
||||
bindPlan builtinTypes functions [] (TableScan "missing") `shouldSatisfy` isFailure
|
||||
it "rejects non-boolean filters" $ withFunctions $ \functions ->
|
||||
bindPlan builtinTypes functions [] (Selection (Literal intType (RInt 1)) SingleRow) `shouldSatisfy` isFailure
|
||||
it "rejects schema drift returned by storage" $ withFunctions $ \functions ->
|
||||
(bindPlan builtinTypes functions [("t", [("x", intType)])] (TableScan "t")
|
||||
>>= executePlan builtinTypes functions (const (Right [[("x", RString "wrong")]]))) `shouldSatisfy` isFailure
|
||||
it "propagates storage failures" $ withFunctions $ \functions ->
|
||||
(bindPlan builtinTypes functions [("t", [])] (TableScan "t")
|
||||
>>= executePlan builtinTypes functions (const (Left "storage unavailable"))) `shouldBe` Left "storage unavailable"
|
||||
describe "SQL runtime functions" $ do
|
||||
it "validates transitive DOMAIN dependencies and ignores unrelated definitions" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN amount AS INT", "CREATE DOMAIN total AS amount"
|
||||
, "CREATE DOMAIN unrelated AS TEXT", "CREATE TABLE amounts (value total)"]
|
||||
statement <- parseStatement "SELECT value FROM amounts"
|
||||
bound <- Query.bindQuery db statement
|
||||
let change target = [(name, if name == target then table {SQL.tableCols = [("base", SQL.plainColumn SQL.CBool)]}
|
||||
else table) | (name, table) <- db]
|
||||
accepted <- fst <$> runMemoryStorage (Query.executeQueryM bound) (change "__system_domain_unrelated")
|
||||
rejected <- fst <$> runMemoryStorage (Query.executeQueryM bound) (change "__system_domain_amount")
|
||||
Right (accepted, rejected)
|
||||
result `shouldBe` Right (Right [], Left "bound query schema changed: __system_domain_amount")
|
||||
it "preserves exact catalog identities and rejects malformed identifiers" $ do
|
||||
let identity = SQL.TableIdentity (maxBound :: Word64) (maxBound :: Word64)
|
||||
info = TableInfo "items" [] 0 [] [] [] (Just identity) Nothing
|
||||
decode text = A.eitherDecode (BS.pack text) :: Either String TableInfo
|
||||
A.fromJSON (A.toJSON info) `shouldBe` A.Success info
|
||||
fmap tiIdentity (decode "{\"table\":\"items\",\"columns\":[],\"row_count\":0}") `shouldBe` Right Nothing
|
||||
fmap tiIdentity (decode "{\"table\":\"items\",\"columns\":[],\"row_count\":0,\"database_id\":0,\"object_id\":1}")
|
||||
`shouldBe` Right (Just (SQL.TableIdentity 0 1))
|
||||
mapM_ (\fields -> decode ("{\"table\":\"items\",\"columns\":[],\"row_count\":0," ++ fields ++ "}")
|
||||
`shouldSatisfy` isFailure)
|
||||
["\"database_id\":1", "\"database_id\":1,\"object_id\":-1"
|
||||
, "\"database_id\":1,\"object_id\":1.5", "\"database_id\":1,\"object_id\":\"18446744073709551616\""
|
||||
, "\"database_id\":1,\"object_id\":1e99999999"]
|
||||
it "rejects a same-schema replacement or loss of object identity" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE bound_items (id INT)"]
|
||||
let identified = [(name, table {SQL.tableIdentity = Just (SQL.TableIdentity 1 1)}) | (name, table) <- db]
|
||||
statement <- parseStatement "SELECT id FROM bound_items"
|
||||
bound <- Query.bindQuery identified statement
|
||||
let replaced = [(name, table {SQL.tableIdentity = Just (SQL.TableIdentity 1 2)}) | (name, table) <- db]
|
||||
changed <- fst <$> runMemoryStorage (Query.executeQueryM bound) replaced
|
||||
lost <- fst <$> runMemoryStorage (Query.executeQueryM bound) db
|
||||
Right (changed, lost)
|
||||
result `shouldBe` Right (Left "bound query object changed: bound_items", Left "bound query object changed: bound_items")
|
||||
it "preserves exact schema versions and rejects malformed versions" $ do
|
||||
let info = TableInfo "items" [] 0 [] [] [] Nothing (Just maxBound)
|
||||
decode version = A.eitherDecode (BS.pack ("{\"table\":\"items\",\"columns\":[],\"row_count\":0,\"schema_version\":" ++ version ++ "}")) :: Either String TableInfo
|
||||
A.fromJSON (A.toJSON info) `shouldBe` A.Success info
|
||||
fmap tiSchemaVersion (decode "0") `shouldBe` Right Nothing
|
||||
fmap tiSchemaVersion (decode "7") `shouldBe` Right (Just 7)
|
||||
mapM_ (\version -> decode version `shouldSatisfy` isFailure)
|
||||
["-1", "1.5", "\"18446744073709551616\"", "\"+1\"", "1e99999999"]
|
||||
it "invalidates a bound query after restoring its original columns" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE versioned (id INT)"]
|
||||
statement <- parseStatement "SELECT id FROM versioned"
|
||||
bound <- Query.bindQuery db statement
|
||||
added <- parseStatement "ALTER TABLE versioned ADD COLUMN extra TEXT" >>= runStatement db
|
||||
restored <- parseStatement "ALTER TABLE versioned DROP COLUMN extra" >>= runStatement (fst added)
|
||||
fst <$> runMemoryStorage (Query.executeQueryM bound) (fst restored)
|
||||
result `shouldBe` Right (Left "bound query schema changed: versioned")
|
||||
it "rejects loss of a bound schema version" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE versioned (id INT)"]
|
||||
statement <- parseStatement "SELECT id FROM versioned"
|
||||
bound <- Query.bindQuery db statement
|
||||
fst <$> runMemoryStorage (Query.executeQueryM bound)
|
||||
[(name, table {SQL.tableSchemaVersion = Nothing}) | (name, table) <- db]
|
||||
result `shouldBe` Right (Left "bound query schema changed: versioned")
|
||||
it "ignores unrelated table changes but validates nested query dependencies" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE referenced (id INT)", "CREATE TABLE unrelated (id INT)"]
|
||||
statement <- parseStatement "SELECT length((SELECT MIN(name) FROM (SELECT 'abc' AS name FROM referenced) d)) AS n"
|
||||
bound <- Query.bindQuery db statement
|
||||
unrelated <- parseStatement "ALTER TABLE unrelated ADD COLUMN extra TEXT" >>= runStatement db
|
||||
accepted <- fst <$> runMemoryStorage (Query.executeQueryM bound) (fst unrelated)
|
||||
referenced <- parseStatement "ALTER TABLE referenced ADD COLUMN extra TEXT" >>= runStatement db
|
||||
rejected <- fst <$> runMemoryStorage (Query.executeQueryM bound) (fst referenced)
|
||||
Right (accepted, rejected)
|
||||
result `shouldBe` Right (Right [[("n", SQL.VNull)]], Left "bound query schema changed: referenced")
|
||||
it "guards tables referenced only by HAVING or expression ordering" $ do
|
||||
let result query = do
|
||||
db <- sqlCatalog ["CREATE TABLE main_rows (id INT)", "CREATE TABLE dependency_rows (id INT)"]
|
||||
bound <- parseStatement query >>= Query.bindQuery db
|
||||
changed <- parseStatement "ALTER TABLE dependency_rows ADD COLUMN extra TEXT" >>= runStatement db
|
||||
fst <$> runMemoryStorage (Query.executeQueryM bound) (fst changed)
|
||||
mapM_ (\query -> result query `shouldBe` Right (Left "bound query schema changed: dependency_rows"))
|
||||
[ "SELECT COUNT(*) FROM main_rows HAVING COUNT(*) > (SELECT COUNT(*) FROM dependency_rows)"
|
||||
, "SELECT id FROM main_rows ORDER BY (SELECT COUNT(*) FROM dependency_rows) + id"
|
||||
]
|
||||
it "rejects schema drift before executing an empty bound query" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE bound_items (id INT)"]
|
||||
statement <- parseStatement "SELECT id FROM bound_items"
|
||||
bound <- Query.bindQuery db statement
|
||||
changed <- parseStatement "ALTER TABLE bound_items ADD COLUMN extra TEXT" >>= runStatement db
|
||||
fst <$> runMemoryStorage (Query.executeQueryM bound) (fst changed)
|
||||
result `shouldBe` Right (Left "bound query schema changed: bound_items")
|
||||
it "keeps binding valid across row and statistics changes" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE bound_items (id INT)"]
|
||||
statement <- parseStatement "SELECT id FROM bound_items"
|
||||
bound <- Query.bindQuery db statement
|
||||
changed <- parseStatement "INSERT INTO bound_items (id) VALUES (7)" >>= runStatement db
|
||||
let current = [(name, table {SQL.tableMeta = Just (SQL.TableMeta 100 [] [] [])})
|
||||
| (name, table) <- fst changed]
|
||||
fst <$> runMemoryStorage (Query.executeQueryM bound) current
|
||||
result `shouldBe` Right (Right [[("id", SQL.VInt 7)]])
|
||||
it "binds grouping keys and then sorting to the grouped output" $ do
|
||||
let source = Rel.Compute [("first", LitInt 1), ("key", LitInt 2)] Rel.Unit
|
||||
plan = Rel.Sort [("key", Desc)] (Rel.Aggregate ["key"] [("n", CountAll)] source)
|
||||
bound = Rel.BoundSort [(ColumnSlot 0 "key", Desc)]
|
||||
(Rel.BoundAggregate [("key", ColumnSlot 1 "key")] [("n", CountAll)] source)
|
||||
bindRelOpColumns [] [] plan `shouldBe` Right bound
|
||||
evalRelOp [] bound `shouldBe` Right [[("key", SQL.VInt 2), ("n", SQL.VInt 1)]]
|
||||
evalRelOp [] (Rel.BoundAggregate [("key", ColumnSlot 0 "key")] [] source)
|
||||
`shouldBe` Left "bound column position mismatch: key"
|
||||
it "sorts bound NULL keys stably and rejects wrong slots" $ do
|
||||
let a = [("id", SQL.VInt 1), ("key", SQL.VInt 2)]
|
||||
b = [("id", SQL.VInt 2), ("key", SQL.VNull)]
|
||||
c = [("id", SQL.VInt 3), ("key", SQL.VInt 2)]
|
||||
sortBoundRows [(ColumnSlot 1 "key", Asc)] [] [a, b, c] `shouldBe` Right [b, a, c]
|
||||
sortBoundRows [(ColumnSlot 1 "key", Desc)] [] [a, b, c] `shouldBe` Right [a, c, b]
|
||||
sortBoundRows [(ColumnSlot 0 "key", Asc)] [] [a]
|
||||
`shouldBe` Left "bound column position mismatch: key"
|
||||
it "preserves NULL group order and empty-input global aggregates" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE grouped_slots (id INT, tag TEXT)"
|
||||
, "INSERT INTO grouped_slots (id, tag) VALUES (1, 'b'), (2, NULL), (3, 'b')"]
|
||||
grouped <- parseStatement "SELECT tag, COUNT(*) AS n FROM grouped_slots GROUP BY tag"
|
||||
groups <- rowsOf (runStatement db grouped)
|
||||
empty <- parseStatement "SELECT COUNT(*) AS n, SUM(id) AS total FROM grouped_slots WHERE id < 0"
|
||||
aggregates <- rowsOf (runStatement db empty)
|
||||
Right (map (map snd) groups, map (map snd) aggregates)
|
||||
result `shouldBe` Right ([[SQL.VStr "b", SQL.VInt 2], [SQL.VNull, SQL.VInt 1]]
|
||||
, [[SQL.VInt 0, SQL.VNull]])
|
||||
it "binds SQL relation expressions to the optimized input slots" $ do
|
||||
let plan = Rel.Compute [("value", Col "second")]
|
||||
(Rel.Compute [("first", LitInt 1), ("second", LitInt 2)] Rel.Unit)
|
||||
bindRelOpColumns [] [] plan `shouldBe` Right (Rel.Compute [("value", ColumnSlot 1 "second")]
|
||||
(Rel.Compute [("first", LitInt 1), ("second", LitInt 2)] Rel.Unit))
|
||||
bindRelOpColumns [] [] (Rel.Filter (Col "missing") Rel.Unit)
|
||||
`shouldBe` Left "unknown column: missing"
|
||||
it "checks SQL slot position instead of searching another column" $ do
|
||||
evalExpr (ColumnSlot 1 "name") [("name", SQL.VStr "abc"), ("id", SQL.VInt 1)]
|
||||
`shouldBe` Left "bound column position mismatch: name"
|
||||
evalExpr (ColumnSlot (-1) "name") [("name", SQL.VStr "abc")]
|
||||
`shouldBe` Left "bound column position mismatch: name"
|
||||
it "binds projections without losing repeated outputs or empty rows" $ do
|
||||
let source = Rel.Compute [("first", LitInt 1), ("second", LitInt 2)] Rel.Unit
|
||||
bindRelOpColumns [] [] (Rel.Project ["second", "first", "second"] source)
|
||||
`shouldBe` Right (Rel.Compute [("second", ColumnSlot 1 "second")
|
||||
, ("first", ColumnSlot 0 "first"), ("second", ColumnSlot 1 "second")] source)
|
||||
bindRelOpColumns [] [] (Rel.Project [] source)
|
||||
`shouldBe` Right (Rel.Compute [] source)
|
||||
bindRelOpColumns [] [] (Rel.Project ["*"] source)
|
||||
`shouldBe` Right (Rel.Compute [("first", ColumnSlot 0 "first"), ("second", ColumnSlot 1 "second")] source)
|
||||
it "preserves repeated SQL outputs and correlated projection values" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE slot_items (id INT)"
|
||||
, "INSERT INTO slot_items (id) VALUES (1), (2)"]
|
||||
repeated <- parseStatement "SELECT id, id FROM slot_items"
|
||||
repeatedRows <- rowsOf (runStatement db repeated)
|
||||
correlated <- parseStatement "SELECT o.id, (SELECT o.id FROM slot_items i WHERE i.id = o.id) AS echoed FROM slot_items o"
|
||||
correlatedRows <- rowsOf (runStatement db correlated)
|
||||
Right (map (map snd) repeatedRows, map (map snd) correlatedRows)
|
||||
result `shouldBe` Right ([[SQL.VInt 1, SQL.VInt 1], [SQL.VInt 2, SQL.VInt 2]]
|
||||
, [[SQL.VInt 1, SQL.VInt 1], [SQL.VInt 2, SQL.VInt 2]])
|
||||
it "binds outer references after the local relation layout" $ do
|
||||
bindRelOpColumns [] ["outer.id"] (Rel.Compute [("id", Col "outer.id")] Rel.Unit)
|
||||
`shouldBe` Right (Rel.Compute [("id", OuterColumnSlot 0 0 "outer.id")] Rel.Unit)
|
||||
it "binds subquery references to parent slots before execution" $ do
|
||||
let statement = Select [("value", Col "parent.id")] FromUnit Nothing [] Nothing [] Nothing
|
||||
query = Subquery statement ["parent.id"]
|
||||
source = Rel.Compute [("id", LitInt 1)] Rel.Unit
|
||||
plan = Rel.Compute [("value", ScalarSub query)] source
|
||||
bindRelOpColumns [] [] plan `shouldBe` Right (Rel.Compute
|
||||
[("value", ScalarSub (BoundSubquery statement ["parent.id"] [("parent.id", ColumnSlot 0 "id")]))] source)
|
||||
case bindRelOpColumns [] [] plan of
|
||||
Left err -> expectationFailure err
|
||||
Right bound -> evalRelOp [] bound `shouldBe` Right [[("value", SQL.VInt 1)]]
|
||||
it "keeps exact outer subquery references ahead of local physical fallbacks" $ do
|
||||
let statement = Select [("value", Col "parent.id")] FromUnit Nothing [] Nothing [] Nothing
|
||||
query = Subquery statement ["parent.id"]
|
||||
source = Rel.Compute [("id", LitInt 1)] Rel.Unit
|
||||
bindRelOpColumns [] ["parent.id"] (Rel.Compute [("value", ScalarSub query)] source)
|
||||
`shouldBe` Right (Rel.Compute [("value", ScalarSub (BoundSubquery statement ["parent.id"]
|
||||
[("parent.id", OuterColumnSlot 1 0 "parent.id")]))] source)
|
||||
it "uses distinct bound positions when subqueries share a diagnostic name" $ do
|
||||
let statement = Select [("value", Col "x")] FromUnit Nothing [] Nothing [] Nothing
|
||||
first = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 0 "a")])
|
||||
second = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 1 "b")])
|
||||
table = SQL.Table "slot_cache" [("a", SQL.plainColumn SQL.CInt), ("b", SQL.plainColumn SQL.CInt)]
|
||||
[[("a", SQL.VInt 1), ("b", SQL.VInt 2)], [("a", SQL.VInt 1), ("b", SQL.VInt 3)]] Nothing Nothing Nothing
|
||||
plan = Rel.Compute [("first", first), ("second", second)] (Rel.Scan Nothing "slot_cache" Nothing)
|
||||
subquerySlotsIn (Add first second) `shouldBe` [ColumnSlot 0 "a", ColumnSlot 1 "b"]
|
||||
evalRelOp [("slot_cache", table)] plan `shouldBe` Right
|
||||
[[("first", SQL.VInt 1), ("second", SQL.VInt 2)]
|
||||
, [("first", SQL.VInt 1), ("second", SQL.VInt 3)]]
|
||||
it "rejects bound subquery layout mismatches instead of looking up names" $ do
|
||||
let statement = Select [("value", Col "id")] FromUnit Nothing [] Nothing [] Nothing
|
||||
query = BoundSubquery statement ["id"] [("id", ColumnSlot 0 "id")]
|
||||
wrongLayout = Rel.Compute [("other", LitInt 2), ("id", LitInt 1)] Rel.Unit
|
||||
evalRelOp [] (Rel.Compute [("value", ScalarSub query)] wrongLayout)
|
||||
`shouldBe` Left "bound column position mismatch: id"
|
||||
prepareRowExpression [] (ScalarSub query)
|
||||
`shouldBe` Left "execution subquery cannot be used in semantic input"
|
||||
bindRelOpColumns [] [] (Rel.Compute [("value", ScalarSub
|
||||
(BoundSubquery statement ["id"] []))] Rel.Unit)
|
||||
`shouldBe` Left "bound subquery references mismatch"
|
||||
it "preserves outer scope identity when rebinding beside a local name" $ do
|
||||
let source = Rel.Compute [("id", LitInt 1)] Rel.Unit
|
||||
expression = OuterColumnSlot 0 0 "id"
|
||||
bound = bindRelOpColumns [] ["id"] (Rel.Compute [("outer", expression)] source)
|
||||
bound `shouldBe` Right (Rel.Compute [("outer", OuterColumnSlot 1 0 "id")] source)
|
||||
evalExpr (OuterColumnSlot 1 0 "id") [("id", SQL.VInt 1), ("id", SQL.VInt 9)]
|
||||
`shouldBe` Right (SQL.VInt 9)
|
||||
bindRelOpColumns [] [] (Rel.Compute [("outer", expression)] source)
|
||||
`shouldBe` Left "unknown column: id"
|
||||
prepareRowExpression [] expression `shouldBe` Left "execution column cannot be used in semantic input"
|
||||
prepareRowExpression [] (ColumnSlot 0 "id") `shouldBe` Left "execution column cannot be used in semantic input"
|
||||
it "preserves duplicate column positions when rebinding local and outer slots" $ do
|
||||
let source = Rel.Compute [("id", LitInt 1), ("id", LitInt 9)] Rel.Unit
|
||||
plan = Rel.Compute [("value", ColumnSlot 1 "id")] source
|
||||
bindRelOpColumns [] [] plan `shouldBe` Right plan
|
||||
(bindRelOpColumns [] [] plan >>= evalRelOp [])
|
||||
`shouldBe` Right [[("value", SQL.VInt 9)]]
|
||||
bindRelOpColumns [] ["id", "id"] (Rel.Compute [("value", OuterColumnSlot 0 1 "id")] source)
|
||||
`shouldBe` Right (Rel.Compute [("value", OuterColumnSlot 2 1 "id")] source)
|
||||
it "rejects ambiguous slot relocation and invalid bound positions" $ do
|
||||
let source = Rel.Compute [("other", LitInt 0), ("id", LitInt 1), ("id", LitInt 9)] Rel.Unit
|
||||
bindRelOpColumns [] [] (Rel.Compute [("value", ColumnSlot 0 "id")] source)
|
||||
`shouldBe` Left "ambiguous bound column: id"
|
||||
bindRelOpColumns [] ["other", "id", "id"] (Rel.Compute [("value", OuterColumnSlot 0 0 "id")] Rel.Unit)
|
||||
`shouldBe` Left "ambiguous bound column: id"
|
||||
bindRelOpColumns [] [] (Rel.Compute [("value", ColumnSlot (-1) "id")] source)
|
||||
`shouldBe` Left "bound column position mismatch: id"
|
||||
bindRelOpColumns [] ["id"] (Rel.Compute [("value", OuterColumnSlot (-1) 0 "id")] Rel.Unit)
|
||||
`shouldBe` Left "bound column position mismatch: id"
|
||||
bindRelOpColumns [] [] (Rel.Compute [("value", ColumnSlot 0 "id")]
|
||||
(Rel.Compute [("other", LitInt 0), ("id", LitInt 9)] Rel.Unit))
|
||||
`shouldBe` Right (Rel.Compute [("value", ColumnSlot 1 "id")]
|
||||
(Rel.Compute [("other", LitInt 0), ("id", LitInt 9)] Rel.Unit))
|
||||
it "keeps duplicate parent slots distinct through subquery rebinding and caching" $ do
|
||||
let statement = Select [("value", Col "x")] FromUnit Nothing [] Nothing [] Nothing
|
||||
first = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 0 "id")])
|
||||
second = ScalarSub (BoundSubquery statement ["x"] [("x", ColumnSlot 1 "id")])
|
||||
source = Rel.Compute [("id", LitInt 1), ("id", LitInt 9)] Rel.Unit
|
||||
plan = Rel.Compute [("first", first), ("second", second)] source
|
||||
bindRelOpColumns [] [] plan `shouldBe` Right plan
|
||||
(bindRelOpColumns [] [] plan >>= evalRelOp [])
|
||||
`shouldBe` Right [[("first", SQL.VInt 1), ("second", SQL.VInt 9)]]
|
||||
it "keeps inner shadowing and multi-level correlated SQL references" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE scoped_items (id INT)"
|
||||
, "INSERT INTO scoped_items (id) VALUES (1), (2)"]
|
||||
statement <- parseStatement "SELECT o.id, (SELECT id FROM scoped_items i WHERE i.id = o.id) AS inner_id, (SELECT (SELECT o.id FROM scoped_items j WHERE j.id = i.id) FROM scoped_items i WHERE i.id = o.id) AS nested_id FROM scoped_items o"
|
||||
rows <- rowsOf (runStatement db statement)
|
||||
Right (map (map snd) rows)
|
||||
result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 1, SQL.VInt 1], [SQL.VInt 2, SQL.VInt 2, SQL.VInt 2]]
|
||||
it "resolves the nearest of several enclosing column scopes" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (id INT)"
|
||||
, "INSERT INTO scope_far (id) VALUES (1), (2)", "INSERT INTO scope_near (id) VALUES (10), (11)"]
|
||||
statement <- parseStatement "SELECT o.id, (SELECT (SELECT id) FROM scope_near n WHERE n.id = o.id + 9) AS nearest FROM scope_far o"
|
||||
map (map snd) <$> rowsOf (runStatement db statement)
|
||||
result `shouldBe` Right [[SQL.VInt 1, SQL.VInt 10], [SQL.VInt 2, SQL.VInt 11]]
|
||||
it "keeps enclosing scopes separate when aliases and DOMAIN types overlap" $ withType stringType $ \tid -> do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN scope_label AS VARCHAR(4)"
|
||||
, "CREATE TABLE scope_far (value INT)", "CREATE TABLE scope_near (value scope_label)"
|
||||
, "INSERT INTO scope_far (value) VALUES (7)", "INSERT INTO scope_near (value) VALUES ('abc')"]
|
||||
statement <- parseStatement "SELECT (SELECT (SELECT length(s.value)) FROM scope_near s) AS size FROM scope_far s"
|
||||
rows <- map (map snd) <$> rowsOf (runStatement db statement)
|
||||
domain <- parseStatement "SELECT (SELECT (SELECT s.value) FROM scope_near s) AS label FROM scope_far s"
|
||||
bound <- Query.bindQuery db domain
|
||||
Right (rows, Query.queryTypes bound)
|
||||
result `shouldBe` Right ([[SQL.VInt 3]], [("label", Query.DomainType "scope_label" (Query.RuntimeType tid))])
|
||||
it "skips empty or unrelated enclosing scopes and preserves NULL" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (name TEXT)"
|
||||
, "INSERT INTO scope_far (id) VALUES (NULL), (4)", "INSERT INTO scope_near (name) VALUES ('n')"]
|
||||
statement <- parseStatement "SELECT (SELECT (SELECT (SELECT id)) FROM scope_near n) AS echoed FROM scope_far o"
|
||||
map (map snd) <$> rowsOf (runStatement db statement)
|
||||
result `shouldBe` Right [[SQL.VNull], [SQL.VInt 4]]
|
||||
it "does not resolve an ambiguous nearer scope against a farther one" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (id INT)"]
|
||||
statement <- parseStatement "SELECT (SELECT (SELECT id) FROM scope_near a JOIN scope_near b ON a.id = b.id) FROM scope_far o"
|
||||
rowsOf (runStatement db statement)
|
||||
result `shouldSatisfy` either (isInfixOf "ambiguous column") (const False)
|
||||
it "does not take a missing column from a shadowed source alias" $ do
|
||||
let result source = do
|
||||
db <- sqlCatalog ["CREATE TABLE source_far (id INT)", "CREATE TABLE source_near (other INT)"
|
||||
, "INSERT INTO source_far (id) VALUES (1)", "INSERT INTO source_near (other) VALUES (10)"]
|
||||
statement <- parseStatement source
|
||||
rowsOf (runStatement db statement)
|
||||
mapM_ (\source -> result source `shouldSatisfy` either (isInfixOf "unknown column") (const False))
|
||||
["SELECT (SELECT s.id FROM source_near s) FROM source_far s"
|
||||
, "SELECT (SELECT (SELECT s.id) FROM source_near s) FROM source_far s"]
|
||||
it "keeps bare far columns visible when the nearer alias has no such column" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE source_far (id INT)", "CREATE TABLE source_near (other INT)"
|
||||
, "INSERT INTO source_far (id) VALUES (1), (2)", "INSERT INTO source_near (other) VALUES (10)"]
|
||||
statement <- parseStatement "SELECT (SELECT (SELECT id) FROM source_near s) AS inherited FROM source_far s"
|
||||
map (map snd) <$> rowsOf (runStatement db statement)
|
||||
result `shouldBe` Right [[SQL.VInt 1], [SQL.VInt 2]]
|
||||
it "uses lexical scopes in IN, EXISTS and quantified subqueries" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE scope_far (id INT)", "CREATE TABLE scope_near (id INT)"
|
||||
, "INSERT INTO scope_far (id) VALUES (1)", "INSERT INTO scope_near (id) VALUES (10)"]
|
||||
statement <- parseStatement "SELECT (SELECT 10 IN (SELECT id) AND EXISTS (SELECT 1 WHERE id = 10) AND 10 = ALL (SELECT id) FROM scope_near n) AS matched FROM scope_far o"
|
||||
map (map snd) <$> rowsOf (runStatement db statement)
|
||||
result `shouldBe` Right [[SQL.VBool True]]
|
||||
it "resolves JOIN conditions against the nearest enclosing scope" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE scope_far (value INT)", "CREATE TABLE scope_near (value INT)"
|
||||
, "CREATE TABLE scope_join (id INT)", "INSERT INTO scope_far (value) VALUES (1)"
|
||||
, "INSERT INTO scope_near (value) VALUES (10)", "INSERT INTO scope_join (id) VALUES (10)"]
|
||||
statement <- parseStatement "SELECT (SELECT (SELECT a.id FROM scope_join a JOIN scope_join b ON a.id = value AND b.id = a.id) FROM scope_near n) AS matched FROM scope_far o"
|
||||
map (map snd) <$> rowsOf (runStatement db statement)
|
||||
result `shouldBe` Right [[SQL.VInt 10]]
|
||||
it "executes SQL against reversed physical column order" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE TABLE slot_items (id INT, name TEXT)"
|
||||
, "INSERT INTO slot_items (id, name) VALUES (1, 'abc'), (2, 'xy')"]
|
||||
let reordered = [(name, table {SQL.tableRows = map reverse (SQL.tableRows table)}) | (name, table) <- db]
|
||||
statement <- parseStatement "SELECT length(name) AS size, id + 1 AS next FROM slot_items WHERE id > 0 ORDER BY size"
|
||||
rowsOf (runStatement reordered statement)
|
||||
fmap (map (map snd)) result `shouldBe` Right [[SQL.VInt 2, SQL.VInt 3], [SQL.VInt 3, SQL.VInt 2]]
|
||||
it "binds the SQL entry point to output TypeIds" $ withType intType $ \tid -> do
|
||||
let result = parseStatement "SELECT length('abc') AS size" >>= Query.bindQuery []
|
||||
fmap Query.queryTypes result `shouldBe` Right [("size", Query.RuntimeType tid)]
|
||||
it "retains compatibility for existing temporal SQL types" $ do
|
||||
let result = parseStatement "SELECT DATE '2026-10-05' AS today" >>= Query.bindQuery []
|
||||
fmap Query.queryTypes result `shouldBe` Right [("today", Query.CompatibilityType SQL.CDate)]
|
||||
it "retains nested DOMAIN identities through derived aliases and DISTINCT" $ withType intType $ \tid -> do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN quantity AS INT", "CREATE DOMAIN stock AS quantity"
|
||||
, "CREATE TABLE inventory (qty stock)", "INSERT INTO inventory (qty) VALUES (2), (NULL)"]
|
||||
statement <- parseStatement "SELECT DISTINCT d.qty AS available FROM (SELECT qty FROM inventory) d"
|
||||
bound <- Query.bindQuery db statement
|
||||
rows <- rowsOf (runStatement db statement)
|
||||
Right (Query.queryTypes bound, map (map snd) rows)
|
||||
result `shouldBe` Right ([("available", Query.DomainType "stock"
|
||||
(Query.DomainType "quantity" (Query.RuntimeType tid)))], [[SQL.VInt 2], [SQL.VNull]])
|
||||
it "preserves temporal and binary DOMAIN wrappers" $ do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN day AS DATE", "CREATE DOMAIN payload AS BLOB"
|
||||
, "CREATE TABLE documents (created day, contents payload)"]
|
||||
statement <- parseStatement "SELECT created, contents FROM documents"
|
||||
Query.queryTypes <$> Query.bindQuery db statement
|
||||
result `shouldBe` Right [("created", Query.DomainType "day" (Query.CompatibilityType SQL.CDate))
|
||||
, ("contents", Query.DomainType "payload" (Query.CompatibilityType SQL.CBlob))]
|
||||
it "uses base function semantics without labeling function results as DOMAIN" $ withType intType $ \tid -> do
|
||||
let result = do
|
||||
db <- sqlCatalog ["CREATE DOMAIN label AS VARCHAR(3)", "CREATE TABLE names (name label)"
|
||||
, "INSERT INTO names (name) VALUES ('abc')"]
|
||||
statement <- parseStatement "SELECT length(name) AS size FROM names"
|
||||
bound <- Query.bindQuery db statement
|
||||
rows <- rowsOf (runStatement db statement)
|
||||
Right (Query.queryTypes bound, map (map snd) rows)
|
||||
result `shouldBe` Right ([("size", Query.RuntimeType tid)], [[SQL.VInt 3]])
|
||||
it "rejects composite ordering without an Ord implementation" $
|
||||
sql "SELECT LIST<Int>(1) AS xs ORDER BY xs" `shouldSatisfy` isFailure
|
||||
it "rejects composite extrema without an Ord implementation" $
|
||||
sql "SELECT MIN(LIST<Int>(1))" `shouldSatisfy` isFailure
|
||||
it "rejects unique runtime columns without a key implementation" $
|
||||
(parseStatement "CREATE TABLE keyed (xs [Int] UNIQUE)" >>= runStatement []) `shouldSatisfy` isFailure
|
||||
it "rejects primary runtime keys without a key implementation" $
|
||||
(parseStatement "CREATE TABLE keyed (xs [Int] PRIMARY KEY)" >>= runStatement []) `shouldSatisfy` isFailure
|
||||
it "constructs nested compound values in SQL" $ withType (listType (maybeType intType)) $ \tid ->
|
||||
sql "SELECT LIST<Maybe Int>(MAYBE<Int>(), MAYBE<Int>(42))"
|
||||
`shouldBe` Right [[SQL.VRuntime tid (RList [RMaybe Nothing, RMaybe (Just (RInt 42))])]]
|
||||
it "constructs heterogeneous tuples with stable type identity" $ withType (tupleType [intType, stringType]) $ \tid ->
|
||||
sql "SELECT TUPLE<Int, String>(1, 'a')" `shouldBe` Right [[SQL.VRuntime tid (RTuple [RInt 1, RString "a"])]]
|
||||
it "rejects constructor argument type mismatch" $
|
||||
sql "SELECT LIST<Int>('bad')" `shouldSatisfy` isFailure
|
||||
it "rejects constructor arity mismatch" $
|
||||
sql "SELECT MAYBE<Int>(1, 2)" `shouldSatisfy` isFailure
|
||||
it "rejects SQL NULL inside a typed compound value" $
|
||||
sql "SELECT LIST<Int>(NULL)" `shouldSatisfy` isFailure
|
||||
it "round trips typed runtime values through the shared wire protocol" $
|
||||
withType (maybeType (listType intType)) $ \tid -> do
|
||||
let value = SQL.VRuntime tid (RMaybe (Just (RList [RInt 1, RInt 2])))
|
||||
parseEither valueFromJSON (valueToJSON value) `shouldBe` Right value
|
||||
it "round trips typed schema identities through catalog type names" $
|
||||
withType (tupleType [intType, listType stringType]) $ \tid ->
|
||||
SQL.parseColumnType (SQL.typeName (SQL.CRuntime tid)) `shouldBe` Just (SQL.CRuntime tid)
|
||||
it "keeps hashing consistent for signed floating zero" $ withType (listType doubleType) $ \tid -> do
|
||||
let positive = SQL.VRuntime tid (RList [RDouble 0])
|
||||
negative = SQL.VRuntime tid (RList [RDouble (-0)])
|
||||
positive `shouldBe` negative
|
||||
hash positive `shouldBe` hash negative
|
||||
it "creates and writes compound columns through SQL" $ do
|
||||
let result = do
|
||||
create <- parseStatement "CREATE TABLE composite (xs [Int], opt Maybe String, pair (Int, String))"
|
||||
(db, _) <- runStatement [] create
|
||||
insert <- parseStatement "INSERT INTO composite (xs, opt, pair) VALUES (LIST<Int>(1, 2), MAYBE<String>(), TUPLE<Int, String>(3, 'x'))"
|
||||
(updated, _) <- runStatement db insert
|
||||
select <- parseStatement "SELECT xs, opt, pair FROM composite"
|
||||
rowsOf (runStatement updated select)
|
||||
result `shouldSatisfy` either (const False) ((== 1) . length)
|
||||
it "stores logical String with the generic runtime encoding" $ do
|
||||
let result = do
|
||||
create <- parseStatement "CREATE TABLE strings (text String)"
|
||||
(db, _) <- runStatement [] create
|
||||
insert <- parseStatement "INSERT INTO strings (text) VALUES ('abc')"
|
||||
(updated, _) <- runStatement db insert
|
||||
select <- parseStatement "SELECT length(text) FROM strings"
|
||||
map (map snd) <$> rowsOf (runStatement updated select)
|
||||
result `shouldBe` Right [[SQL.VInt 3]]
|
||||
it "runs length and not through resolved identities" $
|
||||
sql "SELECT length('你好'), not(TRUE)" `shouldBe` Right [[SQL.VInt 2, SQL.VBool False]]
|
||||
it "preserves nullable SQL function semantics" $
|
||||
sql "SELECT length(NULL), not(NULL)" `shouldBe` Right [[SQL.VNull, SQL.VNull]]
|
||||
it "binds calls before execution" $ do
|
||||
let bound = parseStatement "SELECT length('abc')" >>= prepare []
|
||||
case bound of
|
||||
Right Select {selectItems = [(_, BoundFunction (FunctionId 1) _ [_])]} -> pure ()
|
||||
_ -> expectationFailure (show bound)
|
||||
it "rejects unknown SQL functions before scanning" $
|
||||
sql "SELECT missing('abc')" `shouldSatisfy` isFailure
|
||||
it "rejects wrong argument count" $
|
||||
sql "SELECT length('a', 'b')" `shouldSatisfy` isFailure
|
||||
it "rejects wrong SQL argument type" $
|
||||
sql "SELECT length(1)" `shouldSatisfy` isFailure
|
||||
it "finds references inside calls for projection pushdown" $
|
||||
sql "SELECT length(name) FROM t WHERE not(enabled)" `shouldBe` Right [[SQL.VInt 3]]
|
||||
it "rewrites aggregates nested in calls" $
|
||||
sql "SELECT length(MIN(name)) FROM t" `shouldBe` Right [[SQL.VInt 2]]
|
||||
it "executes subqueries nested in function arguments" $
|
||||
sql "SELECT length((SELECT MIN(name) FROM t))" `shouldBe` Right [[SQL.VInt 2]]
|
||||
it "expands CTEs inside function arguments" $
|
||||
sql "WITH names AS (SELECT name FROM t) SELECT length((SELECT MIN(name) FROM names))"
|
||||
`shouldBe` Right [[SQL.VInt 2]]
|
||||
it "binds CHECK functions using the row schema" $ do
|
||||
let result = do
|
||||
statement <- parseStatement "CREATE TABLE checked (name TEXT CHECK (length(name) > 1))"
|
||||
(db, _) <- runStatement [] statement
|
||||
insert <- parseStatement "INSERT INTO checked (name) VALUES ('abc')"
|
||||
runStatement db insert
|
||||
result `shouldSatisfy` either (const False) (const True)
|
||||
|
||||
-- | 通过正式入口执行测试 SQL
|
||||
sql :: String -> Either String [[SQL.Value]]
|
||||
sql source = do
|
||||
statement <- parseStatement source
|
||||
rows <- rowsOf (runStatement database statement)
|
||||
Right (map (map snd) rows)
|
||||
where
|
||||
-- | 提供函数调用测试表
|
||||
database = [("t", SQL.Table "t" [("name", SQL.plainColumn SQL.CStr), ("enabled", SQL.plainColumn SQL.CBool)]
|
||||
[[("name", SQL.VStr "ab"), ("enabled", SQL.VBool True)]
|
||||
,[("name", SQL.VStr "xyz"), ("enabled", SQL.VBool False)]] Nothing Nothing Nothing)]
|
||||
|
||||
-- | 判断结果是否明确失败
|
||||
isFailure :: Either a b -> Bool
|
||||
isFailure (Left _) = True
|
||||
isFailure _ = False
|
||||
|
||||
-- | 准备已解析类型身份
|
||||
withType :: TypeExpr -> (TypeId -> Expectation) -> Expectation
|
||||
withType ty action = case resolveType builtinTypes ty of
|
||||
Left err -> expectationFailure err
|
||||
Right descriptor -> action (descriptorId descriptor)
|
||||
|
||||
-- | 准备内建函数注册表
|
||||
withFunctions :: (FunctionRegistry -> Expectation) -> Expectation
|
||||
withFunctions action = case builtinFunctions builtinTypes of
|
||||
Left err -> expectationFailure err
|
||||
Right functions -> action functions
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,25 @@
|
||||
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
|
||||
@@ -0,0 +1,669 @@
|
||||
{-# 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)
|
||||
@@ -0,0 +1,509 @@
|
||||
{-# 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
|
||||
]
|
||||
@@ -0,0 +1,294 @@
|
||||
module ChuSQL.Core.Runtime
|
||||
( TypeConstructorId (..), TypeId, TypeExpr (..), Kind (..)
|
||||
, TypeRegistry, TypeDescriptor (..), PhysicalType (..), RuntimeValue (..)
|
||||
, builtinTypes, resolveType, describeType, typeExpression
|
||||
, intType, doubleType, boolType, stringType, listType, maybeType, tupleType, renderTypeExpr, parseTypeExpr, renderRuntimeValue
|
||||
, validateValue, encodeValue, decodeValue, encodeType, decodeType, runtimeToJSON, runtimeFromJSON
|
||||
) where
|
||||
|
||||
import Control.Monad (zipWithM, zipWithM_)
|
||||
import Data.Aeson (Value (..), eitherDecode, encode)
|
||||
import Data.Aeson.Types (Parser, parseEither)
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Data.Char (isAlphaNum, toLower)
|
||||
import qualified Text.ParserCombinators.ReadP as P
|
||||
|
||||
-- 运行时类型身份、构造器注册及版本化物理编码。
|
||||
|
||||
-- | 标识稳定的类型构造器
|
||||
newtype TypeConstructorId = TypeConstructorId Int deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 表达逻辑类型应用
|
||||
data TypeExpr = TypeApply TypeConstructorId [TypeExpr] deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 标识完整的类型实例
|
||||
newtype TypeId = TypeId TypeExpr deriving (Show, Eq, Ord)
|
||||
|
||||
-- | 描述构造器参数个数
|
||||
data Kind = TypeKind | TypeArrow Kind Kind | ProductKind deriving (Show, Eq)
|
||||
|
||||
-- | 描述独立的物理表示
|
||||
data PhysicalType = SignedInteger | FloatingPoint | Boolean | Utf8 | Sequence PhysicalType
|
||||
| Optional PhysicalType | Product [PhysicalType] deriving (Show, Eq)
|
||||
|
||||
-- | 保存类型实例描述
|
||||
data TypeDescriptor = TypeDescriptor
|
||||
{ descriptorId :: TypeId, descriptorName :: String, descriptorPhysical :: PhysicalType
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | 保存构造器元数据
|
||||
newtype TypeRegistry = TypeRegistry [(TypeConstructorId, String, Kind)] deriving (Show, Eq)
|
||||
|
||||
-- | 表达运行时值
|
||||
data RuntimeValue = RInt Int | RDouble Double | RBool Bool | RString String
|
||||
| RList [RuntimeValue] | RMaybe (Maybe RuntimeValue) | RTuple [RuntimeValue]
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | 恢复固定编号的内建构造器
|
||||
builtinTypes :: TypeRegistry
|
||||
builtinTypes = TypeRegistry
|
||||
[(TypeConstructorId 1, "Int", TypeKind), (TypeConstructorId 2, "Double", TypeKind)
|
||||
,(TypeConstructorId 3, "Bool", TypeKind), (TypeConstructorId 4, "String", TypeKind)
|
||||
,(TypeConstructorId 5, "List", TypeArrow TypeKind TypeKind)
|
||||
,(TypeConstructorId 6, "Maybe", TypeArrow TypeKind TypeKind)
|
||||
,(TypeConstructorId 7, "Tuple", ProductKind)]
|
||||
|
||||
-- | 构造整数类型表达式
|
||||
intType :: TypeExpr
|
||||
intType = TypeApply (TypeConstructorId 1) []
|
||||
|
||||
-- | 构造浮点类型表达式
|
||||
doubleType :: TypeExpr
|
||||
doubleType = TypeApply (TypeConstructorId 2) []
|
||||
|
||||
-- | 构造布尔类型表达式
|
||||
boolType :: TypeExpr
|
||||
boolType = TypeApply (TypeConstructorId 3) []
|
||||
|
||||
-- | 构造字符串类型表达式
|
||||
stringType :: TypeExpr
|
||||
stringType = TypeApply (TypeConstructorId 4) []
|
||||
|
||||
-- | 构造列表类型表达式
|
||||
listType :: TypeExpr -> TypeExpr
|
||||
listType t = TypeApply (TypeConstructorId 5) [t]
|
||||
|
||||
-- | 构造可选类型表达式
|
||||
maybeType :: TypeExpr -> TypeExpr
|
||||
maybeType t = TypeApply (TypeConstructorId 6) [t]
|
||||
|
||||
-- | 构造元组类型表达式
|
||||
tupleType :: [TypeExpr] -> TypeExpr
|
||||
tupleType = TypeApply (TypeConstructorId 7)
|
||||
|
||||
-- | 渲染内建逻辑类型语法
|
||||
renderTypeExpr :: TypeExpr -> String
|
||||
renderTypeExpr ty@(TypeApply cid arguments) = case (cid, arguments) of
|
||||
(TypeConstructorId 1, []) -> "Int"
|
||||
(TypeConstructorId 2, []) -> "Double"
|
||||
(TypeConstructorId 3, []) -> "Bool"
|
||||
(TypeConstructorId 4, []) -> "String"
|
||||
(TypeConstructorId 5, [child]) -> "[" ++ renderTypeExpr child ++ "]"
|
||||
(TypeConstructorId 6, [child]) -> "Maybe " ++ renderTypeExpr child
|
||||
(TypeConstructorId 7, fields) -> "(" ++ joinTypes fields ++ ")"
|
||||
_ -> show ty
|
||||
where
|
||||
-- | 连接元组字段类型
|
||||
joinTypes [] = ""
|
||||
joinTypes [field] = renderTypeExpr field
|
||||
joinTypes (field : fields) = renderTypeExpr field ++ ", " ++ joinTypes fields
|
||||
|
||||
-- | 解析完整的内建逻辑类型文本
|
||||
parseTypeExpr :: String -> Either String TypeExpr
|
||||
parseTypeExpr source = case P.readP_to_S (P.skipSpaces *> expression <* P.skipSpaces <* P.eof) source of
|
||||
[(ty, "")] -> Right ty
|
||||
_ -> Left "invalid runtime type expression"
|
||||
where
|
||||
-- | 解析类型原子和构造器应用
|
||||
expression = (intType <$ token "int") P.<++ (doubleType <$ token "double")
|
||||
P.<++ (boolType <$ token "bool") P.<++ (stringType <$ token "string")
|
||||
P.<++ (listType <$> between "[" "]" expression)
|
||||
P.<++ (listType <$> (token "list" *> expression))
|
||||
P.<++ (maybeType <$> (token "maybe" *> expression))
|
||||
P.<++ (tupleType <$> between "(" ")" (P.sepBy expression (symbol ",")))
|
||||
-- | 解析具有名称边界的类型关键字
|
||||
token word = do
|
||||
mapM_ character word
|
||||
rest <- P.look
|
||||
case rest of
|
||||
c : _ | isAlphaNum c || c == '_' -> P.pfail
|
||||
_ -> P.skipSpaces
|
||||
-- | 不区分大小写匹配关键字字符
|
||||
character c = P.satisfy ((== c) . toLower)
|
||||
-- | 解析类型分隔符
|
||||
symbol text = P.string text <* P.skipSpaces
|
||||
-- | 解析括号包围的类型
|
||||
between open close = P.between (symbol open) (symbol close)
|
||||
|
||||
-- | 渲染运行时值的可读文本
|
||||
renderRuntimeValue :: RuntimeValue -> String
|
||||
renderRuntimeValue (RInt n) = show n
|
||||
renderRuntimeValue (RDouble n) = show n
|
||||
renderRuntimeValue (RBool b) = show b
|
||||
renderRuntimeValue (RString text) = show text
|
||||
renderRuntimeValue (RList values) = "[" ++ joinValues values ++ "]"
|
||||
renderRuntimeValue (RMaybe Nothing) = "Nothing"
|
||||
renderRuntimeValue (RMaybe (Just value)) = "Just (" ++ renderRuntimeValue value ++ ")"
|
||||
renderRuntimeValue (RTuple values) = "(" ++ joinValues values ++ ")"
|
||||
|
||||
-- | 连接复合值的字段文本
|
||||
joinValues :: [RuntimeValue] -> String
|
||||
joinValues [] = ""
|
||||
joinValues [value] = renderRuntimeValue value
|
||||
joinValues (value : values) = renderRuntimeValue value ++ ", " ++ joinValues values
|
||||
|
||||
-- | 提取身份中的逻辑类型
|
||||
typeExpression :: TypeId -> TypeExpr
|
||||
typeExpression (TypeId t) = t
|
||||
|
||||
-- | 解析类型实例并校验 kind
|
||||
resolveType :: TypeRegistry -> TypeExpr -> Either String TypeDescriptor
|
||||
resolveType registry@(TypeRegistry constructors) expression@(TypeApply cid args) = do
|
||||
(name, kind) <- case [(n, k) | (c, n, k) <- constructors, c == cid] of
|
||||
[entry] -> Right entry
|
||||
_ -> Left ("unknown type constructor: " ++ show cid)
|
||||
children <- mapM (resolveType registry) args
|
||||
physical <- case (cid, kind, map descriptorPhysical children) of
|
||||
(TypeConstructorId 1, TypeKind, []) -> Right SignedInteger
|
||||
(TypeConstructorId 2, TypeKind, []) -> Right FloatingPoint
|
||||
(TypeConstructorId 3, TypeKind, []) -> Right Boolean
|
||||
(TypeConstructorId 4, TypeKind, []) -> Right Utf8
|
||||
(TypeConstructorId 5, TypeArrow TypeKind TypeKind, [child]) -> Right (Sequence child)
|
||||
(TypeConstructorId 6, TypeArrow TypeKind TypeKind, [child]) -> Right (Optional child)
|
||||
(TypeConstructorId 7, ProductKind, fields) -> Right (Product fields)
|
||||
_ -> Left ("invalid type constructor application: " ++ name)
|
||||
Right (TypeDescriptor (TypeId expression) name physical)
|
||||
|
||||
-- | 按身份查询类型描述
|
||||
describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
|
||||
describeType registry = resolveType registry . typeExpression
|
||||
|
||||
-- | 校验逻辑类型对应的值
|
||||
validateValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String ()
|
||||
validateValue registry tid value = do
|
||||
descriptor <- describeType registry tid
|
||||
validatePhysical (descriptorPhysical descriptor) value
|
||||
|
||||
-- | 校验值的物理结构
|
||||
validatePhysical :: PhysicalType -> RuntimeValue -> Either String ()
|
||||
validatePhysical SignedInteger RInt{} = Right ()
|
||||
validatePhysical FloatingPoint (RDouble n)
|
||||
| not (isNaN n || isInfinite n) = Right ()
|
||||
validatePhysical Boolean RBool{} = Right ()
|
||||
validatePhysical Utf8 RString{} = Right ()
|
||||
validatePhysical (Sequence child) (RList values) = mapM_ (validatePhysical child) values
|
||||
validatePhysical (Optional _) (RMaybe Nothing) = Right ()
|
||||
validatePhysical (Optional child) (RMaybe (Just value)) = validatePhysical child value
|
||||
validatePhysical (Product fields) (RTuple values)
|
||||
| length fields == length values = zipWithM_ validatePhysical fields values
|
||||
validatePhysical physical _ = Left ("value does not fit physical type: " ++ show physical)
|
||||
|
||||
-- | 编码带版本与类型身份的值
|
||||
encodeValue :: TypeRegistry -> TypeId -> RuntimeValue -> Either String BS.ByteString
|
||||
encodeValue registry tid value = do
|
||||
validateValue registry tid value
|
||||
Right (encode (runtimeToJSON tid value))
|
||||
|
||||
-- | 表达协议中的类型化值封装
|
||||
runtimeToJSON :: TypeId -> RuntimeValue -> Value
|
||||
runtimeToJSON tid value = array [Number 1, typeJson (typeExpression tid), valueJson value]
|
||||
|
||||
-- | 解析并校验协议类型化值
|
||||
runtimeFromJSON :: TypeRegistry -> Value -> Either String (TypeId, RuntimeValue)
|
||||
runtimeFromJSON registry json = do
|
||||
(expression, payload) <- parseEither parseEnvelope json
|
||||
descriptor <- resolveType registry expression
|
||||
value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
|
||||
validateValue registry (descriptorId descriptor) value
|
||||
Right (descriptorId descriptor, value)
|
||||
|
||||
-- | 解码并校验版本和类型身份
|
||||
decodeValue :: TypeRegistry -> TypeId -> BS.ByteString -> Either String RuntimeValue
|
||||
decodeValue registry expected bytes = do
|
||||
json <- eitherDecode bytes
|
||||
(expression, payload) <- parseEither parseEnvelope json
|
||||
descriptor <- resolveType registry expression
|
||||
if descriptorId descriptor /= expected then Left "encoded value type identity mismatch" else do
|
||||
value <- parseEither (parseValue (descriptorPhysical descriptor)) payload
|
||||
validateValue registry expected value
|
||||
Right value
|
||||
|
||||
-- | 编码版本化类型身份
|
||||
encodeType :: TypeId -> BS.ByteString
|
||||
encodeType tid = encode (array [Number 1, typeJson (typeExpression tid)])
|
||||
|
||||
-- | 解码并解析类型身份
|
||||
decodeType :: TypeRegistry -> BS.ByteString -> Either String TypeId
|
||||
decodeType registry bytes = do
|
||||
json <- eitherDecode bytes
|
||||
expression <- parseEither parseTypeEnvelope json
|
||||
descriptorId <$> resolveType registry expression
|
||||
|
||||
-- | 生成 JSON 数组
|
||||
array :: [Value] -> Value
|
||||
array = Array . V.fromList
|
||||
|
||||
-- | 编码构造器应用
|
||||
typeJson :: TypeExpr -> Value
|
||||
typeJson (TypeApply (TypeConstructorId cid) args) = array [Number (fromIntegral cid), array (map typeJson args)]
|
||||
|
||||
-- | 解析构造器应用
|
||||
parseTypeJson :: Value -> Parser TypeExpr
|
||||
parseTypeJson (Array values) = case V.toList values of
|
||||
[Number n, Array args] -> case floatingOrInteger n :: Either Double Integer of
|
||||
Right cid | cid > 0, cid <= fromIntegral (maxBound :: Int) -> TypeApply (TypeConstructorId (fromInteger cid)) <$> mapM parseTypeJson (V.toList args)
|
||||
_ -> fail "invalid type constructor identity"
|
||||
_ -> fail "invalid type expression"
|
||||
parseTypeJson _ = fail "invalid type expression"
|
||||
|
||||
-- | 解析类型版本封装
|
||||
parseTypeEnvelope :: Value -> Parser TypeExpr
|
||||
parseTypeEnvelope (Array values) = case V.toList values of
|
||||
[Number 1, expression] -> parseTypeJson expression
|
||||
_ -> fail "unsupported type encoding version or invalid envelope"
|
||||
parseTypeEnvelope _ = fail "invalid type envelope"
|
||||
|
||||
-- | 解析值版本封装
|
||||
parseEnvelope :: Value -> Parser (TypeExpr, Value)
|
||||
parseEnvelope (Array values) = case V.toList values of
|
||||
[Number 1, expression, payload] -> do
|
||||
ty <- parseTypeJson expression
|
||||
pure (ty, payload)
|
||||
_ -> fail "unsupported value encoding version or invalid envelope"
|
||||
parseEnvelope _ = fail "invalid value envelope"
|
||||
|
||||
-- | 编码物理值
|
||||
valueJson :: RuntimeValue -> Value
|
||||
valueJson (RInt n) = Number (fromIntegral n)
|
||||
valueJson (RDouble n) = Number (realToFrac n)
|
||||
valueJson (RBool b) = Bool b
|
||||
valueJson (RString s) = String (T.pack s)
|
||||
valueJson (RList values) = array (map valueJson values)
|
||||
valueJson (RMaybe Nothing) = array []
|
||||
valueJson (RMaybe (Just value)) = array [valueJson value]
|
||||
valueJson (RTuple values) = array (map valueJson values)
|
||||
|
||||
-- | 按物理描述解析值
|
||||
parseValue :: PhysicalType -> Value -> Parser RuntimeValue
|
||||
parseValue SignedInteger (Number n) = case floatingOrInteger n :: Either Double Integer of
|
||||
Right i | i >= fromIntegral (minBound :: Int), i <= fromIntegral (maxBound :: Int) -> pure (RInt (fromInteger i))
|
||||
_ -> fail "integer is fractional or out of range"
|
||||
parseValue FloatingPoint (Number n) = pure (RDouble (realToFrac n))
|
||||
parseValue Boolean (Bool b) = pure (RBool b)
|
||||
parseValue Utf8 (String s) = pure (RString (T.unpack s))
|
||||
parseValue (Sequence child) (Array values) = RList <$> mapM (parseValue child) (V.toList values)
|
||||
parseValue (Optional child) (Array values) = case V.toList values of
|
||||
[] -> pure (RMaybe Nothing)
|
||||
[value] -> RMaybe . Just <$> parseValue child value
|
||||
_ -> fail "invalid optional value"
|
||||
parseValue (Product fields) (Array values)
|
||||
| length fields == V.length values = RTuple <$> zipWithM parseValue fields (V.toList values)
|
||||
parseValue _ _ = fail "invalid physical value"
|
||||
@@ -0,0 +1,4 @@
|
||||
resolver: lts-24.59
|
||||
|
||||
packages:
|
||||
- .
|
||||
@@ -0,0 +1,12 @@
|
||||
# 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
|
||||
Generated
+294
@@ -0,0 +1,294 @@
|
||||
# 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"
|
||||
@@ -0,0 +1,16 @@
|
||||
[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"
|
||||
@@ -0,0 +1,41 @@
|
||||
# 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 不加样式
|
||||
@@ -0,0 +1,521 @@
|
||||
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()
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,587 @@
|
||||
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;
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,320 @@
|
||||
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(())
|
||||
}
|
||||
@@ -0,0 +1,183 @@
|
||||
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() }
|
||||
})
|
||||
}
|
||||
@@ -0,0 +1,777 @@
|
||||
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() }
|
||||
}
|
||||
@@ -0,0 +1,12 @@
|
||||
// 存储层库入口：对外暴露下面这些模块，服务与集成测试都从这里引。
|
||||
|
||||
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;
|
||||
Loaded 100 of 212 files, more files were not shown because too many files have changed in this diff.
Show more
Reference in new issue
Block a user