Compare commits

...
13 Commits
Author SHA1 Message Date
ChuNa7a 6996e19694 修bug,完善功能
build / build (push) Blocked by required conditions
tests / build (push) Waiting to run
tests / tests (push) Waiting to run
2026-10-16 23:52:12 +08:00
ChuNa7a 30364b1c4b fix: fall back to ChuRepo for release installation and updates
tests / tests (push) Canceled after 0s
tests / build (push) Canceled after 0s
build / build (push) Canceled after 0s
2026-10-15 23:05:00 +08:00
ChuNa7a 44766755d8 docs: add ChuRepo download and source installation alternatives
tests / tests (push) Canceled after 0s
tests / build (push) Canceled after 0s
build / build (push) Canceled after 0s
2026-10-15 22:58:13 +08:00
ChuNa7a 4b8c9d9e78 推进
tests / tests (push) Canceled after 0s
tests / build (push) Canceled after 0s
build / build (push) Canceled after 0s
2026-10-15 22:21:57 +08:00
LIm1tZz7 a45e33f94b 整理代码 2026-10-13 14:09:36 +08:00
LIm1tZz7 e87c4ee6a8 修复bug 2026-10-11 17:32:12 +08:00
LIm1tZz7 fc9bbc20e4 v26.10.2 修复bug,简化项目 2026-10-09 09:27:44 +08:00
LIm1tZz7 ff3dbddd13 Publish the first stable release for Windows and Linux only
tests / build (push) Canceled after 0s
build / build (push) Canceled after 0s
tests / tests (push) Canceled after 0s
tests / release (push) Canceled after 0s
release / validate (push) Canceled after 0s
release / linux-x86_64 (push) Canceled after 0s
release / windows-x86_64 (push) Canceled after 0s
release / publish release (push) Canceled after 0s
2026-10-05 23:38:39 +08:00
LIm1tZz7 346530d5f1 Isolate XDG configuration during Unix package installation checks 2026-10-05 23:19:32 +08:00
LIm1tZz7 8d2f65ab8d Package only the platform storage shared library 2026-10-05 22:53:11 +08:00
LIm1tZz7 b51183a794 Describe ChuSQL from the beginning in the first stable release notes 2026-10-05 22:40:30 +08:00
LIm1tZz7 0475a61c66 Fix release validation and require passing Linux tests before publication 2026-10-05 22:35:42 +08:00
LIm1tZz7 8ce4239452 v26.10.1 正式版
修复部分问题,优化性能,进一步推进类型系统
2026-10-05 22:22:23 +08:00
166 changed files with 25638 additions and 4102 deletions

No files matched your search

+21
View File
@@ -0,0 +1,21 @@
# AI agent 协作资料
本页帮助 AI agent 选择任务所需资料。按任务读取,不将全部资料作为每次工作的上下文。
## 资料入口
各文件的职责如下:
- 根目录 `AGENTS.md`:开发规则和测试入口。
- `context/progress.txt`:唯一进度、测试计数和验收来源。
- `context/known-issues.txt`:未解决限制;`design-decisions.txt`:现有设计约束。
- `context/main-roadmap.txt`:长期阶段;`side-branch-plan.txt`:近期任务及依赖。
- `skills/chusql-*/`:类型、存储、跨组件边界三个项目专用技能。
## 文档与技能
文档写作使用全局 `technical-documentation` 和 `plain-writing`,具体规则见根目录 `AGENTS.md` 的“文档编写”一节。
通用技能、安装锁文件及技能生成提示词仅保留在本地,不纳入版本控制。
`gate-check/` 为开发者和 CI 共用的门禁工具;`logs/` 为忽略的本地产物。
这些协作资料不参与应用构建、运行或发行打包。
+259
View File
@@ -0,0 +1,259 @@
# ChuSQL 当前设计决策
进度见 progress.txt,限制见 known-issues.txt,用户操作见 docs/。
## 架构与接口
### 文档与后续方向
- 用户文档按主题记录于 docs/commands.md、docs/types.md、docs/architecture.md 和 docs/install.md;只读范式入口已提供。
后续完善绑定后的中间表示(bound IR)与 DOMAIN,扩展物化资源控制、递归查询,并按实测减少行版本发布与在线整理的开销;规划不代表现有能力。
- 范式迁移首版保留来源,拒绝 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 / maintenance / free / last_error;Web 不本地执行 SQL。
### 类型语义的职责
- 兼容值与类型语义集中于 Core.Model,运行时类型与版本化编码集中于 Core.Runtime,函数注册与绑定集中于 Engine.Runtime;旧运算符保留 Engine.Builtin,错误分类集中于 Engine.Error。
- 比较与赋值兼容性分开,整数与整值浮点统一相等和哈希,SQL NULL 比较走三值逻辑;DML 的 CHECK 随写计划一次绑定,结构变更对新 schema 重新绑定。
### 写入求值与约束
- 写表达式和 CHECK 复用查询的列槽位绑定及行布局整理,避免按物理返回顺序取错值;UPDATE 在执行前按 schema 一次绑定目标槽位及列定义,按槽位校验、转换并覆盖单个值。目标不存在或歧义明确失败,不保留缺失类型时直接写入的兜底;保留逐项赋值、全部赋值后的 CHECK 及未命中行不求值。
- INSERT 目标清单拒绝重复列,合法目标在本次执行中一次映射到 VALUES 槽位;行构造保留 schema 顺序及原输入表达式求值顺序,默认值、自增、显式 NULL 和整批校验沿用既有语义。缺少已绑定输入值明确失败,不把它作为省略列处理。
- UPDATE 在全部行求值及 CHECK 成功后、调用存储写入前,复用 INSERT 的 NOT NULL 和 UNIQUE / PRIMARY KEY 检查;唯一性以最终整表结果判断,多个 NULL 不冲突。约束失败不发布部分行修改,事务快照保留并允许修正后继续提交。
- NOT NULL 和 UNIQUE / PRIMARY KEY 检查使用 schema 位置绑定列,缺值或位置不符明确失败,不用 mapMaybe 跳过缺列。
INSERT 的已有行与经引擎重写 schema 的 ALTER 输入行在约束边界按原 schema 整理;保留列级错误顺序、NULL 去重规则和数值规范化比较。
### 写计划与结构守卫
- 写语句及已有表 DDL 使用仅保存 schema 的 BoundWrite,复用查询的依赖验证规则;收集目标、嵌套查询和传递 DOMAIN,新增列或改类型包含新声明 DOMAIN。
先以只读 validate_write 确认写守卫能力,再发送实际写入;存储按库名排序取门,在目标库独占门及其他依赖共享门内复查后执行,不改变单次请求之间的数据隔离语义。
- 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;任何应用、刷盘或检查点错误都保持该状态,完整落盘与截断成功后才解除。
- 普通提交组在分配对象编号及写 WAL 前,使用 HeapTable::encode_row 检查全部载荷行;单写、批写、整表替换、事务及结构重写共用此边界,避免可预见的行大小错误在提交后触发恢复封闭。账号专用 WAL 路径保留原有账号行预校验;不改变页格式与已有恢复顺序。
- 索引键容量共用 DiskBTree::check_key,存储提交预检复用堆表实际键编码;结构替换只检查保留的内置 id 索引,删列重写排除已移除索引。建索引在写 WAL 前扫描目标列校验;堆表插入、建索引和整表替换在修改数据前检查键长,不用截断键或跳过错误降级。
- 新插入 id 的冲突预检复用 row_key,在同库写门内按 WAL 操作顺序维护键计数;未涉及的现存键按需查询 id 索引,不为单次插入全表扫描。
删除键在一条操作内去重且每键只减一,保留旧重复 id 的首行删除规则;整表替换重建预检基线,沿用其兼容重复 id 的行为。预检不改变恢复重放与原有页格式。
- 目录预演覆盖普通写入可能触发的扩列及结构重写的载荷行,列推导与版本递增共用 Catalog::ensure_columns;只在结构操作或输入可能扩列时克隆目录。
按行及操作顺序累计变化,在写 WAL 前拒绝版本耗尽,保留同一行多列只递增一次及未定型 NULL 不扩列的规则;已有列的数据写入不因版本达到上限而被拒绝。
- Request::valid_columns 检查所有写入载荷的顶层字段名及事务内行,存储表名与列名字符集共用 valid_storage_name;保持已有非空 ASCII 字母、数字及下划线规则。
只在请求边界约束新载荷,不递归检查值内部键,不对旧目录、堆行及 WAL 重放加新名称限制,也不静默改名或丢字段。
## 查询来源与排序
- FROM 是来源树,派生表必须带别名且不能引用外层,输出取裸列名,重名报错;未定型 NULL 保留独立查询推导类型,不能声明为存储类型。
- ORDER BY 优先匹配唯一输出别名,再查来源列;只将排序表达式提前计算,非排序投影保持在 LIMIT 后求值。CTE 列清单同步重命名内层排序别名。
- ORDER BY 输出序号保留到计划生成,不转换为诊断名称;普通查询选定对应投影表达式,DISTINCT 按去重结果槽位排序,重复别名不丢失位置。名称排序仍拒绝歧义,序号不作为相关子查询自由列,排序键遵守类型能力、分组及 LIMIT 求值时序。
- 派生表从透明算子与 schema 统计估算行数,缺统计或表达式可能报错时不重排;投影下推保留计算项,避免删除错误。内存存储提供实时行数及封顶去重统计。
### 数值与子查询语义
- DECIMAL(p,s) 使用有限浮点、ties-to-even 舍入和舍入后溢出检查,要求 1 <= p <= 308、0 <= s <= p;Haskell 与 Rust 写入入口统一边界,日志记录规范化值。
- CTE 解析期展开为派生表,只接受 SELECT。相同执行子树在一次查询中物化复用;不同投影或优化后的子树仍分别执行,不支持递归或显式物化语法。
- 比较及 ANY / ALL 使用独立 AST 节点,量词复用三值逻辑,空集 ANY=false、ALL=true。
- 子查询在 Filter / Compute 中按外层绑定分组复用;适用的独立 IN 与简单等值相关 EXISTS 使用半连接或反连接,复杂条件保留原路径。扫描按页分片,至少 1000 行、最多 8 线程,结果保序,safe FFI 释放执行能力。
## 会话、事务与存储
### 会话快照与差分
- 每连接独立会话及工作库;短锁取得库句柄后执行,每库读写门控制可见性,表锁保护页,在用库不强行删除。
- BEGIN 物化当前库快照,事务内走内存执行,COMMIT 提交相对基线差分,ROLLBACK 丢弃快照。
- COMMIT 先跳过数据未修改的表,整数 id 用 IntMap / IntSet 查找差异与冲突;保留原行顺序及重复 id 的首行查找语义,冲突检查和提交操作共享一次差分。
- SQL 数据语句和提交使用共享全局门与共享库门;同库最终校验和发布使用单独的短提交门。自动提交也走事务计划、行锁和版本复查,保持失败不部分发布。权限与 DDL 全局独占,原始管理员存储写入通过版本变化参与冲突检查。
- 有整数 id 时按键提交及检查写写冲突,无整数 id 时整表比对;未修改表不回写,冲突保留事务并返回 serialization_failure。
- COMMIT 在短提交门内预演实际事务操作,并复用引擎的领域 / CHECK / 非空 / 唯一性规则校验合并最终行集,避免不同整数主键绕过业务唯一约束;校验失败不写 WAL,事务保留。内存预演与存储一致,每个去重删除键只删除首个旧重复 id 行。
- 可选 BEGIN [TRANSACTION] ISOLATION LEVEL SERIALIZABLE / START TRANSACTION ISOLATION LEVEL SERIALIZABLE 保留整库快照,在写事务提交时复查读写语句全部表的 schema 和行集,包含子查询与幻行;按表保守拒绝冲突,默认 BEGIN 的不同行差分合并不变。保存点恢复语句列表,也恢复读依赖;只读事务不因数据变化拒绝提交。
- 保存点保存不可变快照引用,同名取最近一层,回退 / 释放丢弃之后的点,结束清空;事务命令由会话层执行。
### 日志与恢复
- WAL 先记录操作及提交标记,再应用、刷数据与 catalog、写检查点、截断;仅重放已提交且超过检查点的记录。
- WAL 帧保留长度、LSN、类型码、表名及 JSON payload,兼容旧记录;恢复按内容、schema 和文件存在性判断幂等。
- 检查点按库 LSN,前缀截断用同目录临时文件原子替换,未提交尾部直接截短;失败保留 WAL 并进入 recovery_required。
- 检查点采用同目录临时文件替换,长度必须为 8 字节;完整 WAL 帧损坏明确报错,尾部不完整帧保留撕裂处理。刷盘或检查点失败后封闭请求,重启重放已提交组。
### 统计与页面整理
- distinct 在封顶前按值引用计数维护,列封顶不清除其他列状态;直方图独立累计与递减,桶重映射导致删除目标为空时扣最近非空桶以保持总量。rebuild_stats 先扫描数值范围,再按固定边界计数,消除重建过程的桶重映射偏差并保持输入顺序无关。
- 表 / 索引 DDL 进 WAL,删表不重取已移除句柄;库建删不进 WAL,删除以墓碑目录收敛。
- 自动页内 compact 保持槽号及索引位置,死空间达到四分之一时触发;显式 compact 经 WAL 按原扫描顺序打包存活行,回收跨页空洞和隐藏列字节,并重建索引位置。
## 身份、权限与引导
### 对象编号
- 对象标识使用数据库编号与库内表编号组合;数据库编号从 system catalog 的对象高水位分配,表编号从本库高水位分配,删除不降低计数器。对象解析只读取 catalog。
- 建表编号在 WAL 组写入前分配,随建表记录提交;目录应用时推进高水位,恢复使用日志编号。只有建表组复制操作列表,普通数据提交沿用借用列表。
### 身份与角色
- 用户是可登录角色,共用名称空间;identities 保存属性、时间、稳定编号及版本,users 只存编号和口令哈希,编号不复用。
- 最高权限按身份属性判断,不按名称、不继承;默认用户 LOGIN、角色 NOLOGIN,两者 NOSUPERUSER / ENABLED。保护最后一个启用的登录管理员。
- 仅旧格式迁移按管理员参数识别初始最高权限;旧账号保留信息,角色补编号,重名拒绝;身份、凭据及删除清理用同一 Accounts WAL。
- server 判定权限,目录封装于 Server.Catalog;角色成员取向上闭包,写入拒绝环。GRANT role TO member 表示 member 继承 role 权限。
### 对象授权与会话失效
- members 保持身份成员目录;对象授权存于受保护 __system_object_acl,使用稳定对象与身份编号,保存所有者、授予者和 grant option。CONNECT / CREATE 限数据库,四项数据权限限表或单库表范围;ALL 按作用域展开。
- PUBLIC 默认只提供业务数据库 CONNECT,可逐库撤销;CREATE 建表登记创建者所有权,数据库所有权不隐含他人表的数据权限。启用角色可继承所有权,不继承 SUPERUSER。
- 授权链从独立管理来源及所有权展开固定点;撤销清理无来源下游,保留独立来源,循环不能自持。禁用保留所有权和管理来源授权,停止权限贡献并清理失效下游。
- 旧名称授权仅迁移一次到现存稳定对象;旧全局 * 固定为当时现存表,缺失对象或身份清理,旧记录无授予者时使用管理来源。
- 权限快照按字符分块存储,比较旧快照后以同一 WAL 组替换;跨页及 Unicode 不受单行上限限制。普通存储入口隐藏并拒绝访问权限快照表。
- 服务端共享公平读写锁排序查询与权限变更;事务提交复查身份、权限和稳定对象。建表前写入创建者声明,启动时依据现存对象恢复所有权或清理未完成声明。
- 口令 / 属性推进 revision,权限变更预先展开受影响身份;TCP 只标记连接失效,下一请求回 unauthorized 后关闭,避免 Windows 阻塞句柄异步中断;登记在 finally 清理。
### 系统目录与引导
- 系统表统一 __system_ 前缀并分层保护,内部目录按白名单访问;旧名按文件先、catalog 后迁移,崩溃后可重复收敛。
- 安装先 bootstrap:建立 system、默认 root(LOGIN / SUPERUSER / ENABLED)、18 个内置名称,再起服务;引导请求不开放 TCP。
- 清单编入引导并与解析器测试比对;system.__system_types 保存名称、基础表示、参数能力、编号。重复引导保留口令并补齐类型,冲突或身份降权失败;类型建表与写入用同组 WAL。
### 本机 sudo 认证
- sudo 认证用独立 allow_sudo_auth 属性和显式 sudo_auth_user 映射;默认关闭,只有 SUPERUSER 能管理,不继承、不隐含权限。目录管理者不得管理启用该属性的身份。
- 选择操作系统保护的随机本机凭据与 TCP 一次性 HMAC 挑战,以复用三平台既有会话协议;Unix 只信任有效 UID 0,Windows 只信任提升 Administrators 令牌。双方校验内核回环地址,不接受客户端自报 OS 用户或 SUDO_USER。
- 本机凭据只存放于系统保护的端口专属目录,原生入口校验提升身份;实例重启重新生成,现存目录拒绝覆盖。此方案要求服务端也提升运行,以保证创建凭据时的操作系统保护边界。
- 挑战绑定账号、连接及实例,60 秒过期并在每次尝试时消费;证明常量时间比对,凭据不经网络发送。成功登录复用身份版本、登录时间及连接失效机制,审计不含凭据或证明。
- sudo 属性由 Accounts WAL 持久化,旧目录缺列触发身份快照重写,旧记录缺属性默认 false,已有的错误类型明确拒绝。
## 范式分析
- 范式检查采用阿姆斯特朗属性闭包与子集枚举,候选键声明转为决定全关系的依赖;完整覆盖声明与领域原子性分别控制可证明结论,不从样本推断。二元 BCNF 建议按违反依赖无损拆分,投影依赖之并用于验证依赖保持。
## 自定义类型
### DOMAIN 定义与变更
- DOMAIN 命名基础类型,列编码 domain(名称,基础类型) 保留引用,值及索引沿用底层语义。领域目录的 base 列保存类型、可空性与默认值,check_名称 列保存具名条件,旧的仅基础类型定义继续可读;未改变值、页或 WAL 编码版本。
- DOMAIN CHECK 在独立 VALUE 槽位绑定,拒绝聚合及子查询,TRUE / UNKNOWN 通过。领域继承全部 CHECK 和非空限制,默认值按列、最近领域、基础领域选取;继承属性只在绑定时合成,不写回列声明。
- ALTER DOMAIN 在库读门内取完整定义及数据快照,引擎校验传递依赖、默认值和已有行;库身份与 WAL 检查点组成精确令牌,在写门内复查后走 ReplaceSchema WAL。
并发提交返回 serialization_failure;复用已有恢复与结构版本,不引入通用结构事务。创建依赖领域的表 / 领域也在发布点验证结构守卫;事务提交复查修改表及传递领域依赖。
- 各库 __system_domain_<名称> 空目录表的 base 列保存定义,复用 catalog / DDL WAL;普通 SQL 隐藏并保护目录。
- 嵌套只引用当前库已有类型,语义层从 schema 递归解析并拒绝循环,存储写锁内逐层校验;删除检查类型间及间接列依赖。
- 类型 DDL 要求管理员,事务内禁止。DOMAIN 已支持默认值、非空与 CHECK 约束;暂不引入自定义函数 / 运算符。
### 运行时类型与表达式
- 运行时类型使用稳定构造器编号与结构化 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 保留三值语义。运行时描述保存 Eq / Ord / Hash 能力,List、Maybe、Tuple 根据参数递归派生,DOMAIN 沿用基础类型。SQL 比较和量词按运算要求能力,GROUP BY / DISTINCT 同时要求 Eq 和 Hash。
- 复合值排序使用类型身份与结构的字典序;哈希按构造器与子值递归计算,统一浮点正负零,不依赖显示文本。类型和值编码仍为版本 1;哈希只用于内存执行,不需重建持久化索引。SQL NULL 与 Maybe Nothing 分开,空容器也保留完整身份。
- 复合值的 Eq / Ord / Hash 不等于索引键能力;运行时索引及 UNIQUE / PRIMARY KEY 继续拒绝,索引连接仅对现有整数或文本键探测,其余走扫描 / 哈希回退。
- SQL 字面量生成返回明确错误,先验证运行时值与有限浮点;复合值在 Web 使用 SQL 修改。
## 配置、构建与发行
### Web 编辑与受限管理
- Web 编辑在首个业务表加载时建立快照,在提交 / 回退时结束;既有大库基准 BEGIN 269.806 ms、COMMIT 376.345 ms,不按每次单元格编辑重建整库快照。
- Web 登录分别建立普通 API / SQL 和编辑连接,页面 / 数据库标识绑定编辑事务,SQL 事务另绑定查询标签;同 Cookie 请求串行执行。
- 编辑集保留在浏览器,提交从固定保存点重放;失败回退整个编辑集,冲突回滚并重新加载,成功回执去重;系统身份修改不进入数据事务。
- system_catalog_manager 只管理普通身份,不继承、不隐含业务访问权限;存储写锁内再次拒绝特权目标及特权属性修改。
### 离线维护与配置
- bootstrap 维护使用独占数据目录锁,在副本中修复并验证后保留原目录备份再发布;repair 不重放 WAL、不补初始化数据,原有数据文件必须字节一致。
- listen_host 是监听配置,static 固定为静态目录,管理员名由 --user 指定;data_dir 存数据,log_files 存日志,相对路径以启动目录解释。
- resources/settings.toml.linux 与 resources/settings.toml.windows 入库并打包,安装时填入平台路径并生成 settings.toml;UI 设置样本不入库、不进包。配置路径以 docs/config.md 为准。
### 安装与门禁
- 预编译包优先,server / 存储必装,Web / CLI 可选;Windows zip、Linux/macOS tar.gz。包内模板也放 resources/,按确切产物名打包并拒绝未知工件。
- 本地解包安装不联网,管理员名同时传 bootstrap 和 server;安装冒烟隔离配置并恢复用户 PATH,卸载可保留数据 / 配置。
- 门禁先刷新 release cdylib,再并行 Rust、串行 Haskell、注释三条车道;Server / Web 先刷新各工程的本地依赖,任一步失败即失败。
- 局部改动只测试受影响模块;较大改动由 agent 执行全量门禁。日志 / 临时文件在 logs/,必要时 -Full;门禁及打包强制 UTF-8 以避免 GBK 编码失败。
### 口令输入与诊断
- CLI 终端隐藏口令,管道兼容 LF / CRLF / 无行尾,保留空格与内部回车,提示写 stderr。
- CLI 禁用逐行自动历史,只记录完整 SQL 与元命令;含 IDENTIFIED / PASSWORD(忽略大小写)的输入整体排除,避免多行口令或执行失败留下片段。解析错误也隐藏此类原文,筛选保守包含字符串和标识符中的同名文本,已有历史不自动删除。
- TCP 与 Web 使用同一解析诊断脱敏路径;Web 回归校验整个 HTTP 错误响应不含口令。内置 SQL 控制台记录结果或诊断,不将 SQL 原文写入日志,外部代理和采集需自行配置。
### 对象及结构版本编码
- BoundQuery 保存来源对象身份及列定义;DOMAIN 依赖从来源列递归展开,执行前复查。库 / 对象编号在 TableInfo 中输出十进制字符串,读取兼容旧数值,零对象编号表示无有效身份。
- 表级 schema_version 由 catalog 持久化,新表从 1 开始,旧目录缺失版本保留 0;结构变化递增,新增结构 WAL 记录保存确定目标版本,恢复不重新分配。
线上使用精确十进制字符串并兼容数值输入,0 或缺失表示未知版本;IPC schema / 快照与内存 Server 保留版本,内存 DDL 同样递增并拒绝耗尽。
- 注释以 AGENTS.md 为准;原因写本文件,限制写 known-issues.txt,进度及计数只以 progress.txt 为准。
### 容器部署
- 同一运行镜像包含数据库、引导、CLI 和 Web,Compose 将数据库与 Web 分为单进程服务;Web 不挂载数据库目录。运行 UID/GID 为 10001,命名卷保存数据、日志及编辑器偏好。
- 每次 server 启动复用既有幂等 bootstrap,口令从文件经 stdin 输入,不使用文件标记判断系统目录状态;失败阻止启动,不自动 repair / reset。已有口令不随 secret 文件修改而重设。
- Rust 与 Haskell 使用固定 digest 的 Bookworm 构建阶段,运行层沿用 Bookworm。BASE_REGISTRY 只替换下载地址,保持 digest 校验;Debian 与 Cargo 镜像源保留签名及锁文件校验。源码构建单任务且限制 GHC 堆,WSL 使用 1 核 / 3 GiB、无额外交换空间的 Buildx 或异机构建导入。
- Compose 通过 CHUSQL_IMAGE 固定验收镜像,服务默认限制 1 核 / 512 MiB、128 个进程或线程且无额外交换空间。不同 UID 的旧数据卷须停机备份后显式调整所有者,不由服务启动脚本自动递归改权限。
## 博客业务接入
- 业务用户与数据库身份分离,角色使用标量 CHECK;账号完整 Argon2id PHC、发布授权、文章权威状态、评论、互动、审计及迁移标记持久化,可重建文章索引独立。正文与资源留在 Git 文件,接入验收见 docs/blog-database.md。
- 标量索引键上限为 min(128, floor((page_size - 11) / (order - 1)) - 12),保留按旧 64 字节预算校验配置的规则,避免现有合法页 / 分支数组合失效。旧索引头可读取,首次写长键更新能力字段;页、槽位、WAL 与键排序编码不变,提交前及堆直接写入共用配置上限。
## 存储并发与页恢复
- 全局公平门排序权限和 DDL;SQL 数据准备共享库门,最终约束校验与 WAL 发布串行,以保留连续已应用提交前缀。行锁等待位于库门外,持有内部行编号及旧、新唯一值锁;固定名称顺序用于跨库门,等待图用于跨请求行锁。环中的新等待者中止,锁等待总上限 5 秒。保存点回滚恢复计划和读依赖,严格持锁到事务结束。
- 行版本保存在独立的 mvcc.json,以 WAL 提交 LSN 为可见序号,使用不复用内部行编号、起止序号、内容版本和逻辑行序。内容版本与位置变化分开,避免其他行的删除或排序造成伪写冲突。发布顺序是逻辑 WAL、数据与索引、版本目录、库检查点;重放后幂等发布版本。版本超前于可恢复 WAL 时拒绝打开,不冒充已完成恢复。
- 选择独立版本文件以保留现有页与键格式,代价是整库扫描和版本文件写放大。SQL 仍使用物化工作行集;默认快照隔离,SERIALIZABLE 写事务按表保守复查读依赖。版本保留到最老活跃快照,结束事务回收内存,后续发布回收磁盘版本。database_snapshot 的单版本缓存继续供普通后端读取,不承担事务存活登记。
- 保留现有页内布局,以 .page-wal 记录 CPW1 全页镜像、写序号与校验和,以版本 1 的 .pages 保存页 LSN。镜像先同步,数据文件再同步,页元数据经临时文件原子替换并同步目录,最后清理镜像;库 WAL 检查点在这些步骤之后推进。
- 同一逻辑提交可多次刷新同一页,镜像按独立写序号恢复,不仅按页 LSN 比较;截断也写入重置标记。缓存淘汰先记录并写回当前脏页批次,避免反复记录未修改的缓存页。日志错误使当前页句柄进入恢复封闭,保留材料而不靠析构重试。
- 已提交逻辑组重放前丢弃受影响表的派生索引,再依据修复后的堆重建;整表载荷直接重写,避免残缺根或部分行集阻断幂等恢复。账号变更统一走带提交标记和检查点的组,保留旧账号日志解码 / 恢复。
- 显式 compact 在独立文件代次复制堆与索引,最终库写门内追平并发变更,保留切换时逻辑行序。影子文件同步后用 Migrate WAL 发布 catalog.file_generation,对象身份与结构版本不变。旧快照阻止退役文件删除;启动恢复后清理孤立代次。保留有序前缀、重写其余后缀避免重排可观察行序,代价是变化较多时切换窗口变长。启动隐藏列整理保留离线 Compact 日志兼容。
+121
View File
@@ -0,0 +1,121 @@
# ChuSQL 当前限制与风险
进度见 progress.txt,设计见 design-decisions.txt;仅记录未解决的限制。
## 事务、恢复与并发
### 事务快照与冲突
- SQL 工作行集仍整库物化,持久化行版本目录每次发布也会读取整库并写出文件。每会话一个事务,无嵌套事务,事务内禁止 DDL / USE;未提供按需版本读取和增量版本日志。
- BEGIN / COMMIT 仍有快照传输和修改表比较成本。SERIALIZABLE 写事务按表复查读依赖,可能因不同行的变化发生保守冲突;未提供谓词锁或 SSI。长期快照阻止旧版本和退役文件回收,增加内存、磁盘与 I/O 成本。旧版本的内存回收随事务结束完成,磁盘版本文件在后续发布时收缩。
### Web 编辑生命周期
- Web 首次加载业务表即固定编辑快照,同一登录会话只允许一个页面持有编辑事务;系统身份表只读,通过 SQL 管理。
- 页面关闭的回滚请求可能因断线未送达;此时按会话空闲 / 最长寿命过期清理,后台每分钟检查一次。编辑连接失效后必须重新登录,不能恢复旧快照。
### 提交与存储边界
- 行锁和唯一键锁跨请求保留到事务结束,保存点回滚不提前释放锁。总锁等待上限为 5 秒,死锁或超时中止事务;调用方须 ROLLBACK 后重做业务检查,无自动重试。缺少可用整数 id 或旧重复 id 时,物理提交可能整表替换,但合并与冲突使用内部行编号。
- 原始存储整表替换仍兼容旧重复 id;普通插入会在提交前拒绝 id 索引冲突。这不表示存储端已完整执行 SQL 的全部唯一性和类型约束,SQL 约束仍由引擎校验。
### 恢复与锁
- 逻辑 WAL 仍为 redo,逻辑重放范围按库检查点决定。页 LSN 与全页镜像用于修复撕裂页,不代表已经实现按页跳过任意逻辑操作;恢复需重建受影响表的派生索引,代价随数据量增长。库目录建删不走 WAL,删库用墓碑目录处理。
- recovery_required 期间除 Ping / SystemStatus 外请求被拒绝,需恢复后继续。
- 同库可并行准备不同行的修改;最终校验、WAL 发布和页刷盘仍按库串行。权限和 DDL 全局排序。管理员原始存储写入不取得 SQL 事务行锁,版本变化会使冲突的旧事务拒绝提交。未给出吞吐量或尾延迟保证。
- 权限变更只标记 TCP 连接失效,客户端下一次请求收到 unauthorized 后关闭,空闲连接不会立即断开;并发测试不证明性能提升。
## 查询与性能
### 行与索引容量
- 堆行的 JSON 编码必须放入单页(默认 4096 字节,含页头与槽位开销),尚无长行溢出页;TEXT 不表示可存任意长度正文。普通提交组会在写 WAL 前拒绝超页行。
- 标量索引键默认最多 128 字节,按页容量与分支数计算有效上限,密集旧配置可能仍只有 64 字节;字符串按 UTF-8 字节计数,普通写入与建索引在提交前拒绝超限。非索引文本仅受声明长度和整行容量限制;写入长键后不得降级到仅支持 64 字节的旧二进制。
### 成本估算与统计
- 基础成本及贪心连接重排,无动态规划或跨外连接重排;只在行序不可观察处重排。
- catalog 行数可能滞后,distinct 有上限;16 桶等宽直方图只统计数值并按闭区间估算,增量维护可能偏差,桶内分布仍为估算。
- 内存统计去重上限为 4096,暂不提供直方图或索引成本;派生表可从透明算子估计行数,含聚合或可能报错表达式时仍保守。投影下推保留所有计算项,不消除潜在错误。
### 子查询与并行执行
- 查询内物化只在内存保存结果,尚无容量预算或磁盘溢出;既有按绑定分组求值可能更早报告同一错误。
- CTE 解析期展开,不支持递归、写语句或 MATERIALIZED / NOT MATERIALIZED 指定;不同优化子树不能共享物化。只能引用前面定义的 CTE,前向引用按普通表名解析。
- 半连接重写尚未覆盖组合谓词、复杂相关条件、多键、相关聚合或排序截断;可能报错的相关投影继续走原执行路径。
- 并行只覆盖页区间扫描:schema 至少 1000 行、最多 8 线程,无页内并行,统计滞后可退回顺序扫描。
- 显式 compact 使用影子文件在线复制和 WAL 代次切换,但仍物化完整行集。最终追平与切换独占库门;并发变化较多时可能重写较长后缀,不能保证固定切换时延。中途失败的未发布代次在重启恢复后清理;启动隐藏列整理仍离线重写。
## 权限与兼容性
### 旧数据与对象身份
- 旧目录或历史行中的非法字段名不自动改名;原始扫描与旧 WAL 重放仍可用,但新写入或重写载荷须提供合法顶层字段名。迁移需显式整理字段,不能靠升级自动修正。
- 对象权限快照整体写入,鉴权会读取身份、成员和对象元数据;尚未针对大规模权限目录做性能基准。
- 对象高水位损坏或回退后无法恢复已删除对象的编号上限;旧二进制会丢弃新增目录字段,不应降级使用已升级的数据目录。
### 权限功能与迁移
- 无列级权限、所有权转移或角色 ADMIN OPTION。
- 旧授权缺少授予来源,迁移为管理来源;旧全局 * 只绑定迁移时现存表。没有身份改名命令;已有同名 public 身份在删除前不会解析为虚拟 PUBLIC。
- 尚无 CREATEDB / CREATEROLE、继承开关、口令到期、连接上限或 Web 专门的身份属性编辑界面。
- 旧账号与角色重名会阻止迁移;迁移后的身份目录与 DOMAIN 编码不支持旧二进制。更早的 __chusql_users 无自动迁移。
- 旧配置 host 不读取,web.static_dir / web.user 被忽略,升级需按 docs/config.md 调整。
- 引导不重设已有口令、不提升已降权身份;类型定义冲突需人工解决。
## 类型与语义
### 范式与类型能力
- 范式分析最多 12 列;领域原子性和依赖完整性由用户声明,信息不足时不认证高阶范式。分解建议仅一轮,不保证子关系已达 BCNF;尚无自动迁移。
- DOMAIN 尚无 CASCADE、改名、修改基础类型、NOT VALID 及显式事务内 DDL;ALTER DOMAIN 读取整库快照,尚无按依赖扫描或磁盘溢出;尚无 ENUM 或用户定义复合类型。内置目录不能靠增加行扩展基础类型。
- DECIMAL 仍使用浮点表示,不是精确十进制存储;整数类型共用整数表示,CHAR 不补空格。
- 少量接口设置仍用字符串类型名;Haskell 值语义和 Rust 索引键分开维护。旧 ColumnType / RelOp 仍是兼容桥,完整能力、转换及关系 IR 迁移待后续阶段。
### 绑定与执行隔离
- 多请求查询不提供整条查询的数据快照;旧目录无有效对象编号时无法证明历史对象身份。执行期外层行仍使用扁平布局,原始关系执行 API 仍允许名称引用;尚无独立作用域或来源编号。
- 引擎直接调用存储时,各次操作分别取门,尚无整条语句的数据快照或数据冲突检测。服务端会话已对数据写入及提交整体串行,但不提供自动提交语句在 I/O 失败后的整体回滚。来源/列缺少独立身份,不能视作完整写入 bound IR;建表、库及 DOMAIN 管理不在已有表写计划范围。
- CHECK 仍以表达式文本持久化;RENAME COLUMN 不自动改写依赖 CHECK,引用旧列名时拒绝改名。普通原始存储 DDL 不具有 Haskell 的完整表达式语义校验。
### 复合值与协议
- 内建运行时类型已提供 Eq / Ord / Hash 能力,尚无用户注册的运算实现或复合索引键编码;运行时类型的索引、UNIQUE / PRIMARY KEY 仍拒绝。复合字段在 Web 通过 SQL 修改,没有结构化单元格编辑器。
- 运行时协议使用版本 1,旧客户端不支持新增类型化值;Web 的 JSON 数值仍受 JavaScript 安全整数范围限制。
- 派生表输出取裸列名,重复名称报错;未定型 NULL 仅用于查询类型推导,不可声明为存储列类型。
## 构建、发行与安全
### 离线维护
- 离线 recover 依赖完整可用 WAL,不能保证修复损坏数据页或已截断的历史;未知系统表缺少结构时需备份或 reset。目录计数器损坏后无法还原已删除身份编号上限。
- 旧版进程不支持数据目录独占锁;维护前必须停止所有相关进程。
### 本机认证与平台验收
- sudo 本机认证需提升身份启动 server;当前只映射 Unix root / Windows 提升 Administrators 到一个显式配置身份,无任意 OS 用户映射或自动提权。异常退出留下的端口凭据目录须在确认停止后手工清理。
- sudo 的 Windows 提升成功路径、macOS 编译运行及 Linux 完整提升 server/CLI 链路仍待目标平台实机验收;Debian/WSL 已验证原生凭据安全边界。
### 构建与发行
- 直接构建独立 Stack 工程时可能复用旧注册库,必要时使用 --force-dirty 或全量门禁 -Full;Haskell 构建须串行。
- 存储协议变化后必须重建实际 cdylib,开发环境须配置 PATH / LD_LIBRARY_PATH;旧命名构建工件仍可能残留。
- 真实 server 测试须先引导并能找到 bootstrap;注释检查对部分多行语法可能误报。
- GitHub 在线安装、Linux $ORIGIN 与 macOS 发布仍需实机验证;无 Release 时在线安装无法取得预编译资源。
- SHA256 只能检测损坏,无发布签名;外部采集仍可能记录 SQL 原文。旧 CLI 历史不自动清理,任意业务字符串中的敏感数据不自动识别。
### 容器验收范围
- 容器仅验收 Linux amd64、本次工作区源码镜像及本机已有 ChuBlog 数据库镜像的升级;五分钟负载与 SIGKILL / 检查点 ENOSPC 回归不替代生产长期稳定性、真实断电或任意版本升级验证。
- 部分 Docker 代理的镜像源模式会返回 502,可显式设置 BASE_REGISTRY;构建器不自动继承 Engine 的镜像源。WSL 曾退出但原因未确认,仍须限额构建,或在构建机生成后导入。
## 博客接入边界
- examples/blog 提供数据库 schema、旧文件字段映射及真实驱动验收,不修改 ChuBlog 当前文件账户实现。生产账户迁移、HTTP / SSH 授权、会话与查阅凭据版本检查、哈希升级、限流、匿名身份合并及文件访问控制仍由 ChuBlog 配套实现。数据库或身份查询失败时应用必须拒绝受保护访问。
- 博客关联尚无数据库外键;双方写入及物理删除需采用 SERIALIZABLE 事务检查存在性和关联明细。评论按字数、UTF-8 字节、请求体和配额限制,整行仍须适配页容量,不提供长行 / 溢出存储。
- 本阶段没有重建 Docker 镜像;已验收镜像仍对应 progress.txt 中的可靠性阶段版本,不含当前事务及长键改动。腾讯云内网 Debian 源仅按要求修改,未执行网络或构建验证。
### 页格式与升级边界
- 新增 .pages(版本 1 页 LSN / 写序号)、.page-wal(CPW1 全页镜像)及临时 .pages.pending。停机备份和迁移必须复制整个数据目录,不得只复制 .db / .idx;首次写入页版本后禁止旧二进制写该目录。
- 全页镜像可修复镜像已完整同步后的撕裂写;可检测到的镜像或页元数据格式损坏会报错,不能检测或修复任意介质损坏。不提供真实断电、文件系统或硬件缓存丢失的保证。
+31
View File
@@ -0,0 +1,31 @@
# ChuSQL 长期路线图
交付状态和验收只以 progress.txt 为准;近期顺序见 side-branch-plan.txt。
本文件描述目标,不代表现有实现或功能承诺。
目标链路:SQL → 解析与绑定 → 类型化中间表示 → 规划与优化 → 执行 → Rust 存储。
类型化中间表示(Typed IR)是已经确定类型与引用关系的查询结构;能力(Capability)描述类型支持的运算。代数数据类型(ADT)用于表达多个可选构造分支,多版本并发控制(MVCC)用于管理数据版本和读取快照。
类型能力与权限保持独立;catalog 保存对象、依赖和语义,内核保留必要基础机制。
## 阶段目标
按以下阶段推进;括号中的编号沿用原路线图:
| 阶段 | 目标 |
| --- | --- |
| A 类型与函数基础 | 稳定 TypeId / FunctionId、注册表、逻辑/物理类型分离、版本化值;验收见 progress.txt。 |
| B 能力与运算(2–6) | 类型能力、运算符、类型转换、聚合,以及参数多态与约束解析。 |
| C 复合与自定义类型(7–12) | 代数数据类型、记录/复合类型、命名类型/领域、参数化类型、范围和用户类型。 |
| D 函数与效果(13–16) | 用户函数、效果管理、纯计算生成列和有副作用的触发器。 |
| E 权限与类型化查询(17–19) | 权限能力、类型化查询 Query a,以及查询重写与优化器的函数化。 |
| F 扩展 | 对象体系统一后实现 Extension 的版本、依赖、安装/升级/移除;其他访问方法按真实需求推进。 |
## 贯穿约束
- 现有 ColumnType / Expr / RelOp 有真实消费者;迁移时逐步收拢,不提前删除兼容桥。
- 每阶段验证持久化、升级、依赖和恢复,不能靠重新初始化掩盖不兼容。
- 内建对象可由可信 bootstrap 元数据恢复;用户对象依赖 WAL / 备份。
- catalog 版本与 bootstrap / recovery 匹配,系统目录索引可重建。
- 不提前增加孤立扩展或绕过事务、权限及依赖管理。
+129
View File
@@ -0,0 +1,129 @@
# ChuSQL 已完成事项
更新:2026-10-16
本文件是当前完成状态及最新验收的唯一来源,等价于 project-plan.txt;不保留历史批次、提交记录或修改流水。
设计见 design-decisions.txt,未解决限制见 known-issues.txt,后续计划见 side-branch-plan.txt。
近期第一阶段“数据库可靠性与部署验收”、第二阶段“博客业务持久化与驱动联调”及第三阶段“存储并发与恢复扩展”已完成数据库侧本地验收。第三阶段包括持久化行版本、行与唯一键锁、死锁与锁等待取消、同库并行数据准备、在线文件代次迁移,以及页 LSN / 全页镜像恢复。整库物化、串行最终提交和切换窗口的成本见 known-issues.txt。ChuBlog 实际业务接入、生产文件迁移、长期运行及真实断电仍保留配套边界。
## SQL 与查询执行
- 实现 CRUD、表列约束、索引、INNER / LEFT JOIN、聚合、GROUP BY、HAVING、ORDER BY、LIMIT、投影别名、DISTINCT / ALL;排序支持输出序号、表达式、函数、聚合及子查询。
- 实现标量及相关子查询、派生表、非递归 CTE、IN / EXISTS、比较与 ANY / ALL;保持 NULL 三值逻辑、重复列、稳定排序、空输入聚合及空集成员比较语义;HAVING 覆盖整体组与未投影聚合,新子句参与依赖守卫和表权限检查。
- 实现谓词 / 投影下推、常量折叠、点查 / 范围成本选择、贪心内连接重排、16 桶直方图及保序并行扫描;子查询按定义和外层值在查询内物化、跨子句复用,相同 CTE / 派生执行子树共享结果;独立 IN / NOT IN 和简单等值相关 EXISTS / NOT EXISTS 使用哈希半连接 / 反连接。
## 类型与绑定
### 类型表示与 DOMAIN
- 建立固定类型 / 函数编号、TypeId / TypeExpr / Kind、逻辑与物理类型、版本化复合值编码;支持 Int / Double / Bool / String / List / Maybe / Tuple、length / not,接入 SQL、存储、CLI 和 Web。
- 内建类型描述提供 Eq / Ord / Hash 能力,List / Maybe / Tuple 根据参数递归派生,DOMAIN 沿用基础能力。复合值支持结构比较、排序、JOIN、IN / ANY / ALL、分组、去重及 MIN / MAX;完整身份不隐式转换,保留 SQL NULL / Nothing、稳定排序及正负零的相等哈希一致性。索引与唯一键边界见 known-issues.txt。
- 实现 CREATE / ALTER / DROP / SHOW DOMAIN、库内嵌套定义、列引用、依赖与循环校验及持久化;支持领域 DEFAULT / NOT NULL / 多条具名或匿名 CHECK、约束继承、默认值优先级与旧数据校验,查询输出保留 DOMAIN 身份。
### 查询与写入绑定
- 查询使用 BoundQuery;表达式、投影、连接、排序和分组按 schema 槽位绑定,存储返回行按布局整理,缺列和位置失配明确失败。
- 相关列按最近到最远的独立词法作用域解析,局部 / 外层槽位分离;重绑定保留有效位置,失配仅允许唯一同名列重定位。子查询取值与缓存共享槽位绑定。
- DML 使用可复用 BoundWrite,预绑定 INSERT 输入、UPDATE 目标、DELETE 布局及 CHECK / 非空 / 唯一性约束;保留默认值、自增、逐项赋值和未命中行不求值,唯一性按最终行集判断,失败不发布修改。
### 依赖复查与约束发布
- 查询与已有表写计划保存对象身份、schema 版本、列定义及传递 DOMAIN 依赖;执行前及实际存储操作锁内复查。写前握手拒绝不支持守卫的存储,跨库按名称排序取门;数据、统计和无关结构变化不使计划失效。
- ALTER DOMAIN 校验一致整库快照,并在存储写门内复查库身份和提交点后通过既有结构 WAL 发布;并发提交返回 serialization_failure。依赖领域的建表及领域创建使用结构守卫,事务提交复查修改表及传递领域依赖。
- CHECK 定义与执行共用类型及槽位绑定;建表、加列和结构变更校验条件、默认值与键能力,空表不跳过,失效引用明确拒绝。
## 存储与事务
- SQL 查询与数据写语句使用存储事务;同库不同行可以并行准备,行锁等待不占库提交门。最终权限 / 对象 / 约束校验与 WAL 发布仍串行;权限与 DDL 全局独占。真实 TCP 验证不同行合并提交、旧快照读取、死锁返回和断线释放行锁。
- 实现页、堆表、B+Tree、catalog、WAL、LSN 检查点、已提交组幂等恢复及页内 compact;持久化对象编号、高水位和 schema 版本,失败进入 recovery_required。
- 实现按连接隔离工作库、持久化行版本快照、行级写写冲突检查、保存点和合并提交;权限及对象身份在事务提交时复查。COMMIT 在发布前复用引擎规则校验合并最终行集,拒绝不同整数主键形成的 UNIQUE 冲突,失败不发布其他表修改。
- 支持 BEGIN [TRANSACTION] ISOLATION LEVEL SERIALIZABLE 及 START TRANSACTION ISOLATION LEVEL SERIALIZABLE,写事务提交按表复查全部读依赖的 schema 和数据,包含子查询和幻行;保存点回退恢复读依赖,只读快照可完成,默认 BEGIN 保留不同行合并行为。
### 提交前校验
- 普通 WAL 提交组在落盘前复用堆行与索引键编码检查行大小及有效索引键长度,覆盖单行 / 批量插入、整表替换、事务、结构替换及整理;超限输入不改变数据、索引、catalog、WAL 或检查点,不触发 recovery_required。
建索引先校验已有值,结构替换按实际保留的索引校验;堆表直接写入与整表替换也在修改前拒绝超限键。
- 新插入 id 的冲突在普通 WAL 提交前按操作顺序预检,覆盖单行、批量及跨表事务;复用实际键编码,按需点查并缓存键计数,支持先删除再插入及整表替换。保留 NULL / 缺失 id、旧重复 id 与重复删除键只删除首行一次的兼容行为。
- 普通写入可能扩列时,在提交前按操作顺序复用 catalog 规则预演列推导和 schema 版本递增;结构替换及整理的载荷行参与预演。版本耗尽不发布数据或日志修改;同一行多列只递增一次,未定型 NULL 不扩列,版本上限不阻断无需结构变化的数据写入。
- 存储协议的表名、列定义及写入行顶层字段名共用名称规则;单行、批量、整表替换、结构替换和事务载荷在处理请求时拒绝非法字段名。值内部键和文本不受字段名校验影响,旧数据扫描与已提交旧 WAL 重放保持兼容。
### Web 编辑事务
- Web 编辑使用独立连接与页面绑定,支持跨表原子提交、保存点重放、提交去重、冲突重载、SQL 标签隔离及退出清理。
## 身份、工具与发行
- 用户与角色统一名称空间,支持 LOGIN / SUPERUSER / ENABLED、稳定编号、角色继承、迁移及删除清理;权限变更使受影响会话失效。
- 实现对象所有权、grant option、DATABASE CONNECT / CREATE、表级数据权限及 PUBLIC、SHOW GRANTS、REVOKE GRANT OPTION FOR 和失效授权级联清理。
### 认证、工具与发行
- 实现默认关闭的本机 sudo 身份映射、受保护凭据、回环校验与一次性 HMAC 挑战;已验证 Windows 非提升拒绝及 Debian/WSL root 凭据安全边界。
- 范式检查通过 Haskell / TCP / CLI / Web 提供只读分析,依据 schema 与声明检查 1NF / 2NF / 3NF / BCNF,输出违反依赖、一次无损分解及依赖保持结果。
- 引导初始化 system、默认 root 与 18 个内置类型,重复引导保留口令并拒绝冲突;实现 system_catalog_manager 及 bootstrap repair / recover / reset。
- 统一监听、数据 / 日志目录与配置模板;完成 Windows 分组件打包安装冒烟、管道口令兼容、敏感 SQL 诊断 / 历史脱敏及 UTF-8 构建。发行与平台未验收事项见 known-issues.txt。
## 容器部署
- 提供多阶段 Dockerfile、默认数据库与可选 Web 的 Compose 配置、非 root 服务、文件口令、幂等引导、数据 / 日志 / Web 偏好卷、协议健康检查和停机备份说明。
- 构建按单任务执行,GHC 构建堆上限 1536 MiB;运行服务各限制 1 核和 512 MiB,文档提供 3 GiB 上限的 Buildx 构建器及异机构建导入方式。
## 最新验证
### 门禁结果
- 全量门禁通过:Rust 221 / Engine 619 / Server 177 / Web 80 / CLI 20 / Bootstrap 9,均零失败;release 动态库重建、Clippy、注释检查及 git diff --check 通过。
受影响 Haskell 源码与测试 HLint 无建议;Fourmolu 格式及幂等检查通过。
### 存储回归
- 回归验证超页行与超长索引键在提交前拒绝,失败后文件不变且可继续读写和重启;覆盖 UTF-8 字节边界、NULL、建索引失败与移除索引后的结构替换。真实 TCP 验证超限 SQL 写入后仍可查询与写入。
- 重复 id 回归验证单行 / 批内 / 跨操作冲突均不改变持久文件,事务早先的跨表修改不发布;合法删除再插入可提交并重启点查。验证整值浮点等键、NULL / 缺失 id 及旧重复 id 的删除顺序;真实 TCP 验证重复 id SQL 插入报错后仍可查询和合法写入。
- 扩列回归验证单行、批量、整表替换、结构替换及事务在 schema 版本耗尽前拒绝,失败后持久文件不变,原表可读、合法写入及重启正常;同一行多列与未定型 NULL 的版本行为保持一致。
- 非法字段名回归覆盖六种写入路径,空名、路径字符、点号、空白、非 ASCII 字符和 NUL 均在写入前拒绝且文件不变;合法文本及嵌套对象可重启读取,旧式字段名的已提交日志仍可重放并继续合法写入。
- 验收入口:gate-check/run-gate.ps1;最新日志:logs/mvcc-stage-gate-final.log,真实 TCP 日志:logs/id-preflight-tcp.log。当前工作区改动未提交。
### DOMAIN 回归
- DOMAIN 回归覆盖继承默认值、显式 NULL、UNKNOWN、非空、多条约束及命名、空表定义校验、加列 / 改类型、旧行与依赖默认值拒绝、绑定失效、真实 FFI 重启与并发插入冲突;Rust 验证发布失败不改持久文件、结构版本递增及已提交日志重复恢复,Server 验证管理员权限、事务 DDL 禁止和领域变更后的旧事务提交拒绝。
### 复合值运算回归
- 覆盖数字与前缀排序、可选值和元组顺序、嵌套 Eq / Ord / Hash 一致性、NULL / Nothing、空容器身份、非有限数拒绝、分组 / 去重 / 极值、连接 / 成员 / 相关存在与量词比较;真实 FFI 验证重启后的复合 DOMAIN、隐式 id 索引回退、修改和删除,Web 经 HTTP / TCP 验证结构值比较、排序和分组。值与类型编码保持版本 1。
### Docker 验证
- 完整多阶段源码镜像构建通过,Rust / Haskell / 运行阶段均为固定 digest 的 Bookworm 镜像;本地验收镜像为 chusql:local,ID / 仓库摘要为 sha256:4b22ced1f95c80c6904a5c794acac02d141b3e1dc91a619692c07dc020fcc720。构建器限制 1 核 / 3 GiB、无额外交换空间,GHC 堆上限 1536 MiB;构建完成后已停止构建器。
- 默认与 Web profile 的 Compose 配置、TOML、脚本语法、入口与健康检查错误分支通过;独立 Compose 项目验证固定镜像、首次引导、非 root 卷权限、TCP / HTTP 健康检查、CLI、Web 登录、1 核 / 512 MiB / 128 进程限制及无额外交换空间。
- docker/test-runtime.py 在真实源码镜像上完成 300 秒、三个会话并发负载:1696 次成功提交、2415 次明确冲突;SIGKILL 恢复后 1701 个关联事务完整,全部已确认提交保留,未提交数据丢弃。
- 用容器内 16 MiB 临时文件系统制造检查点 ENOSPC,验证 WAL 已提交后的错误、业务请求封闭、日志保留、重启幂等重放及恢复后写入;不填满宿主磁盘。验证重复引导不覆盖原口令,停机备份恢复到空卷后业务行、账号和只读授权保留。
- 本机已有 ChuBlog 镜像 sha256:afd2394af5606169b7dbf5b08f4e30fe0521fe47b0b6fbd7c53a67154388c354 的测试数据,在停机并将卷所有者从 10003 调整为 10001 后,可用本次镜像打开、保留原口令并继续写入;不据此承诺任意版本升级兼容。
- ChuBlog 当前固定 Rust 驱动的 2 项单元测试与 4 项协议测试通过,覆盖错误码、断线、超时、取消及响应大小;真实 TCP 示例完成 Unicode / 布尔值 CRUD 与结果映射。博客业务数据库侧验收见下节;ChuBlog 生产文件迁移仍需配套实现。
- 日志为 logs/docker-source-build.log、logs/docker-runtime-acceptance.log、logs/docker-integration-check.log、logs/docker-upgrade-check.log 和 logs/blog-driver-tests.log。全部测试容器、网络及测试卷已清理;本次未改动 ChuBlog 源码。
### 博客业务与驱动验收
- examples/blog/schema.sql 与 acceptance.rs 提供账户、完整 Argon2id PHC、角色 CHECK、发布路径 / SSH 公钥、文章权威状态、评论、互动、计数、审计及迁移标记的模型和实际 Rust 驱动验收;正文不入库,可重建索引独立。
- 实际驱动验证旧 reader / publisher / admin 及禁用账号映射,完整 PHC 原样保存、参数与盐保留且可验证原口令;独立盐产生不同哈希,错误口令拒绝。迁移输入缺失授权时拒绝,同一来源重复迁移不重复写入。该验收使用构造的旧文件副本,不读取或迁移生产账户。
- 验证不同主键并发注册仍只有一个用户名、跨表失败不部分发布、撤权后的旧读事务拒绝、文章删除与并发评论冲突、点赞 / 收藏并发计数、去重与重复取消、负数拒绝、匿名 / 登录评论关联、同时间游标分页、可见评论聚合 / 重算及超页评论拒绝后继续读写。
- 验证文章查阅口令完整 PHC、撤销版本及管理审计持久化,文章索引重建不覆盖隐藏 / 删除 / 精华等权威状态;仅获文章索引表权限的数据库账号不能读口令哈希或改管理状态,关闭连接后的查询明确失败。HTTP / SSH / 文件访问授权仍由博客实现。
- 标量索引键默认支持 128 字节,实际上限按页容量及分支数计算;真实驱动验证 113 字节文章键,Rust 回归覆盖 128 字节键跨页 / 重启、旧 64 字节头无写打开及首次长键升级、密集旧配置边界与超限写前拒绝。无正文或长行存储改动。
- examples/blog/test-business.py 以真实本机服务和 ChuBlog 固定 Rust 驱动完成 seed、重启 verify 及停机备份副本 verify,账户哈希、授权版本、评论、互动计数及审计均保留;临时业务目录和副本自动清理。日志为 logs/blog-business-driver.log。
- Dockerfile 的 Debian 源改为 http://mirrors.tencentyun.com,按用户要求未验证或重建镜像;既有 Docker 验收结果只适用于上节固定镜像。接入方式及应用边界见 docs/blog-database.md。
### 行版本、并发与在线迁移
- 持久化 mvcc.json 记录格式版本、提交序号、不复用行编号、可见起止序号、内容版本与逻辑行序。默认快照隔离与自身修改可见,SERIALIZABLE 写事务按表复查读依赖;旧目录首次事务或写入前导入,原堆页格式不变。堆 / 索引同步后原子发布版本目录,再推进检查点;重启重放幂等发布,版本超前于可恢复 WAL 时拒绝打开。
- 行锁和旧 / 新唯一值锁跨请求持有,NULL 不争用唯一值锁。等待图检测环、5 秒总等待超时、显式取消与存储恢复封闭均可释放或唤醒等待者;deadlock_detected、lock_timeout 和 serialization_failure 保留结构化错误码。保存点回滚同步最终计划与读依赖,锁保留到事务结束;断线和重新认证清理旧事务。
- 同库数据准备共享执行门,最终校验和 WAL 发布使用短提交门;其他库可独立推进。内部行编号用于合并与冲突,内容版本避免其他行位置移动造成伪冲突;整数 id 可增量物理写入,其余情况保留整表写入兼容。事务结束回收内存旧版本,后续发布回收磁盘版本;原始管理员写入通过发布版本参与冲突检查。
- database_snapshot 保留完整结构 / 数据与提交点返回、相同令牌 snapshot_unchanged 及最近一个库的缓存;SQL 事务另行登记快照存活期,不依赖缓存保留旧版本。工作行集仍整库物化,不宣称按需版本索引扫描或增量版本日志。
- 页与索引页写入前同步 CPW1 全页镜像,数据同步后发布版本 1 的 .pages 元数据,再清理 .page-wal。页 LSN 关联逻辑 WAL 提交点,独立写序号区分同一提交内多次页写;旧无元数据页文件按既有格式打开,首次写入建立元数据。
- 回归验证撕裂数据页修复、重复打开幂等、未完整尾帧丢弃、完整镜像校验失败保留材料、截断后旧页不复活、镜像 I/O 失败后禁止继续刷新,以及小缓存淘汰时镜像量不随缓存页数重复放大。页大小、堆和索引页内布局未变;备份须保留整个目录,新版写入后不得降级旧二进制。
- 逻辑恢复在重放已提交组前重建受影响的派生索引,整表日志直接重写,残缺索引根不再阻断恢复。账号初始化与变更也使用带提交标记、检查点和页 LSN 的普通提交组;旧账号 WAL 仍可恢复。文件删除和改名同步处理页元数据与镜像,并传播发布路径 I/O 错误。
- 显式 compact 在线复制影子堆与全部索引,最终写门内追平并发修改,经 Migrate WAL 切换 catalog.file_generation,逻辑对象与结构版本保持不变。旧快照保留退役文件,结束后回收;重启恢复后清理孤立代次。固定并发窗口验证复制期间删除、更新、新增和行序保持;验证提交切换日志后、发布 catalog 前的中断可幂等恢复。启动隐藏列整理保留离线兼容路径。
- 版本与锁专项验证不同行合并、等待后旧版本拒绝、死锁中止、锁超时、等待取消、旧版本引用回收、SERIALIZABLE 幻行拒绝和重启读取。在线整理回归验证文件缩小、隐藏字节回收、旧快照结束前旧文件保留及重启索引点查。
- 实际 ChuBlog Rust 驱动业务验收后连续提交关联明细与计数,收到十次回执后强杀一次性服务;重启保留全部十次已确认提交,明细 / 计数一致,停机备份副本再次通过。日志为 logs/mvcc-driver-final.log;不据此承诺真实断电或任意介质损坏恢复。
- 本阶段源码动态库、全量门禁、补充 Rust 回归、实际驱动业务 / 并发 / 强杀恢复、HLint、Fourmolu 与差异空白检查通过;日志为 logs/mvcc-stage-gate-final.log、logs/mvcc-lifecycle.log、logs/mvcc-hlint.log。未重建 Docker 镜像,ChuBlog 实现未修改。
+69
View File
@@ -0,0 +1,69 @@
# ChuSQL 近期任务与依赖
本计划帮助开发者按个人博客落地所需的顺序推进数据库。实现、测试及门禁状态只以 progress.txt 为准;设计见 design-decisions.txt,限制见 known-issues.txt。
下列顺序是规划,不是已完成能力;按大阶段交付,阶段内运行受影响模块测试,较大改动完成后运行全量门禁。
## 1. 数据库可靠性与部署验收
以 ChuBlog 最新 TODO.md 的优先级为准;其 PLAN.md 保留原始规划,不能据此排除账户、评论、互动或内部文章需求。先验证现有数据库和驱动,再承接不可重建的业务数据。
完成现有多阶段 Dockerfile 的完整源码镜像构建,在受限 Buildx 或异机构建后导入,避免在 WSL 无限制并行编译。验证该镜像的首次引导、非 root 运行、健康检查、卷权限、重启持久化、升级及备份恢复,并固定通过验收的版本与镜像 digest。
在实际镜像上执行持续负载、并发冲突、进程崩溃、磁盘满及提交失败恢复验证,区分已确认提交、失败和断线后提交结果未知。验证驱动连接、超时、错误传播及回滚行为;未知提交结果不能直接重试非幂等操作。先处理发现的数据一致性缺陷,不要求先实现完整 MVCC。
在副本演练备份恢复,区分可从 Git 重建的文章索引与必须恢复的业务数据。域名、公网证书、SSH 发布、Git 硬配额和整站加密备份属于 ChuBlog 部署工作,数据库阶段提供相应验证支持,不替代整站验收。
## 2. 博客业务持久化与驱动联调
覆盖用户、Argon2id 密码哈希及参数、角色、发布授权和迁移;支持 BANNED / MEMBER / AUTHOR / MASTER 所需的业务数据。角色继承、文章所有权及撤权后的会话 / SSH 发布失效由博客服务端落实,不要求为每名读者创建数据库身份。ENUM 先评估驱动兼容性,可用现有标量字段及 CHECK 约束交付,不作为默认前置条件。
核对实际字段、SQL 和协议需求,验证并发注册唯一性、业务关联写入及权限变更的原子性。现有多请求写语句缺少整条语句的数据快照与冲突检查,须验证显式事务能否满足这些场景,并补齐必要的数据库或驱动缺口;不能把单次存储操作持锁等同于整条 SQL 原子性。
保存内部文章可见性、查阅口令的加盐慢哈希及授权撤销版本、站长隐藏 / 删除 / 精华状态和管理审计。将这些权威业务状态与可重建文章索引分开,验证作者再次推送、索引重建或恢复不会覆盖站长管理决定;数据库或身份查询失败时拒绝受保护访问。哈希计算、限流及正文 / 资源访问控制由博客实现。
验证评论的作者 / 文章关联、时间、管理状态、分页和必要索引,以及匿名 / 登录身份关联、重复提交与点赞 / 收藏去重所需的持久数据。并发新增、取消、删除及计数更新须保持约定的一致性,避免重复计数、丢失更新和负数;热度权重、时间衰减、防刷及保留规则由博客定义,数据库验证聚合、排序和重算所需能力。按实际查询检查稳定分页、可见性过滤与资源消耗。
正文和资源落盘为文件,不存入数据库;长行 / 溢出存储不属于博客需求。评论虽然入库,也不据此引入长行支持:由博客明确字数、UTF-8 字节数、请求体和累计配额,数据库按实际整行编码验证容量。按实际索引字段验证 64 字节键限制,只有实际超限时才补所需标量长键支持,不截断或静默丢值。
使用 ChuBlog 的 Rust 驱动完成上述数据库场景联调及账户迁移、业务备份恢复验证。博客实现和旧文件迁移属于 ChuBlog 的配套工作,修改该仓库前遵循其开发约束;前两个阶段完成表示数据库满足已验收的博客场景,不代表博客前端、审核或所有后续功能已完成。
## 3. 存储并发与恢复扩展
本阶段范围为持久化行版本、快照引用与回收、行锁和唯一键锁、等待 / 取消与死锁、同库并行准备、连续 WAL 发布,以及影子文件在线迁移与恢复。实现和验收状态只见 progress.txt。
后续性能工作根据实测减少整库物化、版本文件写放大和最终切换窗口,保留隔离、行序、句柄生命周期和恢复约束;不把这些优化混同于未完成基础并发能力。
## 4. 统一绑定与类型系统
在已有多级词法作用域、查询和写入绑定基础上,完善独立来源 / 列身份及约束绑定,收拢旧兼容桥。
在 DOMAIN 约束、ALTER DOMAIN 和内建复合类型 Eq / Ord / Hash 的基础上,推进精确 DECIMAL、复合索引键编码及用户运算实现,再推进枚举(ENUM)、用户复合类型和代数数据类型(ADT)。博客若采用 ENUM,须连同驱动映射另行验收,不作为账户持久化的默认依赖。
统一写入、导入、事务提交与 Rust 索引语义,保留 nullable、错误时序和布局语义;明确整数范围、CHAR、旧目录身份升级及数据迁移。已有 schema 版本和读取守卫的验收见 progress.txt。
## 5. 原子结构变更与范式迁移
将库建删、DDL、对象依赖及版本复查纳入原子发布和恢复,维护绑定失效、权限、回滚与编号高水位。
在对象目录、DOMAIN 约束及结构事务基础上支持 CASCADE 和范式自动迁移,发布前验证旧数据与嵌套依赖。
迁移首版保留来源,拒绝 NULL、重复行及依赖不保持,后续推进多轮分解。
## 6. 查询语言与执行优化
推进递归 CTE 和写入型 CTE,扩展复杂条件去相关,完善物化内存预算及磁盘溢出,合并连接搜索、外连接变换及统计成本改进;写入型 CTE 依赖统一写入校验。
优化保持行序、重复、错误时序及来源解析规则。博客基线查询若出现资源耗尽或性能问题,先按实测补必要预算或优化,不等待本阶段整体完成。
## 7. 权限与客户端扩展
完善数据库列级权限、所有权转移、ADMIN OPTION 和身份属性;统一 Web 复合值编辑、大整数及多页面事务的交互与会话约束。
按真实需求选择实施范围。博客业务用户与角色由博客表及应用授权管理,不要求为每名读者创建数据库登录身份;现有数据库权限不足以隔离博客服务账号时,必要修复提前到博客业务联调阶段。
## 持续验收
- 局部改动通过受影响模块测试;较大改动由 agent 执行全量门禁,通过后再提交。模块测试不替代异常恢复、磁盘错误、持续负载及并发冲突演练。
- sudo、在线安装、Linux $ORIGIN、macOS 构建发行与发布签名按目标平台验证,结果登记 progress.txt;非博客部署目标的平台验收不阻塞博客接入。
- 升级明确账号 / 授权 / 配置迁移、禁止降级、旧历史和异常凭据清理;不承诺旧二进制兼容、损坏页自动修复或任意 OS 用户映射。
- Haskell 构建串行,存储协议变化重建实际动态库;门禁入口为 gate-check/run-gate.ps1。
@@ -0,0 +1,77 @@
---
name: chusql-boundary-contracts
description: 修改 ChuSQL Rust/Haskell FFI、客户端与 Server 协议、跨组件序列化契约或公开接口时使用;核对调用链、线程与所有权。单模块内部算法且接口未变时不加载。
---
# ChuSQL 边界契约
## 适用范围
负责组件间表示、调用与生命周期。类型内容使用 chusql-type-system,落盘与恢复使用 chusql-storage-integrity,通用 unsafe 检查使用 rust-c-ffi-safety。路径相对仓库根目录,按变更读相关消费者。
## 模块与调用路径
- 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 | 离线操作;响应所有权同 request |
| free | u8*, usize → void | 归还原始指针 / 长度对,不跨分配器、不重复释放 |
| last_error | usize* → const u8* | 借用线程局部错误,立即复制、不释放 |
## 必须保持的不变量
### 表示与指针
- 路径为 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 消费者,不绕过对象权限或业务错误。
## 实现取舍与边界
优先扩展共享协议与真实调用者,不增加无用途适配层;确认无人依赖的内部接口可直接调整。新增类型化值沿 JSON 载荷传递,只有实际需要才扩展 ABI。
Rust panic、Haskell IO 失败与业务错误按边界转成明确失败;当前没有自动 ABI 兼容协商或后台回调生命周期管理。
## 验证入口
- 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`,测试范围按风险决定,不自动运行所有者全量门禁。
## 相关资料
Web 值展示 / SQL 生成消费者见 `chusql-web/static/core.js`;总体路径见 `docs/architecture.md`。核对协议时读两端编码 / 解码和调用者,不依赖绝对行号。
@@ -0,0 +1,68 @@
---
name: chusql-storage-integrity
description: 修改 ChuSQL 存储页、索引、序列化、catalog、系统元数据、初始化、持久化事务或恢复时使用;维护实际落盘顺序与恢复约束。普通 SQL 表达式或界面任务不加载。
---
# ChuSQL 存储完整性
## 适用范围
负责持久化状态及其与服务端事务的关系。类型语义使用 chusql-type-system,接口生命周期使用 chusql-boundary-contracts;不照搬 PostgreSQL 内核设计。路径相对仓库根目录,只读受影响模块。
## 模块与调用路径
- `chusql-core/storage/src/runtime.rs`:Storage 持有数据目录文件锁、管理数据库;Server 管每库 catalog、WAL、表缓存和读写门。
- 数据根目录中 system/ 保存系统库,databases/<name>/ 保存业务库。
每库有 catalog.json、mvcc.json、<table>.db、内建 <table>.idx、其他 <table>.<column>.idx、wal.log 与 wal.checkpoint;非空 file_generation 使用 <table>.g<代次> 前缀;页文件另有 .pages、.page-wal 和可能残留的 .pages.pending,备份复制整个目录;诊断日志由 log_files 单独配置。
- `chusql-core/storage/src/page.rs` 管定长页与缓存刷盘;`heap.rs` 管页内槽位、JSON 行、隐藏列和 compact;`btree.rs` 管变长字节键、重复键与叶子链范围扫描。
- `chusql-core/storage/src/catalog.rs` 管 schema、索引、统计、隐藏列、对象编号 / 高水位;`protocol.rs` 定义线上 schema 和系统表常量。
- `chusql-core/storage/src/mvcc.rs` 管持久化行版本、稳定行编号、快照引用、行 / 唯一键锁、等待图与回收。
- `chusql-core/storage/src/wal.rs` 管 LSN、提交组、日志扫描与检查点;runtime.rs 的 group_via_wal、recover_wal、replay_op 连接记录与应用。
- `chusql-server/src/ChuSQL/Server/Session.hs` 管会话快照、保存点、差分与冲突;`Backend.hs` 向存储提交操作。
`chusql-bootstrap/` 调用 Storage::maintenance 与 maintenance_candidate 做离线维护。
## 必须保持的不变量
### 目录与提交顺序
- 表存在性以 catalog 为准,文件存在不表示已登记;不能靠打开文件创建逻辑表。语义与优化只读取 schema。
- Catalog::save 写 pending 文件、同步后替换;单文件替换不等于 catalog、页与索引已整体原子提交。
- 普通组先 append_group 落盘,再设置 recovery_required,然后应用、刷表、原子发布行版本目录、推进检查点、截断日志,全部成功才解除恢复状态。
- 应用 / 刷盘 / 检查点 / 截断失败必须保持恢复状态并报错。普通业务请求被阻断;Ping / SystemStatus 例外由各自分派层处理,新增入口不得绕过状态。
- 恢复仅重放检查点之后已提交组,保持 replay_op 幂等;不应用未提交组。现有 WAL 是 redo,检查点是库级 LSN,不是 undo 或页级恢复。
- 账号引导 / 变更已走普通带提交标记的组;旧账号 WAL 仍须兼容恢复,不删除既有解码和迁移规则。
- 全页镜像先同步,再覆盖页文件;数据同步后发布页 LSN 元数据,最后清理镜像。镜像用独立写序号区分同一提交内的重复页写,错误后当前页句柄不得继续刷新。
### 身份与生命周期
- 库 / 表对象和身份编号依赖持久化高水位,删除后不复用;迁移不能降低计数器,不能从现存对象推断已删除编号上限。
- 系统身份 / 凭据、角色、授权、类型与 DOMAIN 元数据保持对应关系。引导保留已有口令和降权状态,拒绝定义 / 保留文件冲突;类型目录不是可动态扩展基础类型的机制。
- 数据目录锁覆盖存储和维护生命周期;维护前停止占用进程。同库行修改可并行准备,行锁等待不占提交门;最终 WAL 发布、页刷盘和版本发布仍串行,表句柄加锁。
### 事务与格式
- SQL 使用持久化行版本快照,工作行集仍整库物化,无嵌套事务,事务内禁止 DDL / USE。提交按内部行编号合并,整数 id 可差分物理写入,否则整表替换;对象身份、权限和最终约束需复查。行锁等待图中止环的新等待者,5 秒总等待超时;保存点回滚不释放已有锁。错误后调用方回滚,不能只重发 COMMIT。
- 页内 compact 保留槽位编号与索引位置;隐藏列 compact 可能整表重写。布局、键编码、行序和隐藏列改动须检查真实消费者。
- 页大小、B+Tree magic / 布局、槽位小端字段、JSON 行、WAL 标签 / 帧和 catalog 字段是格式契约。改变前明确加载、迁移或拒绝策略,不以重新初始化掩盖不兼容。
## 实现取舍与边界
- 优化可减少分配或重复读取,但保留验证、刷盘顺序、错误传播与可观察行序。结构变更同时核对 WAL、应用、幂等恢复与 catalog 保存。
- 数据库目录建删不走普通表 WAL,删库使用墓碑目录;不能承诺表提交组相同的崩溃原子性。
- 离线维护在候选目录操作并保留备份;repair 不改既有表数据,recover 依赖可用 WAL,reset 重建系统目录且保留业务库。失败保留原目录 / 恢复材料。
- 当前 Catalog::load 对不存在或空文件返回空目录,JSON 损坏报错;不能宣称所有损坏都会拒绝。文件发布路径改名与删除须同时维护页侧文件并传播错误;部分析构 / 清理路径仍可能忽略 I/O 错误,不作为成功持久化保证。
- 在线 compact 复制影子堆 / 索引,最终库写门内追平,经 Migrate WAL 切换 file_generation;影子文件先同步,catalog 再发布。快照结束后回收退役文件,启动先恢复再清理孤立代次。对象编号、schema 版本和逻辑行序不变;同名重建不能复用仍被快照保留的旧文件。
- 行版本以提交 LSN 为可见序号,内容变化和行序变化分开;版本超前于可恢复 WAL 时拒绝打开。旧版本保留到最老活跃快照,不复用行编号。尚无通用结构迁移事务,不据此放松校验。
## 验证入口
- 按影响选择 `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。
## 相关资料
恢复操作按需读 `docs/bootstrap.md`,配置见 `docs/config.md`,限制见 `.agents/context/known-issues.txt`;涉及拟议能力时仍以源码为准。
@@ -0,0 +1,61 @@
---
name: chusql-type-system
description: 修改 ChuSQL SQL 类型、值表示、赋值转换、类型推导、函数或表达式语义时使用;提供类型模块职责与一致性约束。仅调整界面样式或无关存储性能时不加载。
---
# ChuSQL 类型系统
## 适用范围
负责类型语义;落盘顺序交给 chusql-storage-integrity,传输契约交给 chusql-boundary-contracts。通用语言与测试规范使用已有 Skills,不重复加载。下列路径相对仓库根目录,只读本次相关模块。
## 模块与调用路径
- `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>` 保存行。
## 必须保持的不变量
### 类型身份与值
- 构造器编号固定: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 重复实现转换。
- 整数与可规范化整值浮点保持相等 / 哈希一致。内建运行时类型的 Eq / Ord / Hash 由 TypeDescriptor 按参数递归派生,排序和哈希按结构实现;索引键编码仍独立,不能因已有查询能力放开索引或唯一键声明。
### 领域与兼容表示
- DOMAIN 使用 domainTableName 与目录定义解析基础类型、依赖及循环;不能拿解析器占位基础类型直接执行。系统内建类型目录也不是通过增加行即可扩展的插件注册表。
- Date / Timestamp / Blob 在 QueryType 保留 CompatibilityType;ColumnType 与 RelOp 仍有真实消费者,不能作为无用兼容层删除。
### 编码与错误传播
- 类型 / 值编码版本为 1;身份、类型名、封装或值结构变化可能影响 catalog、WAL、FFI、TCP 和 Web,组合相关 Skills 核对消费者。
- Rust 当前保存通用 JSON,只做局部校验,包括隐藏列、DOMAIN 依赖和 DECIMAL 规范化。它没有 Haskell validateValue 的完整等价检查,不要依赖原始存储请求完成所有 SQL 类型校验。
- 错误沿 Either String 返回;`chusql-core/engine/src/ChuSQL/Core/Engine/Error.hs` 用消息规则映射类别 / 协议码。修改错误文字须检查分类,不用默认值或 NULL 掩盖错误。
## 实现取舍与边界
复用 Model / Runtime 的语义入口,在现有类型桥上做最小修改。尚无完整 capability / operator / cast 注册机制、通用显式 CAST、用户 ADT 或 Extension;DOMAIN 的继承约束、默认值和变更校验集中在 Engine/Domain.hs;ALTER DOMAIN 通过一致快照和提交点复查发布。不要将规划当现有契约。
DECIMAL 是有限浮点表示,采用 ties-to-even 舍入与舍入后溢出检查,并非精确十进制存储。内建运行时复合类型已提供 SQL Eq / Ord / Hash 能力,尚无用户注册的运算实现或复合索引键编码。
## 验证入口
- 语义改动验证解析 → 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 自动执行全量门禁或追求覆盖率。
## 相关资料
按需读 `docs/types.md`,区分当前类型用法与未来约束设计。以上源码模块是契约核对入口。
+22
View File
@@ -0,0 +1,22 @@
# 只发送构建所需源码,排除凭据、数据及宿主构建缓存。
.git
.agents
.codex
.aws
**/.stack-work
**/target
**/dist
**/dist-newstyle
**/__pycache__
logs
secrets
.env
.env.*
**/*.db
**/*.idx
**/wal.log
**/wal.checkpoint
Dockerfile*
compose*.yaml
docs
benchmark
+3
View File
@@ -31,6 +31,9 @@ jobs:
steps:
- uses: actions/checkout@v4
- name: installer release fallback tests
run: python3 scripts/test-release-fallback.py
# ---------- Rust 存储 ----------
- name: Rust toolchain
uses: dtolnay/rust-toolchain@stable
+29 -110
View File
@@ -1,8 +1,7 @@
# 发版流水线:打 tag(v*)时为四个平台各出一个发行包,附 sha256,挂到 Release。
# 发版流水线:构建 Windows 与 Linux 安装包,验证后上传 Release。
#
# 资源命名(install.sh / install.ps1 按 <os>-<arch> 挑资源,见 scripts/install.sh):
# chusql-linux-x86_64.tar.gz chusql-windows-x86_64.zip
# chusql-macos-x86_64.tar.gz chusql-macos-arm64.tar.gz
#
# 一个平台一个包,里面 Web 前端与命令行客户端两部分都在;装哪几个由包内的安装脚本
# 当场问(非交互时用 --component / -Component 指定)。
@@ -10,11 +9,13 @@
# 装的人拿到的就是编好的二进制,不需要 GHC / Rust:
# curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh \
# | sh -s -- --component web
# 也可下载 ChuRepo 脚本(发行包下载失败时自动回退):
# curl -fsSL https://repo.chunana.cn/ChuNa7a/ChuSQL/raw/branch/main/scripts/install.sh -o install.sh
# sh install.sh --component web
# 两站发行包与源码安装入口见 docs/install.md。
# 没有对应平台的资源时,同一个脚本可以退回本地编译:
# sh scripts/install.sh --component web --from-source
#
# 说明:macOS 两个 runner 会让总时长变长(每个 job 都要 cargo + stack 各编一遍);
# 不需要 Intel mac 的包就把 macos-13 那两行删掉。
name: release
on:
@@ -29,10 +30,19 @@ on:
permissions:
contents: write
concurrency:
group: release-${{ inputs.tag || github.ref_name }}
cancel-in-progress: true
env:
CARGO_TERM_COLOR: always
jobs:
validate:
uses: ./.github/workflows/linux.yml
with:
phase: release
build:
name: ${{ matrix.platform }}
runs-on: ${{ matrix.os }}
@@ -43,10 +53,10 @@ jobs:
include:
- { os: ubuntu-latest, platform: linux-x86_64 }
- { os: windows-latest, platform: windows-x86_64 }
- { os: macos-13, platform: macos-x86_64 }
- { os: macos-14, platform: macos-arm64 }
steps:
- uses: actions/checkout@v4
with:
ref: ${{ inputs.tag || github.ref }}
# ---------- 工具链 ----------
- name: Rust toolchain
@@ -101,113 +111,15 @@ jobs:
working-directory: chusql-bootstrap
run: stack build --fast chusql-bootstrap:exe:csql-bootstrap
# ---------- 装配 + 打归档(CI 里直接写在这里;本机打同一个包用 scripts/package.sh)----------
# 归档里是包内容本身(bin/、scripts/、static/、install.sh 就在根上),安装脚本按这个布局找文件。
- name: package (Unix)
- name: package and verify (Unix)
if: runner.os != 'Windows'
shell: bash
run: |
set -eu
name="chusql-${{ matrix.platform }}"
stage="dist/$name"
rm -rf "$stage"
mkdir -p "$stage/bin" "$stage/resources"
run: sh scripts/package.sh --out-dir "$PWD/dist" --platform '${{ matrix.platform }}' --version '${{ inputs.tag || github.ref_name }}' --no-build
cp chusql-core/storage/target/release/libchusql_core_storage.* "$stage/bin/"
stack_root="$(cd chusql-cli && stack path --local-install-root | tail -n 1 | tr -d '\r')"
for front_name in chusql-web chusql-server csql; do
front="$stack_root/bin/$front_name"
if [ ! -f "$front" ]; then
front="$(find chusql-web/.stack-work chusql-cli/.stack-work -name "$front_name" -type f 2>/dev/null | head -n 1 || true)"
fi
[ -n "$front" ] && [ -f "$front" ] || { echo "front end binary not found: $front_name" >&2; exit 1; }
cp "$front" "$stage/bin/"
done
# 引导程序住在自己的工程里,安装根也单独问它要
bootstrap_root="$(cd chusql-bootstrap && stack path --local-install-root | tail -n 1 | tr -d '\r')"
bootstrap_bin="$bootstrap_root/bin/csql-bootstrap"
if [ ! -f "$bootstrap_bin" ]; then
bootstrap_bin="$(find chusql-bootstrap/.stack-work -name csql-bootstrap -type f 2>/dev/null | head -n 1 || true)"
fi
[ -n "$bootstrap_bin" ] && [ -f "$bootstrap_bin" ] || { echo "csql-bootstrap not found" >&2; exit 1; }
cp "$bootstrap_bin" "$stage/bin/"
# Haskell 一般静态链接,靶目录里真有共享库就一起带上;改名前的旧库(libchusql_storage.*)不能进包
for lib in chusql-core/storage/target/release/*.so chusql-core/storage/target/release/*.dylib; do
[ -f "$lib" ] || continue
case "$(basename "$lib")" in
libchusql_storage.*|libchusql_storage-*) continue ;;
esac
cp "$lib" "$stage/bin/"
done
cp resources/settings.toml.* "$stage/resources/"
cp scripts/install.ps1 scripts/install.sh "$stage/"
cp scripts/uninstall.ps1 scripts/uninstall.sh "$stage/"
mkdir -p "$stage/static"
cp -R chusql-web/static/. "$stage/static/"
cp scripts/csql-web.sh "$stage/"
if [ -f scripts/csql-web.ps1 ]; then cp scripts/csql-web.ps1 "$stage/"; fi
chmod +x "$stage/install.sh" "$stage/uninstall.sh" "$stage/csql-web.sh"
mkdir -p dist
tar -czf "dist/$name.tar.gz" -C "$stage" .
rm -rf "$stage"
ls -l "dist/$name.tar.gz"
- name: package (Windows)
- name: package and verify (Windows)
if: runner.os == 'Windows'
shell: pwsh
run: |
$ErrorActionPreference = 'Stop'
$name = "chusql-${{ matrix.platform }}"
$stage = "dist/$name"
if (Test-Path $stage) { Remove-Item -Recurse -Force $stage }
New-Item -ItemType Directory -Force -Path "$stage/bin", "$stage/resources" | Out-Null
Copy-Item 'chusql-core/storage/target/release/chusql_core_storage.dll' "$stage/bin/"
$stackRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
foreach ($frontName in @('chusql-web.exe', 'chusql-server.exe', 'csql.exe')) {
$front = Join-Path $stackRoot "bin/$frontName"
if (-not (Test-Path $front)) {
$front = Get-ChildItem -Path 'chusql-web/.stack-work', 'chusql-cli/.stack-work' -Recurse -Filter $frontName -File -ErrorAction SilentlyContinue |
Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
}
if (-not $front -or -not (Test-Path $front)) { throw "front end binary not found: $frontName" }
Copy-Item $front "$stage/bin/"
}
$bootstrapRoot = (& stack path --local-install-root | Select-Object -Last 1).Trim()
$bootstrapExe = Join-Path $bootstrapRoot 'bin/csql-bootstrap.exe'
if (-not (Test-Path $bootstrapExe)) {
$bootstrapExe = Get-ChildItem -Path 'chusql-bootstrap/.stack-work' -Recurse -Filter 'csql-bootstrap.exe' -File -ErrorAction SilentlyContinue |
Sort-Object LastWriteTime -Descending | Select-Object -First 1 -ExpandProperty FullName
}
if (-not $bootstrapExe -or -not (Test-Path $bootstrapExe)) { throw 'csql-bootstrap.exe not found' }
Copy-Item $bootstrapExe "$stage/bin/"
# 第三方 dll 才要连带上:名字带 chusql 的是本 crate 产物或改名前的残留,上面已按名拷过
Get-ChildItem 'chusql-core/storage/target/release' -Filter '*.dll' -File -ErrorAction SilentlyContinue |
Where-Object { $_.Name -notlike 'chusql*' } |
ForEach-Object { Copy-Item $_.FullName "$stage/bin/" }
Copy-Item 'resources/settings.toml.*' "$stage/resources/"
Copy-Item 'scripts/install.ps1', 'scripts/install.sh' $stage
Copy-Item 'scripts/uninstall.ps1', 'scripts/uninstall.sh' $stage
New-Item -ItemType Directory -Force -Path "$stage/static" | Out-Null
Copy-Item 'chusql-web/static/*' "$stage/static" -Recurse
Copy-Item 'scripts/csql-web.sh' $stage
if (Test-Path 'scripts/csql-web.ps1') { Copy-Item 'scripts/csql-web.ps1' $stage }
New-Item -ItemType Directory -Force -Path dist | Out-Null
Compress-Archive -Path "$stage/*" -DestinationPath "dist/$name.zip" -Force
Remove-Item -Recurse -Force $stage
Get-Item "dist/$name.zip" | Select-Object Name, Length | Format-Table
run: ./scripts/package.ps1 -OutDir dist -Platform '${{ matrix.platform }}' -Version '${{ inputs.tag || github.ref_name }}' -NoBuild
- name: checksum
shell: pwsh
run: |
@@ -229,9 +141,13 @@ jobs:
publish:
name: publish release
needs: build
needs: [build, validate]
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
with:
ref: ${{ inputs.tag || github.ref }}
- uses: actions/download-artifact@v4
with:
path: dist
@@ -244,5 +160,8 @@ jobs:
run: |
set -eu
ls -l dist
gh release view "$TAG" >/dev/null 2>&1 || gh release create "$TAG" --title "ChuSQL $TAG" --generate-notes
notes="docs/release-$TAG.md"
test -f "$notes"
gh release view "$TAG" >/dev/null 2>&1 || gh release create "$TAG" --title "ChuSQL $TAG" --notes-file "$notes" --verify-tag
gh release edit "$TAG" --notes-file "$notes"
gh release upload "$TAG" dist/* --clobber
+17 -2
View File
@@ -76,8 +76,6 @@ resources/chusql.ui.settings.json
*~
\#*\#
.\#*
AGENTS.md
agent-credientials
.dsh
# 注意:.zed/tasks.json 是本仓库共享的构建任务(stack build / run / test / repl),
# 需要入库,所以这里不忽略 .zed/
@@ -95,3 +93,20 @@ plandocs/
Thumbs.db
ehthumbs.db
desktop.ini
learning
# 通用技能和安装状态仅供本机;只跟踪项目专用技能
/.agents/skills/*
!/.agents/skills/chusql-boundary-contracts/
!/.agents/skills/chusql-storage-integrity/
!/.agents/skills/chusql-type-system/
/.agents/context/prompt.txt
/skills-lock.json
# Docker 部署口令仅保存在本机。
/secrets/
/.env
/.env.*
examples
+61
View File
@@ -0,0 +1,61 @@
# 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 历史。
## 文档编写
编写、修改或审阅 README、`docs/` 及其他说明文档时,加载以下全局 Skills:
- `technical-documentation`:先确定读者和阅读目的,再安排标题、操作步骤、示例与参考信息。入口为 `~/.codex/skills/technical-documentation/SKILL.md`。
- `plain-writing`:用常用词解释行为,删除空话,拆开堆叠的术语与长句。入口为 `~/.codex/skills/plain-writing/SKILL.md`。
涉及设计理由时,另用 `documentation-and-adrs`,沿用现有设计文件,不另建决策或进度来源。全局目录以 `$CODEX_HOME/skills` 为准,未设置时使用 `~/.codex/skills`。
文档须遵守以下约定,中文不机械套用英文语法规则:
- 开头说明本页帮助谁完成什么任务。README 先帮助安装和使用,内部实现放在架构文档中,通过链接提供深入阅读。
- 按问题或任务分节,每段只解释一个主题,通常用 2 至 4 句。长段落优先拆分主题,不把整页改成零碎列表。
- 有先后顺序的操作用编号步骤,并说明前提和验证结果;并列要点用列表;参数和能力对比用表格。标题、正文、列表和代码块之间留空行。
- 必要术语首次出现时用一句中文解释,再保留准确名称。同一概念使用同一名称,不连续堆叠缩写、内部类型和函数名。
- 命令和示例标明语言及占位符含义。链接文字说明目标内容,图示须有正文说明,不让关键信息只存在于图中。
- 完稿后按读者顺序通读,核对链接、命令、条件、错误行为和限制。排版与措辞优化不得删掉技术边界,不为简化表达夸大能力;规划与已实现能力分开说明。
## 注释规范
- 文件级:外部引用语句(Haskell `import`、Rust `use`、JS `import`、HTML 的 `<link>`/`<script>`、
CSS `@import`、脚本的依赖/参数区)之后写一段注释,概括本文件的功能;没有引用语句的文件写在
文件开头。长度不超过 3 行、合计不超过 90 字。
- 函数级:每个函数(含 Haskell 的 `where`/`let` 内函数、Rust 的私有 `fn`)前用一行不超过
30 字的注释说明它做什么。
- 摘要说明做什么;仅在必要处补充不直观的不变量、所有权与安全约束,不记录历史和被删实现。
## 协作规则
- 全量门禁入口:`gate-check/run-gate.ps1`(三条车道并行,日志写仓库根的 `logs/`)。
- 局部改动运行受影响模块的规定测试;较大改动由 agent 执行全量门禁,通过后再提交。
- engine / web / storage 使用规定测试入口。
- 规定入口见 `gate-check/run-step.ps1`;Haskell 构建串行,存储协议改动须重建实际动态库。
- 改动说明只在交流中记录。
+66
View File
@@ -0,0 +1,66 @@
# syntax=docker/dockerfile:1
# 分阶段构建存储和四个程序,运行镜像不包含编译器。
ARG DEBIAN_MIRROR=http://mirrors.tencentyun.com
ARG BASE_REGISTRY=docker.io
FROM ${BASE_REGISTRY}/library/rust:1-bookworm@sha256:e12566d5abc17a0da741628782cdb504b68b8961f5bfcf677936bf3e8b32de29 AS storage
ARG CARGO_REGISTRY=sparse+https://rsproxy.cn/index/
ENV CARGO_BUILD_JOBS=1 CARGO_HTTP_TIMEOUT=30
WORKDIR /build/chusql-core/storage
COPY chusql-core/storage/Cargo.toml chusql-core/storage/Cargo.lock ./
COPY chusql-core/storage/src ./src
RUN --mount=type=cache,target=/usr/local/cargo/registry \
cargo --config 'source.crates-io.replace-with="build-mirror"' \
--config "source.build-mirror.registry=\"${CARGO_REGISTRY}\"" \
build --release --locked --jobs 1
FROM ${BASE_REGISTRY}/library/haskell:9.10.3-slim-bookworm@sha256:4f1f62fec9cea4cbb03e885c9ad45642609cadd3897b1e64a7f61d0862b575b1 AS haskell
ARG DEBIAN_MIRROR
RUN sed -i "s|http://deb.debian.org|${DEBIAN_MIRROR}|g" /etc/apt/sources.list.d/debian.sources \
&& apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 update \
&& apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 install -y --no-install-recommends libgmp-dev zlib1g-dev \
&& rm -rf /var/lib/apt/lists/*
ENV LD_LIBRARY_PATH=/build/chusql-core/storage/target/release \
GHCRTS=-M1536m
WORKDIR /build
COPY --from=storage /build/chusql-core/storage/target/release/libchusql_core_storage.so ./chusql-core/storage/target/release/
COPY chusql-core/model ./chusql-core/model
COPY chusql-core/engine ./chusql-core/engine
COPY chusql-interface ./chusql-interface
COPY chusql-bootstrap ./chusql-bootstrap
COPY chusql-server ./chusql-server
COPY chusql-web ./chusql-web
COPY chusql-cli ./chusql-cli
RUN --mount=type=cache,target=/root/.stack \
stack --stack-yaml chusql-cli/stack.yaml --system-ghc --no-install-ghc \
build --fast --jobs 1 --ghc-options=-j1 --copy-bins --local-bin-path /out/bin \
chusql-server:exe:chusql-server chusql-bootstrap:exe:csql-bootstrap \
chusql-web:exe:chusql-web chusql-cli:exe:csql
FROM ${BASE_REGISTRY}/library/debian:bookworm-slim@sha256:7c7b2c966bc9ee8cedfeef67e0e279108992c77681fa595db4a9d65c06ccc587 AS runtime
ARG DEBIAN_MIRROR
RUN sed -i "s|http://deb.debian.org|${DEBIAN_MIRROR}|g" /etc/apt/sources.list.d/debian.sources \
&& apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 update \
&& apt-get -o Acquire::Retries=2 -o Acquire::http::Timeout=30 install -y --no-install-recommends \
ca-certificates libgmp10 libnuma1 libffi8 libtinfo6 zlib1g curl netcat-openbsd \
&& rm -rf /var/lib/apt/lists/* \
&& groupadd --gid 10001 chusql \
&& useradd --uid 10001 --gid chusql --create-home chusql \
&& install -d -o chusql -g chusql /var/lib/chusql /var/log/chusql /opt/chusql/resources
WORKDIR /opt/chusql
COPY --from=haskell /out/bin/ ./bin/
COPY --from=storage /build/chusql-core/storage/target/release/libchusql_core_storage.so ./bin/
COPY chusql-web/static ./static
COPY docker/server.toml docker/web.toml /etc/chusql/
COPY --chmod=755 docker/entrypoint.sh docker/healthcheck.sh /usr/local/bin/
ENV PATH=/opt/chusql/bin:${PATH} \
LD_LIBRARY_PATH=/opt/chusql/bin \
LANG=C.UTF-8 \
CHUSQL_ADMIN_USER=root
USER 10001:10001
EXPOSE 7777 7778
HEALTHCHECK --interval=15s --timeout=5s --start-period=30s --retries=5 \
CMD ["healthcheck.sh", "server"]
ENTRYPOINT ["entrypoint.sh"]
CMD ["server"]
+70 -18
View File
@@ -1,50 +1,102 @@
# ChuSQL
[![Release](docs/badges/release.svg)](https://github.com/TheBadRoger/ChuSQL/releases) [![Commit](docs/badges/commit.svg)](https://github.com/TheBadRoger/ChuSQL/commits/main) ![Haskell + Rust](docs/badges/languages.svg) [![Code lines](docs/badges/lines.svg)](scripts/update-code-lines.ps1)
<p align="center">
<img src="https://img.shields.io/badge/Haskell-5e5086?style=flat-square" alt="Haskell">
<img src="https://img.shields.io/badge/Rust-dea584?style=flat-square" alt="Rust">
<a href="https://github.com/TheBadRoger/ChuSQL/actions/workflows/build.yml"><img src="https://img.shields.io/github/actions/workflow/status/TheBadRoger/ChuSQL/build.yml?branch=main&amp;label=build&amp;style=flat-square" alt="Build"></a>
<a href="https://github.com/TheBadRoger/ChuSQL/actions/workflows/linux.yml"><img src="https://img.shields.io/github/actions/workflow/status/TheBadRoger/ChuSQL/linux.yml?branch=main&amp;label=tests&amp;style=flat-square" alt="Tests"></a>
<a href="https://github.com/TheBadRoger/ChuSQL/releases"><img src="https://img.shields.io/github/v/release/TheBadRoger/ChuSQL?style=flat-square" alt="Release"></a>
<br>
</p>
[![Build](docs/badges/build.svg)](https://github.com/TheBadRoger/ChuSQL/actions/workflows/build.yml) [![Tests](docs/badges/tests.svg)](https://github.com/TheBadRoger/ChuSQL/actions/workflows/linux.yml) [![Gate](docs/badges/gate.svg)](https://github.com/TheBadRoger/ChuSQL/actions/workflows/gate.yml)
ChuSQL 是一个用 Haskell 和 Rust 编写的数据库,提供命令行客户端和 Web 管理界面。本页帮助你安装并启动客户端;SQL 写法和内部设计见文末的文档导航。
ChuSQL 是采用 Haskell SQL 引擎与 Rust 存储层的数据库项目,提供 TCP 服务、CLI 和 Web 管理端。支持查询优化、快照事务、WAL 崩溃恢复、DOMAIN 自定义类型及用户与角色管理。
你可以用 SQL 查询和修改数据、通过事务提交或回滚修改,以及管理用户与角色。数据库还支持自定义类型(DOMAIN),并通过预写日志(WAL)在崩溃后恢复已提交的数据。
项目仓库:[GitHub](https://github.com/TheBadRoger/ChuSQL) · [ChuRepo](https://repo.chunana.cn/ChuNa7a/ChuSQL)。两处均可获取源码,按网络情况选择。
## 快速开始
按操作系统选择安装命令,再启动命令行客户端或 Web 界面。
### 安装
Linux / macOS:
```sh
curl -fsSL https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh | sh -s -- --component web
(curl -fsSL --connect-timeout 10 \
https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.sh -o install.sh ||
curl -fsSL --connect-timeout 10 \
https://repo.chunana.cn/ChuNa7a/ChuSQL/raw/branch/main/scripts/install.sh -o install.sh) &&
sh install.sh --component web
```
Windows(PowerShell 里下下来再跑;也有下载 zip 解压的包内安装):
也可从 ChuRepo 下载后执行:
```sh
curl -fsSL \
https://repo.chunana.cn/ChuNa7a/ChuSQL/raw/branch/main/scripts/install.sh \
-o install.sh
sh install.sh --component web
```
Windows:在 PowerShell 中下载并执行安装脚本。
```powershell
irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1"
try {
irm https://raw.githubusercontent.com/TheBadRoger/ChuSQL/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1" -TimeoutSec 60 -ErrorAction Stop
} catch {
irm https://repo.chunana.cn/ChuNa7a/ChuSQL/raw/branch/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1" -TimeoutSec 60 -ErrorAction Stop
}
& "$env:TEMP\install.ps1" -Component web
```
ChuRepo 下载方式:
```powershell
irm https://repo.chunana.cn/ChuNa7a/ChuSQL/raw/branch/main/scripts/install.ps1 -OutFile "$env:TEMP\install.ps1"
& "$env:TEMP\install.ps1" -Component web
```
首组命令优先从 GitHub 下载脚本,失败后尝试 ChuRepo。安装脚本在查询版本或下载发行包失败时,也会尝试 ChuRepo,并保持已选定的版本。校验失败时直接报错。
两站均无对应发行包时,使用包内安装或源码安装。显式指定其他仓库或归档 URL 时,不会回退到官方仓库。详细步骤见[安装与卸载](docs/install.md)。
### Docker 部署
已提供 Dockerfile 和 Compose 配置,可启动数据库并按需启用 Web。首次运行先创建管理员口令文件,再构建和启动;步骤与资源限制见 [Docker 部署](docs/docker.md)。
博客接入的数据模型、事务、迁移与验收步骤见[博客业务数据库接入](docs/blog-database.md)。
### 启动
已安装 CLI 时,运行以下命令打开命令行界面:
```sh
csql
```
启动CLI界面,或
已安装 Web 组件时,运行以下命令启动 Web 界面:
```sh
csql-web
```
启动web界面,默认通过7778端口访问
启动后,在浏览器中打开 <http://127.0.0.1:7778>。监听地址和端口的修改方法见[配置选项](docs/config.md)。
## 更多参考文档
## 文档导航
- [安装与卸载](docs/install.md)
- [配置选项](docs/config.md)
- [命令与选项](docs/commands.md)
- [SQL 语法](docs/syntax.md)
- [类型与类型目录](docs/types.md)
- [用户、角色与属性](docs/users-and-roles.md)
- [系统引导与恢复](docs/bootstrap.md)
- [架构与组件](docs/architecture.md)
- [性能基准与瓶颈分析](docs/performance.md)
按你要完成的任务选择文档:
| 任务 | 文档 |
| --- | --- |
| 用容器部署和备份 | [Docker 部署](docs/docker.md) |
| 安装、更新或卸载 | [安装与卸载](docs/install.md) |
| 修改端口、路径等设置 | [配置选项](docs/config.md) |
| 查找客户端命令和启动参数 | [命令与选项](docs/commands.md) |
| 编写查询和修改数据 | [SQL 语法](docs/syntax.md) |
| 选择数据类型或定义 DOMAIN | [类型与类型目录](docs/types.md) |
| 管理账号和访问权限 | [用户、角色与属性](docs/users-and-roles.md) |
| 初始化或离线修复数据库 | [系统引导与恢复](docs/bootstrap.md) |
| 理解组件、查询执行和存储机制 | [架构与组件](docs/architecture.md) |
| 查看性能测量及瓶颈 | [性能基准与瓶颈分析](docs/performance.md) |
+54 -24
View File
@@ -2,6 +2,7 @@
module Main where
import ChuSQL.Core.Model (Value (..))
import ChuSQL.Core.Protocol (QueryResult (..), TableInfo (..))
import ChuSQL.Interface.Link (Client, clientPing, closeClient, connectClient)
import ChuSQL.Interface.Session (
@@ -12,12 +13,12 @@ import ChuSQL.Interface.Session (
runStatement,
switchDatabase,
)
import Control.Concurrent (forkIO, forkFinally, threadDelay)
import Control.Concurrent (forkFinally, forkIO, threadDelay)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Control.Exception (IOException, bracket, evaluate, throwIO, try)
import Control.Monad (forM, forM_, replicateM, unless, when)
import Control.Monad (forM_, replicateM, unless, void, when)
import Data.Either (lefts)
import Data.List (intercalate, sort)
import ChuSQL.Core.Model (Value (..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Clock (getMonotonicTime)
@@ -31,8 +32,8 @@ import System.Directory (
import System.Environment (getArgs)
import System.Exit (ExitCode (..), exitFailure)
import System.FilePath ((</>))
import System.IO (BufferMode (LineBuffering), Handle, hGetLine, hSetBuffering, stdout)
import System.Info (os)
import System.IO (Handle, hGetLine)
import System.Process (
CreateProcess (std_err, std_out),
ProcessHandle,
@@ -77,7 +78,7 @@ timedQuery bench sql = do
Left _ -> pure (-1)
Right result -> evaluate (qrRowCount result)
t1 <- getMonotonicTime
pure (t1 - t0, either Left (const (Right n)) r)
pure (t1 - t0, const (Right n) =<< r)
-- | 打印一行结果
report :: String -> Either Text Int -> Double -> IO ()
@@ -107,7 +108,7 @@ batchInsert bench label n mkSql = do
results <- mapM (runSql bench . mkSql) [1 .. n]
t1 <- getMonotonicTime
let total = t1 - t0
errs = [e | Left e <- results]
errs = lefts results
case errs of
[] -> do
printf
@@ -181,13 +182,13 @@ runBatch bench sqls = do
t0 <- getMonotonicTime
results <- mapM (runSql bench) sqls
t1 <- getMonotonicTime
pure (t1 - t0, [e | Left e <- results])
pure (t1 - t0, lefts results)
-- | 把 1..n 按 size 切成一段段
chunked :: Int -> Int -> [[Int]]
chunked size n = go [1 .. n]
where
-- | 递归切分
-- \| 递归切分
go [] = []
go xs = let (a, b) = splitAt size xs in a : go b
@@ -336,7 +337,7 @@ prepareDatabase session = do
Left e -> die ("cannot select the benchmark database: " ++ T.unpack e)
Right () -> pure ()
where
-- | 报错退出
-- \| 报错退出
die message = do
putStrLn message
exitFailure
@@ -385,11 +386,11 @@ portFromBanner line
isInfixOf :: String -> String -> Bool
isInfixOf needle haystack = any (prefix needle) (tails haystack)
where
-- | 前缀匹配
-- \| 前缀匹配
prefix [] _ = True
prefix _ [] = False
prefix (x : xs) (y : ys) = x == y && prefix xs ys
-- | 所有后缀
-- \| 所有后缀
tails [] = [[]]
tails s@(_ : rest) = s : tails rest
@@ -484,6 +485,7 @@ stopProcess process = do
-- | 主入口
main :: IO ()
main = do
hSetBuffering stdout LineBuffering
args <- getArgs
unless (length args <= 2) (ioError (userError "usage: benchmark4csql [users=10000] [orders=50000]"))
let values = take 2 (args ++ drop (length args) ["10000", "50000"])
@@ -496,7 +498,7 @@ main = do
printf "timing : wall clock (monotonic); every statement runs the full chain over TCP\n"
printf "note : the client no longer links the engine or the storage library\n"
bracket
(do
( do
t1 <- getMonotonicTime
bench <- startBench
t2 <- getMonotonicTime
@@ -543,14 +545,14 @@ latencies label rows times = do
let ordered = sort times
count = length times
total = sum times
-- | 按最近秩取分位数
-- \| 按最近秩取分位数
percentile fraction = ordered !! (ceiling (fraction * fromIntegral count) - 1)
printf "CASE %-24s n=%d rows=%d mean_ms=%.3f p50_ms=%.3f p95_ms=%.3f max_ms=%.3f ops_s=%.2f\n" label count rows (total / fromIntegral count) (percentile (0.5 :: Double)) (percentile (0.95 :: Double)) (last ordered) (fromIntegral count * 1000 / total)
-- | 预热后反复测量并校验结果行数
sampleQuery :: Bench -> String -> String -> Int -> IO ()
sampleQuery bench label statement expected = do
-- | 执行一次并校验结果数量
-- \| 执行一次并校验结果数量
let action = do
result <- runSql bench statement
case result of
@@ -588,9 +590,10 @@ pressureScenarios bench u o = do
_ <- runSql bench "CREATE TABLE writes (id int, name str, age int)"
_ <- batchInsert bench "200 individual durable INSERTs" 200 (\i -> printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i)
(milliseconds, ()) <- measure $ do
_ <- runSql bench "BEGIN"
forM_ [201 .. 400 :: Int] $ \i -> runSql bench (printf "INSERT INTO writes (id,name,age) VALUES (%d,'w%d',%d)" i i i) >> pure ()
_ <- runSql bench "COMMIT"
(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
@@ -607,17 +610,44 @@ pressureScenarios bench u o = do
-- | 用多条独立会话同步开始点查
concurrentLookup :: Bench -> Int -> IO ()
concurrentLookup bench workers = do
completions <- forM [1 .. workers] $ \_ -> do
completions <-
replicateM
workers
( do
start <- newEmptyMVar
done <- newEmptyMVar
client <- connectClient "127.0.0.1" (bPort bench) >>= either (ioError . userError . T.unpack) pure
client <-
connectClient "127.0.0.1" (bPort bench)
>>= either (ioError . userError . T.unpack) pure
session <- newSession client
authenticateSession session "admin" "" >>= either (ioError . userError . T.unpack) pure
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)
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
+7 -6
View File
@@ -2,18 +2,19 @@
module Main (main) where
import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
import ChuSQL.Core.Engine.Storage.FFI (maintainStorage)
import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
import ChuSQL.Interface.Auth (hashPassword)
import ChuSQL.Interface.Config (loadWebConfigAt, rootUserName)
import ChuSQL.Interface.TOML (resolveConfigPath)
import Control.Exception (finally)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Control.Exception (finally)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
@@ -45,7 +46,7 @@ emptyOptions =
parseArgs :: [String] -> Either String Options
parseArgs = go emptyOptions
where
-- | 逐条消费参数列表
-- \| 逐条消费参数列表
go opts [] = Right opts
go opts (command : rest)
| command `elem` ["repair", "recover", "recovery", "reset"] = case optMode opts of
@@ -139,7 +140,7 @@ runMaintenance opts mode = do
Left err -> failWith err
Right plain -> do
encoded <- if T.null plain then pure "" else hashPassword plain
let request = A.object ["mode" A..= mode, "user" A..= maybe "root" id (optUser opts), "password_hash" A..= encoded, "types" A..= preinstalledTypes]
let request = A.object ["mode" A..= mode, "user" A..= fromMaybe "root" (optUser opts), "password_hash" A..= encoded, "types" A..= preinstalledTypes]
reply <- maintainStorage path (BL.toStrict (A.encode request))
case reply of
Left err -> failWith err
@@ -156,8 +157,8 @@ readPassword :: Options -> IO (Either String Text)
readPassword opts
| optPasswordless opts = pure (Right "")
| optPasswordStdin opts = do
line <- TIO.getLine
pure (Right (T.dropWhileEnd (\c -> c == '\r' || c == '\n') line))
Right . T.dropWhileEnd (\c -> c == '\r' || c == '\n')
<$> TIO.getLine
| otherwise = pure (Left "pass --password-stdin or --passwordless")
-- | 打印错误并退出 1
+4
View File
@@ -28,6 +28,10 @@ executable csql-bootstrap
, text
default-language: Haskell2010
ghc-options: -Wall
if os(linux)
ld-options: -Wl,-rpath,$ORIGIN
if os(osx)
ld-options: -Wl,-rpath,@loader_path
test-suite chusql-bootstrap-test
type: exitcode-stdio-1.0
+30 -16
View File
@@ -14,20 +14,33 @@ import qualified Data.Text as T
-- | 现有内置类型及其默认参数
preinstalledTypes :: [A.Value]
preinstalledTypes = map definition
[ ("int", CInt, False), ("integer", CInt, False)
, ("bigint", CBigInt, False), ("smallint", CSmallInt, False)
, ("varchar", CStr, True), ("char", CChar 1, True)
, ("text", CStr, False), ("str", CStr, False)
, ("boolean", CBool, False), ("bool", CBool, False)
, ("float", CFloat, False), ("real", CFloat, False), ("double", CDouble, False)
, ("decimal", CDecimal 10 0, True), ("numeric", CDecimal 10 0, True)
, ("date", CDate, False), ("timestamp", CTimestamp, False), ("blob", CBlob, False)
preinstalledTypes =
map
definition
[ ("int", CInt, False)
, ("integer", CInt, False)
, ("bigint", CBigInt, False)
, ("smallint", CSmallInt, False)
, ("varchar", CStr, True)
, ("char", CChar 1, True)
, ("text", CStr, False)
, ("str", CStr, False)
, ("boolean", CBool, False)
, ("bool", CBool, False)
, ("float", CFloat, False)
, ("real", CFloat, False)
, ("double", CDouble, False)
, ("decimal", CDecimal 10 0, True)
, ("numeric", CDecimal 10 0, True)
, ("date", CDate, False)
, ("timestamp", CTimestamp, False)
, ("blob", CBlob, False)
]
where
-- | 编码类型的名称与基础表示
-- \| 编码类型的名称与基础表示
definition :: (Text, ColumnType, Bool) -> A.Value
definition (name, base, parameterized) = A.object
definition (name, base, parameterized) =
A.object
["name" A..= name, "base_type" A..= typeName base, "parameterized" A..= parameterized]
-- | 依次引导身份、迁移目录并预装类型
@@ -44,11 +57,11 @@ runBootstrap send name encoded = do
installed <- send (A.object ["method" A..= ("bootstrap_types" :: Text), "types" A..= preinstalledTypes])
pure (expect "rows" installed >>= installedTypes)
where
-- | 确认系统目录已初始化
-- \| 确认系统目录已初始化
initializedCatalog fields
| KM.lookup "initialized" fields == Just (A.Bool True) = Right ()
| otherwise = Left "system catalog is not initialized"
-- | 确认所选引导身份可以管理系统
-- \| 确认所选引导身份可以管理系统
administrator fields = case KM.lookup "accounts" fields of
Nothing -> Left "missing identity directory"
Just value -> case A.fromJSON value :: A.Result [Account] of
@@ -56,14 +69,15 @@ runBootstrap send name encoded = do
A.Success accounts
| any (\a -> accountUser a == T.toLower name && accountCanLogin a && accountEnabled a && accountIsSuperuser a) accounts -> Right ()
| otherwise -> Left "bootstrap identity is not an enabled login superuser; existing identities were preserved"
-- | 确认全部预装类型存在且定义一致
-- \| 确认全部预装类型存在且定义一致
installedTypes fields = case KM.lookup "rows" fields of
Just (A.Array rows)
| all (\definition -> any (matches definition) (toList rows)) preinstalledTypes -> Right (length rows)
| otherwise -> Left "preinstalled type verification failed"
_ -> Left "missing preinstalled type directory"
-- | 比对类型定义并检查持久化编号
matches (A.Object definition) (A.Object saved) = all (\(key, value) -> KM.lookup key saved == Just value) (KM.toList definition)
-- \| 比对类型定义并检查持久化编号
matches (A.Object definition) (A.Object saved) =
all (\(key, value) -> KM.lookup key saved == Just value) (KM.toList definition)
&& case KM.lookup "id" saved of Just (A.Number n) -> n > 0; _ -> False
matches _ _ = False
+12 -10
View File
@@ -3,16 +3,17 @@
module Main (main) where
import ChuSQL.Bootstrap (preinstalledTypes, runBootstrap)
import ChuSQL.Core.Protocol (Account (..))
import ChuSQL.Core.Model (columnType, typeName)
import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
import ChuSQL.Core.Engine.Syntax.AST (Statement (CreateTable))
import ChuSQL.Core.Engine.Syntax.Parser (parseStatement)
import ChuSQL.Core.Engine.Storage.IPC (closeConnection, localStorageLink, sendRawRequest, setStorageLink)
import ChuSQL.Core.Model (columnType, typeName)
import ChuSQL.Core.Protocol (Account (..))
import Control.Exception (finally)
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, modifyIORef')
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Unique (hashUnique, newUnique)
@@ -32,7 +33,8 @@ main = hspec $ do
runBootstrap send "root" "new-hash" `shouldReturn` Right 18
calls <- requests
map (field "method") calls `shouldBe` map A.String ["bootstrap_system", "identity_initialize", "bootstrap_types"]
mapM_ (\(title, replies, err) -> it title (expectBootstrapFailure replies err))
mapM_
(\(title, replies, err) -> it title (expectBootstrapFailure replies err))
[ ("stops on storage errors", [Left "storage unavailable"], "storage unavailable")
, ("rejects an uninitialized system response", [Right (A.object ["status" A..= ("system" :: Text), "initialized" A..= False])], "system catalog is not initialized")
, ("preserves a demoted identity and stops before type installation", [Right ready, Right (identity False)], "bootstrap identity is not an enabled login superuser; existing identities were preserved")
@@ -81,19 +83,19 @@ ready = A.object ["status" A..= ("system" :: Text), "initialized" A..= True]
-- | 带最高权限属性的身份响应
identity :: Bool -> A.Value
identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [Account 1 "root" "existing-hash" 1 "" Nothing True super True False]]
identity super = A.object ["status" A..= ("accounts" :: Text), "accounts" A..= [Account 1 "root" "existing-hash" 1 "" Nothing True super True False False]]
-- | 已写入编号的类型响应
installed :: A.Value
installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= map numbered (zip [1 :: Int ..] preinstalledTypes)]
installed = A.object ["status" A..= ("rows" :: Text), "rows" A..= zipWith (curry numbered) [1 :: Int ..] preinstalledTypes]
where
-- | 给预装定义添加持久化编号
-- \| 给预装定义添加持久化编号
numbered (n, A.Object fields) = A.Object (KM.insert "id" (A.toJSON n) fields)
numbered (_, value) = value
-- | 读取响应中的一个字段
field :: A.Key -> A.Value -> A.Value
field key (A.Object fields) = maybe A.Null id (KM.lookup key fields)
field key (A.Object fields) = fromMaybe A.Null (KM.lookup key fields)
field _ _ = A.Null
-- | 记录请求并返回指定响应
@@ -102,7 +104,7 @@ mock replies = do
calls <- newIORef []
queuedReplies <- newIORef replies
let
-- | 消费一条模拟响应
-- \| 消费一条模拟响应
send request = do
modifyIORef' calls (++ [request])
remaining <- readIORef queuedReplies
+45 -13
View File
@@ -3,21 +3,24 @@
module Main (main) where
import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
import ChuSQL.CLI.Normalization (runNormalizationOnce)
import ChuSQL.CLI.Password (readPasswordInput)
import ChuSQL.CLI.Script (stripTerminator)
import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
import ChuSQL.Interface.Link (Client, closeClient, connectClient)
import ChuSQL.Interface.Session (
Session,
authenticateSession,
authenticateSudoSession,
isPlainIdentifier,
newSession,
switchDatabase,
)
import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
import ChuSQL.Interface.Link (Client, closeClient, connectClient)
import ChuSQL.Interface.Sudo (SudoCredential, readSudoCredential)
import ChuSQL.Interface.TOML (resolveConfigPath)
import Control.Exception (finally)
import Control.Monad (unless)
import Data.IORef (newIORef)
import Control.Monad (unless, when)
import Data.IORef (IORef, newIORef)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -38,6 +41,9 @@ data Options = Options
, optExecute :: Maybe Text
, optHistory :: Maybe FilePath
, optConfig :: Maybe FilePath
, optNormalize :: Maybe Text
, optDeclaration :: Maybe FilePath
, optSudo :: Bool
}
-- | 命令行参数解析器
@@ -61,15 +67,19 @@ optionsParser =
<> metavar "FORMAT"
<> value FormatTable
<> showDefaultWith (T.unpack . formatName)
<> help "Output format: table, json or csv"
<> help "Output format: table (or text), json or csv"
)
<*> optional (T.pack <$> strOption (long "execute" <> short 'e' <> metavar "SQL" <> help "Run one statement and exit"))
<*> optional (strOption (long "history" <> metavar "FILE" <> help "SQL history file (default ~/.chusql_history)"))
<*> optional (strOption (long "config" <> metavar "FILE" <> help "Config file to read (default: the fixed settings.toml under the system config directory)"))
<*> optional (T.pack <$> strOption (long "normalize" <> metavar "TABLE" <> help "Analyze normalization using explicit declarations"))
<*> optional (strOption (long "declaration" <> metavar "FILE" <> help "UTF-8 JSON normalization declaration"))
<*> switch (long "sudo" <> help "Authenticate using the local root or elevated administrator identity")
-- | 把 --format 的取值解析成格式
formatReader :: String -> Either String OutputFormat
formatReader raw = maybe (Left "format must be table, json or csv") Right (parseFormat (T.pack raw))
formatReader "text" = Right FormatTable
formatReader raw = maybe (Left "format must be table, text, json or csv") Right (parseFormat (T.pack raw))
-- | 命令行界面与帮助
parserInfo :: ParserInfo Options
@@ -87,24 +97,40 @@ main = do
hSetEncoding stdout utf8
hSetEncoding stderr utf8
options <- execParser parserInfo
case (optNormalize options, optDeclaration options, optExecute options, optFormat options) of
(Nothing, Nothing, _, _) -> pure ()
(Just _, Just _, Nothing, format) | format /= FormatCsv -> pure ()
_ -> reportError "--normalize requires --declaration, text/json format and cannot be combined with --execute" >> exitFailure
configPath <- resolveConfigPath (optConfig options)
base <- loadWebConfigAt configPath
config <- loadServerConfigAt configPath
let rootName = rootUserName base
userName = fromMaybe rootName (optUser options)
password <- promptPassword userName
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
connect options client userName password credential
`finally` closeClient client
-- | 连 server、登录,之后转入会话
connect :: Options -> Client -> Text -> Text -> IO ()
connect options client userName password = do
connect :: Options -> Client -> Text -> Text -> Maybe SudoCredential -> IO ()
connect options client userName password credential = do
session <- newSession client
signedIn <- authenticateSession session userName password
signedIn <- case credential of
Just proof -> authenticateSudoSession session proof userName
Nothing -> authenticateSession session userName password
case signedIn of
Left message -> reportError message >> exitFailure
Right () -> runSession options session
@@ -116,7 +142,13 @@ runSession options session = do
ready <- selectDatabase session (T.strip (optDatabase options))
if not ready
then exitFailure
else case optExecute options of
else case (optNormalize options, optDeclaration options) of
(Just table, Just file) -> runNormalizationOnce session table file (optFormat options == FormatJson) >>= \ok -> unless ok exitFailure
_ -> runSqlSession options session formatRef
-- 执行 SQL 或进入交互循环。
runSqlSession :: Options -> Session -> IORef OutputFormat -> IO ()
runSqlSession options session formatRef = case optExecute options of
Just sql -> do
ok <- runStatementOnce session (optFormat options) (stripTerminator sql)
unless ok exitFailure
+18 -16
View File
@@ -1,18 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
module Repl
( runRepl
, runStatementOnce
, reportError
) where
module Repl (
runRepl,
runStatementOnce,
reportError,
) where
import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
import ChuSQL.CLI.History (historySettings, rememberStatement)
import ChuSQL.CLI.Normalization (runNormalizationOnce)
import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
import Control.Monad (forM_, when)
import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
import Control.Monad (forM_, unless, when)
import Control.Monad.IO.Class (liftIO)
import Data.IORef (IORef, readIORef, writeIORef)
import Data.Text (Text)
@@ -83,7 +84,7 @@ drain :: Session -> IORef OutputFormat -> Text -> InputT IO Text
drain session formatRef buffer = case takeStatement buffer of
Nothing -> pure (T.strip buffer)
Just (statement, rest) -> do
when (not (T.null statement)) $ do
unless (T.null statement) $ do
rememberStatement (statement <> ";")
runOne session formatRef statement
drain session formatRef rest
@@ -106,6 +107,7 @@ runMeta session formatRef meta = case meta of
MetaDatabases -> listDatabases session >> pure True
MetaTables -> listTables session >> pure True
MetaDescribe name -> describeTable session name >> pure True
MetaNormalize table file jsonOutput -> liftIO (runNormalizationOnce session table file jsonOutput) >> pure True
MetaRoles -> listRoles session >> pure True
MetaConnect name -> do
switched <- liftIO (switchDatabase session name)
@@ -136,7 +138,7 @@ listTables session = do
Right tables -> outputStrLn (T.unpack (renderRows headers (map tableRow tables)))
where
headers = ["table", "columns", "rows", "indexes"]
-- | 把表信息排成一行
-- \| 把表信息排成一行
tableRow info =
[ T.pack (tiTable info)
, tshow (length (tiColumns info))
@@ -156,9 +158,9 @@ describeTable session name = do
(info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
where
headers = ["column", "type", "primary", "unique", "nullable", "auto"]
-- | 表名忽略大小写比较
-- \| 表名忽略大小写比较
matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
-- | 把列信息排成一行
-- \| 把列信息排成一行
columnRow column =
[ T.pack (scName column)
, T.pack (scType column)
@@ -167,7 +169,7 @@ describeTable session name = do
, yesNo (scNullable column)
, yesNo (scAutoIncrement column)
]
-- | 布尔值转成 yes/no
-- \| 布尔值转成 yes/no
yesNo True = "yes"
yesNo False = "no"
@@ -179,17 +181,17 @@ listRoles session = do
Left message -> liftIO (reportError message)
Right roles -> outputStrLn (T.unpack (renderRows ["role", "grants", "members"] (map roleRow roles)))
where
-- | 把角色信息排成一行
-- \| 把角色信息排成一行
roleRow view =
[ roleName view
, if null (roleGrants view) then "-" else T.intercalate ", " (map grantText (roleGrants view))
, if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view)
]
-- | 拼一条授权说明
-- \| 拼一条授权说明
grantText grant = grantPrivilege grant <> " on " <> grantObject grant <> optionText grant
-- | 带转授权时补一段说明
-- \| 带转授权时补一段说明
optionText grant = if grantable grant then " with grant option" else ""
-- | 用 show 转成 Text
tshow :: Show a => a -> Text
tshow :: (Show a) => a -> Text
tshow = T.pack . show
+2
View File
@@ -12,6 +12,7 @@ build-type: Simple
library
hs-source-dirs: src
exposed-modules: ChuSQL.CLI.Format
ChuSQL.CLI.Normalization
ChuSQL.CLI.History
ChuSQL.CLI.Password
ChuSQL.CLI.Script
@@ -55,6 +56,7 @@ test-suite chusql-cli-test
, directory
, aeson
, bytestring
, chusql-interface
, chusql-cli
, chusql-core-model
, hspec
+17 -15
View File
@@ -1,19 +1,20 @@
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.CLI.Format
( OutputFormat (..)
, parseFormat
, formatName
, renderResult
, renderTable
, renderRows
, renderCsv
, renderJson
, displayValue
) where
module ChuSQL.CLI.Format (
OutputFormat (..),
parseFormat,
formatName,
renderResult,
renderTable,
renderRows,
renderCsv,
renderJson,
displayValue,
) where
import ChuSQL.Core.Model (Value (..))
import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
import ChuSQL.Core.Runtime (renderRuntimeValue)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BL
import Data.Text (Text)
@@ -54,7 +55,7 @@ renderCsv :: QueryResult -> Text
renderCsv result = T.unlines (header : map rowLine (qrRows result))
where
header = T.intercalate "," (map csvField (qrColumns result))
-- | 拼一行 CSV
-- \| 拼一行 CSV
rowLine row = T.intercalate "," (map (csvField . csvCell) row)
-- | CSV 里的空值就是空字段
@@ -79,13 +80,13 @@ renderRows :: [Text] -> [[Text]] -> Text
renderRows columns rawRows = T.unlines (border : headerLine : border : body ++ [border, summary])
where
widths = [columnWidth index | index <- [0 .. length columns - 1]]
-- | 一列的显示宽度,有上限
-- \| 一列的显示宽度,有上限
columnWidth index =
min maxColumnWidth (maximum (T.length (columns !! index) : [T.length (cellAt row index) | row <- rawRows]))
maxColumnWidth = 64
-- | 取某行某列,缺的当空
-- \| 取某行某列,缺的当空
cellAt row index = if index < length row then row !! index else ""
-- | 拼一行带竖线的表行
-- \| 拼一行带竖线的表行
cellLine cells = "| " <> T.intercalate " | " (zipWith pad widths (cells ++ repeat "")) <> " |"
headerLine = cellLine columns
body = map cellLine rawRows
@@ -109,3 +110,4 @@ displayValue (VFloat d) = T.pack (show d)
displayValue (VStr s) = T.pack s
displayValue (VBool True) = "true"
displayValue (VBool False) = "false"
displayValue (VRuntime _ value) = T.pack (renderRuntimeValue value)
+5 -4
View File
@@ -11,11 +11,12 @@ import System.Console.Haskeline.History (addHistory)
-- 关闭逐行历史,筛选完整语句后记录安全输入。
-- | 配置仅手动追加的输入历史
historySettings :: MonadIO m => Maybe FilePath -> Settings m
historySettings path = defaultSettings {historyFile = path, autoAddHistory = False}
historySettings :: (MonadIO m) => Maybe FilePath -> Settings m
historySettings path = defaultSettings{historyFile = path, autoAddHistory = False}
-- | 排除含口令标记的完整语句
rememberStatement :: MonadIO m => T.Text -> InputT m ()
rememberStatement :: (MonadIO m) => T.Text -> InputT m ()
rememberStatement statement =
unless (T.null (T.strip statement) || any (`T.isInfixOf` T.toCaseFold statement) ["password", "identified"])
unless
(T.null (T.strip statement) || any (`T.isInfixOf` T.toCaseFold statement) ["password", "identified"])
(modifyHistory (addHistory (T.unpack statement)))
@@ -0,0 +1,76 @@
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.CLI.Normalization (normalizationArguments, loadNormalizationDeclaration, renderNormalization, runNormalizationOnce) where
import ChuSQL.Interface.Normalization
import ChuSQL.Interface.Session (Session, analyzeNormalization, sessionDatabase)
import Control.Exception (IOException, try)
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as K
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
+20 -14
View File
@@ -1,17 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.CLI.Script
( Meta (..)
, parseMeta
, takeStatement
, statementComplete
, stripTerminator
, errorHint
, metaHelp
) where
module ChuSQL.CLI.Script (
Meta (..),
parseMeta,
takeStatement,
statementComplete,
stripTerminator,
errorHint,
metaHelp,
) where
import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
import ChuSQL.CLI.Normalization (normalizationArguments)
import Data.Char (isSpace)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
@@ -23,6 +25,7 @@ data Meta
| MetaDatabases
| MetaTables
| MetaDescribe Text
| MetaNormalize Text FilePath Bool
| MetaRoles
| MetaConnect Text
| MetaSetFormat OutputFormat
@@ -46,10 +49,12 @@ parseMeta raw = do
"list" -> MetaDatabases
"dt" -> MetaTables
"tables" -> MetaTables
"d" | T.null argument -> MetaTables
"d"
| T.null argument -> MetaTables
| otherwise -> MetaDescribe argument
"dr" -> MetaRoles
"roles" -> MetaRoles
"normalize" -> either (const (MetaUnknown "normalize")) (\(table, file, jsonOutput) -> MetaNormalize table file jsonOutput) (normalizationArguments argument)
"c" -> connectTo argument
"connect" -> connectTo argument
"use" -> connectTo argument
@@ -57,18 +62,18 @@ parseMeta raw = do
"format" -> selectFormat argument
other -> MetaUnknown other
where
-- | 拼出切库命令
-- \| 拼出切库命令
connectTo argument
| T.null argument = MetaUnknown "c"
| otherwise = MetaConnect argument
-- | 解析格式参数
-- \| 解析格式参数
selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
-- | 取出第一条语句,忽略引号与注释里的分号
takeStatement :: Text -> Maybe (Text, Text)
takeStatement = go ScanNormal [] . T.unpack
where
-- | 逐字符扫描语句边界
-- \| 逐字符扫描语句边界
go _ _ [] = Nothing
go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest
@@ -87,7 +92,7 @@ data ScanState = ScanNormal | ScanString | ScanLineComment | ScanBlockComment
-- | 攒下来的内容里有没有一条以分号结束的语句
statementComplete :: Text -> Bool
statementComplete = maybe False (const True) . takeStatement
statementComplete = isJust . takeStatement
-- | 去掉结尾的空白与分号(-e 直接执行时用)
stripTerminator :: Text -> Text
@@ -118,6 +123,7 @@ metaHelp =
, " \\l, \\list list databases"
, " \\dt, \\d list tables"
, " \\d <table> describe a table"
, " \\normalize TABLE --declaration FILE [--format text|json]"
, " \\dr, \\roles list roles with their grants and members"
, " \\c <database> switch database"
, " \\f, \\format <fmt> output format: " <> T.intercalate ", " (map formatName [FormatTable, FormatJson, FormatCsv])
+59 -18
View File
@@ -2,24 +2,27 @@
module Main (main) where
import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable)
import ChuSQL.CLI.Format (OutputFormat (..), displayValue, parseFormat, renderCsv, renderJson, renderTable)
import ChuSQL.CLI.History (historySettings, rememberStatement)
import ChuSQL.CLI.Normalization
import ChuSQL.CLI.Password (readPasswordInput)
import ChuSQL.CLI.Script (Meta (..), errorHint, parseMeta, statementComplete, stripTerminator, takeStatement)
import ChuSQL.Core.Model (Value (..))
import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
import ChuSQL.Core.Runtime
import ChuSQL.Interface.Normalization
import Control.Exception (bracket, finally)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (decode)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Control.Exception (bracket, finally)
import Control.Monad.IO.Class (liftIO)
import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
import System.Console.Haskeline.History (historyLines)
import System.Directory (getTemporaryDirectory, removeFile)
import System.IO (Handle, SeekMode (AbsoluteSeek), hClose, hPutStr, hSeek, hSetNewlineMode, noNewlineTranslation, openTempFile)
import Test.Hspec
import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
import System.Console.Haskeline.History (historyLines)
-- chusql-cli 测试:输出格式、语句缓冲、元命令与口令输入。
@@ -30,6 +33,11 @@ main = hspec spec
-- | 全部测试用例
spec :: Spec
spec = do
normalizationSpec
it "renders typed compound values without losing their wire identity" $ do
case resolveType builtinTypes (listType intType) of
Left err -> expectationFailure err
Right descriptor -> displayValue (VRuntime (descriptorId descriptor) (RList [RInt 1, RInt 2])) `shouldBe` "[1, 2]"
formatSpec
scriptSpec
passwordSpec
@@ -39,12 +47,15 @@ spec = do
historySpec :: Spec
historySpec = describe "CLI: SQL history" $ do
it "does not automatically record unfinished input lines" $
withPasswordInput "CREATE USER alice IDENTIFIED BY\n'secret'\n" (\handle -> do
withPasswordInput
"CREATE USER alice IDENTIFIED BY\n'secret'\n"
( \handle -> do
entries <- runInputTBehavior (useFileHandle handle) (historySettings Nothing) $ do
getInputLine "" >>= liftExpectation "CREATE USER alice IDENTIFIED BY"
getInputLine "" >>= liftExpectation "'secret'"
historyLines <$> getHistory
entries `shouldBe` [])
entries `shouldBe` []
)
it "keeps ordinary statements and excludes multiline or mixed-case passwords" $ do
entries <- runInputT (historySettings Nothing) $ do
rememberStatement "SELECT 1;"
@@ -58,18 +69,20 @@ historySpec = describe "CLI: SQL history" $ do
entries `shouldBe` ["SELECT 1;"]
it "persists only safe statements from a batch" $ do
directory <- getTemporaryDirectory
bracket (openTempFile directory "csql-history-test")
bracket
(openTempFile directory "csql-history-test")
(\(path, _) -> removeFile path)
(\(path, handle) -> do
( \(path, handle) -> do
hClose handle
runInputT (historySettings (Just path)) $
rememberBatch "SELECT 1; CREATE USER alice IDENTIFIED BY 'secret'; SELECT 2;"
entries <- runInputT (historySettings (Just path)) (historyLines <$> getHistory)
entries `shouldBe` ["SELECT 2;", "SELECT 1;"])
entries `shouldBe` ["SELECT 2;", "SELECT 1;"]
)
where
-- | 核对实际读取的输入行
-- \| 核对实际读取的输入行
liftExpectation expected actual = liftIO (actual `shouldBe` Just expected)
-- | 按完整语句筛选批量输入
-- \| 按完整语句筛选批量输入
rememberBatch input = case takeStatement input of
Nothing -> pure ()
Just (statement, rest) -> do
@@ -80,27 +93,33 @@ historySpec = describe "CLI: SQL history" $ do
withPasswordInput :: String -> (Handle -> IO a) -> IO a
withPasswordInput input action = do
directory <- getTemporaryDirectory
bracket (openTempFile directory "csql-password-test")
bracket
(openTempFile directory "csql-password-test")
(\(path, handle) -> hClose handle `finally` removeFile path)
(\(_, handle) -> do
( \(_, handle) -> do
hSetNewlineMode handle noNewlineTranslation
hPutStr handle input
hSeek handle AbsoluteSeek 0
action handle)
action handle
)
-- | 管道口令的行尾与内容用例
passwordSpec :: Spec
passwordSpec = describe "CLI: password input" $ do
it "reads LF, CRLF and unterminated passwords identically" $ do
mapM_ (\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
mapM_
(\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
["secret\n", "secret\r\n", "secret"]
it "preserves password spaces and internal carriage returns" $
withPasswordInput " a\rb \r\n" (\handle -> readPasswordInput handle `shouldReturn` " a\rb ")
it "accepts an empty password and consumes only one line" $
withPasswordInput "\r\nsecond\n" (\handle -> do
withPasswordInput
"\r\nsecond\n"
( \handle -> do
readPasswordInput handle `shouldReturn` ""
readPasswordInput handle `shouldReturn` "second"
readPasswordInput handle `shouldReturn` "")
readPasswordInput handle `shouldReturn` ""
)
-- | 输出格式的用例
formatSpec :: Spec
@@ -183,3 +202,25 @@ sampleResult =
, qrTruncated = False
, qrDatabase = Nothing
}
-- 范式元命令、严格文件与显示格式回归。
normalizationSpec :: Spec
normalizationSpec = describe "CLI: normalization" $ do
it "parses quoted paths without interpreting Windows backslashes" $ do
normalizationArguments "users --declaration \"C:\\My Data\\fd.json\" --format json" `shouldBe` Right ("users", "C:\\My Data\\fd.json", True)
parseMeta "\\normalize users --declaration deps.json --format text" `shouldBe` Just (MetaNormalize "users" "deps.json" False)
normalizationArguments "users --declaration deps.json --format csv" `shouldSatisfy` either (const True) (const False)
it "keeps the same report fields in text and JSON output" $ do
let report = A.object ["candidate_keys" A..= ([["id"]] :: [[T.Text]]), "conditional" A..= True, "findings" A..= [A.object ["normal_form" A..= ("bcnf" :: T.Text), "verdict" A..= ("insufficient" :: T.Text)]]]
A.eitherDecodeStrict (encodeUtf8 (renderNormalization True report)) `shouldBe` Right report
renderNormalization False report `shouldSatisfy` T.isInfixOf "candidate_keys"
renderNormalization False report `shouldSatisfy` T.isInfixOf "insufficient"
it "loads defaults and refuses duplicate JSON fields in declaration files" $ do
directory <- getTemporaryDirectory
bracket (openTempFile directory "normalization-declaration") (\(path, _) -> removeFile path) $ \(path, handle) -> do
hPutStr handle "{}"
hClose handle
loadNormalizationDeclaration path `shouldReturn` Right (NormalizationDeclaration [] [] False Nothing)
BL.writeFile path "{\"atomic_attributes\":true,\"atomic_attributes\":false}"
result <- loadNormalizationDeclaration path
result `shouldSatisfy` either (T.isInfixOf "duplicate") (const False)
+17 -1
View File
@@ -10,7 +10,8 @@ build-type: Simple
library
hs-source-dirs: src
exposed-modules: ChuSQL.Core.Engine.Algebra.Cost
exposed-modules: ChuSQL.Core.Engine.Domain
ChuSQL.Core.Engine.Algebra.Cost
ChuSQL.Core.Engine.Algebra.Eval
ChuSQL.Core.Engine.Algebra.Expr
ChuSQL.Core.Engine.Algebra.JoinOrder
@@ -22,6 +23,14 @@ library
ChuSQL.Core.Engine.Error
ChuSQL.Core.Engine
ChuSQL.Core.Engine.Parallel
ChuSQL.Core.Engine.Normalization
ChuSQL.Core.Engine.Runtime.Types
ChuSQL.Core.Engine.Runtime.Functions
ChuSQL.Core.Engine.Runtime.Binding
ChuSQL.Core.Engine.Runtime.SQL
ChuSQL.Core.Engine.Runtime.Query
ChuSQL.Core.Engine.Runtime.Relation
ChuSQL.Core.Engine.Runtime.Dependencies
ChuSQL.Core.Engine.Semantic
ChuSQL.Core.Engine.Storage
ChuSQL.Core.Engine.Storage.FFI
@@ -38,7 +47,9 @@ library
, parser-combinators
, scientific
, text
, transformers
, unordered-containers
, vector
extra-libraries: chusql_core_storage
-- 运行期找 libchusql_core_storage.so:$ORIGIN 让二进制与动态库同目录即可
if os(linux)
@@ -46,11 +57,14 @@ library
if os(osx)
ld-options: -Wl,-rpath,@loader_path
default-language: Haskell2010
default-extensions: ImportQualifiedPost
ghc-options: -Wall
test-suite chusql-core-engine-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules: NormalizationSpec
RuntimeSpec
hs-source-dirs: test
build-depends: base
, chusql-core-engine
@@ -59,5 +73,7 @@ test-suite chusql-core-engine-test
, filepath
, hashable
, hspec
, bytestring
, aeson
default-language: Haskell2010
ghc-options: -Wall -threaded
+327 -157
View File
@@ -1,17 +1,20 @@
module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf) where
module ChuSQL.Core.Engine (runStatement, runStatementM, rowsOf, BoundWrite, bindWrite, executeWriteM, validateTableRows) where
import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM, evalRelOpM)
import ChuSQL.Core.Engine.Algebra.Eval (evalCondForRowM, evalExprM)
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr)
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
import ChuSQL.Core.Engine.Algebra.Planner (translate)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Semantic (prepare)
import ChuSQL.Core.Engine.Domain
import ChuSQL.Core.Engine.Runtime.Dependencies (domainDependencies, queryTables, typeDependencies, validateDependencies)
import ChuSQL.Core.Engine.Runtime.Query (bindQuery, executeQueryM)
import ChuSQL.Core.Engine.Runtime.Relation (bindWriteColumns, orderRow)
import ChuSQL.Core.Engine.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.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.Maybe (mapMaybe)
import qualified Data.HashSet as HS
-- 引擎入口:检查语义、按语句分发执行,另有内存实现与泛型版本。
@@ -33,81 +36,177 @@ runStatementM (DropDatabase name) = fmap (fmap (const [])) (dropDatabase name)
runStatementM (UseDatabase name) = fmap (fmap (const [])) (useDatabase name)
runStatementM ShowDatabases = fmap (fmap (map (\name -> [("database", VStr name)]))) listDatabases
runStatementM q = do
db <- schema
case prepare db q of
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
-- | 按语句类型分发(已检查过)
runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
runStatementUncheckedM db q@Select{} =
case translate q of
Left e -> pure (Left e)
Right relOp -> evalRelOpM db (optimize db relOp)
runStatementUncheckedM db q@SelectExpr{} =
case translate q of
Left e -> pure (Left e)
Right relOp -> evalRelOpM db (optimize db relOp)
runStatementUncheckedM db (Insert tbl cols rows) =
case lookupTable db tbl of
Left e -> pure (Left e)
Right table -> do
current <- existingRows tbl table
case current >>= \current' -> buildRows table current' cols rows of
| otherwise -> case bindWrite db q of
Left err -> pure (Left err)
Right rs -> do
result <- insertMany tbl rs
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
declared <- lookupTable catalog target
columnsEffective <- effectiveColumns catalog (tableCols declared)
let table = declared{tableCols = columnsEffective}
checks <- checkPlan catalog table
let plan =
InsertPlan
(bindInsertTargets (tableCols table) columns)
(length columns)
(autoColumn table)
checks
(constraintPlan (tableCols table))
Right (InsertAction target plan rows)
Update target assignments condition -> do
declared <- lookupTable catalog target
columnsEffective <- effectiveColumns catalog (tableCols declared)
let table = declared{tableCols = columnsEffective}
bound <- bindUpdateTargets (tableCols table) assignments
checks <- checkPlan catalog table
let plan = UpdatePlan (map fst (tableCols table)) bound condition checks (constraintPlan (tableCols table))
Right (UpdateAction target plan)
Delete target condition -> do
table <- lookupTable catalog target
Right (DeleteAction target (map fst (tableCols table)) condition)
_ -> Right (StructureAction statement)
-- | 直接执行已绑定的数据修改或结构动作
executeWriteActionM :: (MonadStorage m) => Database -> WriteAction -> m (Either String [Row])
executeWriteActionM _ (InsertAction target plan rows) = do
current <- existingRows target plan
case current >>= \current' -> buildRows plan current' rows of
Left err -> pure (Left err)
Right built -> do
result <- insertMany target built
pure (result >> Right [])
runStatementUncheckedM db (Delete tbl mWhere) = do
rowsResult <- scan tbl
case rowsResult of
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
split <- splitByConditionM db mWhere rows
updated <- mapM (updateRowM catalog checks condition assignments) rows
case sequence updated >>= \newRows -> enforceConstraints constraints [] newRows >> Right newRows of
Left err -> pure (Left err)
Right newRows -> do
result <- replaceAll target newRows
pure (result >> Right [])
executeWriteActionM catalog (DeleteAction target columns condition) = do
current <- scan target
case current >>= mapM (orderRow columns) of
Left err -> pure (Left err)
Right rows -> do
split <- splitByConditionM catalog condition rows
case split of
Left err -> pure (Left err)
Right (doomed, kept) ->
case mapM rowId doomed of
Right (doomed, kept) -> case mapM rowId doomed of
Right ids -> do
result <- deleteKeys tbl ids
result <- deleteKeys target ids
pure (result >> Right [])
Left _ -> do
result <- replaceAll tbl kept
result <- replaceAll target kept
pure (result >> Right [])
where
-- | 取行里的整数 id,取不到就报错
rowId :: Row -> Either String Int
rowId r = case lookup "id" r of
Just (VInt k) -> Right k
-- \| 取整数主键,否则使用原有整表删除路径
rowId row = case lookup "id" row of
Just (VInt key) -> Right key
_ -> Left "row has no integer id"
runStatementUncheckedM db (Update tbl assigns mWhere) =
case lookupTable db tbl of
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 table -> do
rowsResult <- scan tbl
case rowsResult of
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 db (CreateTable name cols) = case validateDomainDefaults db cols of
Left err -> pure (Left err)
Right rows -> case checkPlan table of
Left err -> pure (Left err)
Right plan -> do
newRows <- mapM (updateRowM db table plan mWhere assigns) rows
case sequence newRows of
Left err -> pure (Left err)
Right rs -> do
result <- replaceAll tbl rs
Right () -> do
result <- guardDomainCreation db (map (columnType . snd) cols) (createTable name cols)
pure (result >> Right [])
runStatementUncheckedM _ (CreateTable name cols) = do
result <- createTable name cols
runStatementUncheckedM db (CreateDomain name definition) = case canonicalDomain db name definition of
Left err -> pure (Left err)
Right normalized -> do
let DomainDefinition column _ = normalized
result <- guardDomainCreation db [columnType column] (createTable (domainTableName name) (domainColumns normalized))
pure (result >> Right [])
runStatementUncheckedM _ (CreateDomain name base) = do
result <- createTable (domainTableName name) [("base", plainColumn base)]
runStatementUncheckedM _ (AlterDomain name action) = do
result <- alterDomain (domainTableName name) (prepareDomainAlter name action)
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 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 [])
@@ -121,7 +220,7 @@ runStatementUncheckedM _ (DropColumn tbl col) = do
result <- dropColumn tbl col
pure (result >> Right [])
runStatementUncheckedM db (AddColumn tbl def) =
alterTable db tbl (\table -> addColumnTo def (tableCols table) (tableRows table))
alterTable db tbl (\table -> addColumnTo db def (tableCols table) (tableRows table))
runStatementUncheckedM db (RenameColumn tbl old new) =
alterTable db tbl (\table -> renameColumnIn old new (tableCols table) (tableRows table))
runStatementUncheckedM db (AlterColumnType tbl col ty) =
@@ -133,11 +232,13 @@ runStatementUncheckedM db (AlterColumnNull tbl col nullable) =
runStatementUncheckedM _ CreateUser{} = pure (Left "CREATE USER is executed by the account service")
runStatementUncheckedM _ AlterUser{} = pure (Left "ALTER USER is executed by the account service")
runStatementUncheckedM _ AlterIdentity{} = pure (Left "ALTER ROLE is executed by the account service")
runStatementUncheckedM _ ShowGrants = pure (Left "SHOW GRANTS is executed by the account service")
runStatementUncheckedM _ ShowRoles = pure (Left "SHOW ROLES is executed by the account service")
runStatementUncheckedM _ DropUser{} = pure (Left "DROP USER is executed by the account service")
runStatementUncheckedM _ CreateRole{} = pure (Left "CREATE ROLE is executed by the privilege service")
runStatementUncheckedM _ DropRole{} = pure (Left "DROP ROLE is executed by the privilege service")
runStatementUncheckedM _ GrantPrivileges{} = pure (Left "GRANT is executed by the privilege service")
runStatementUncheckedM _ RevokeGrantOption{} = pure (Left "REVOKE is executed by the privilege service")
runStatementUncheckedM _ RevokePrivileges{} = pure (Left "REVOKE is executed by the privilege service")
runStatementUncheckedM _ GrantRole{} = pure (Left "GRANT is executed by the privilege service")
runStatementUncheckedM _ RevokeRole{} = pure (Left "REVOKE is executed by the privilege service")
@@ -146,69 +247,84 @@ runStatementUncheckedM _ q@DropDatabase{} = runStatementM q
runStatementUncheckedM _ q@UseDatabase{} = runStatementM q
runStatementUncheckedM _ ShowDatabases = runStatementM ShowDatabases
runStatementUncheckedM _ BeginTransaction = pure (Left "BEGIN is executed by the session")
runStatementUncheckedM _ BeginSerializableTransaction = pure (Left "BEGIN is executed by the session")
runStatementUncheckedM _ CommitTransaction = pure (Left "COMMIT is executed by the session")
runStatementUncheckedM _ RollbackTransaction = pure (Left "ROLLBACK is executed by the session")
runStatementUncheckedM _ Savepoint{} = pure (Left "SAVEPOINT is executed by the session")
runStatementUncheckedM _ RollbackToSavepoint{} = pure (Left "ROLLBACK TO is executed by the session")
runStatementUncheckedM _ ReleaseSavepoint{} = pure (Left "RELEASE is executed by the session")
-- | 只有需要读全表才能判断约束时才扫表
existingRows :: (MonadStorage m) => String -> Table -> m (Either String [Row])
existingRows tbl table
| needsRows table = scan tbl
| otherwise = pure (Right [])
-- | 建表时在实际发布点复查领域定义
guardDomainCreation :: (MonadStorage m) => Database -> [ColumnType] -> m (Either String a) -> m (Either String a)
guardDomainCreation db types action
| null dependencies = action
| otherwise = withWriteSchemaGuard dependencies action
where
-- | 这一表有没有要判约束的列
needsRows t = any (constraintColumn . snd) (tableCols t)
-- | 这一列带不带要判的约束
constraintColumn c = columnAutoIncrement c || columnUnique c || columnPrimaryKey c
names = typeDependencies db types
dependencies = [(name, table) | (name, table) <- db, name `elem` names]
-- | 只有需要读全表才能判断约束时才扫表
existingRows :: (MonadStorage m) => String -> InsertPlan -> m (Either String [Row])
existingRows tbl (InsertPlan _ _ auto _ (ConstraintPlan _ _ unique))
| Just _ <- auto = scan tbl
| not (null unique) = scan tbl
| otherwise = pure (Right [])
-- | 插一行:补齐缺列、给自增值、收类型、查约束
buildRows :: Table -> [Row] -> [String] -> [[Expr]] -> Either String [Row]
buildRows table current cols rows = do
values <- mapM (mapM (\e -> evalExpr e [])) rows
if any (\vals -> length vals /= length cols) values
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 do
let auto = autoColumn table
go auto (autoStart auto current) values []
else go (autoStart auto current) values []
where
-- | 逐行构造,最后统一查一遍约束
go _ _ [] acc = do
-- \| 逐行构造,最后统一查一遍约束
go _ [] acc = do
let built = reverse acc
plan <- checkPlan table
mapM_ (runChecks plan) built
enforceNotNull (tableCols table) built
enforceUnique (tableCols table) (current ++ built)
mapM_ (runChecks checks) built
enforceConstraints constraints current built
Right built
go auto counter (vals : rest) acc = do
(row, counter') <- buildRow table auto cols counter vals
go auto counter' rest (row : acc)
go counter (vals : rest) acc = do
(row, counter') <- buildRow layout auto counter vals
go counter' rest (row : acc)
-- | 按列定义补出一行
buildRow :: Table -> Maybe (String, Column) -> [String] -> Int -> [Value] -> Either String (Row, Int)
buildRow table auto cols counter vals = go (tableCols table) counter []
-- | 保存输出列定义及可选 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
provided = zip cols vals
-- | 按列定义逐列补值
positions = zip targets [0 ..]
-- | 按绑定槽位和列定义补出一行
buildRow :: [BoundInsertColumn] -> Maybe (String, Column) -> Int -> [Value] -> Either String (Row, Int)
buildRow layout auto counter vals = go layout counter []
where
provided = HM.fromList (zip [0 :: Int ..] vals)
-- \| 按列定义逐列补值
go [] c acc = Right (reverse acc, c)
go ((name, col) : rest) c acc = do
(v, c') <- pick name col 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 c
-- \| 决定这一列取什么值
pick name col supplied c
| Just (autoName, _) <- auto
, name == autoName
, maybe True (== VNull) (lookup name provided) = Right (VInt c, c + 1)
| Just v <- lookup name provided = Right (v, bump name col c v)
, 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
-- \| 自增值跟着已有的值往前推
bump name c v
| Just (autoName, _) <- auto
, name == autoName = max (c + 1) (valueInt v + 1)
, name == autoName =
max (c + 1) (valueInt v + 1)
| otherwise = c
-- | 取自增值,不是整数就当 0
@@ -230,61 +346,97 @@ autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup
ns -> maximum ns + 1
-- | 一次解析出来的 CHECK 条件
type CheckPlan = [(String, Expr)]
data CheckPlan = CheckPlan [String] [(String, Expr)] [(String, Int, Expr)]
-- | 把表上的 CHECK 文本解析成条件,每语句只解析一次
checkPlan :: Table -> Either String CheckPlan
checkPlan table = mapM parse (mapMaybe checked (tableCols table))
-- | 按 schema 解析并绑定表上全部 CHECK
checkPlan :: Database -> Table -> Either String CheckPlan
checkPlan db table = do
local <- mapM parse (mapMaybe checked (tableCols table))
domains <- domainCheckPlan db (tableCols table)
Right (CheckPlan (map fst (tableCols table)) local domains)
where
-- | 只挑出带 CHECK 文本的列
-- \| 只挑出带 CHECK 文本的列
checked (name, col) = (,) name <$> columnCheck col
-- | 解析一列的 CHECK 文本
-- \| 解析一列的 CHECK 文本
parse (name, text) = case parseExpression text of
Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
Right e -> Right (name, e)
Right e -> do
bound <- prepareCheckExpression (tableCols table) e
Right (name, bound)
-- | 执行解析好的 CHECK 条件
runChecks :: CheckPlan -> Row -> Either String ()
runChecks plan row = mapM_ check plan
runChecks (CheckPlan columns plan domains) row = do
ordered <- orderRow columns row
mapM_ (check ordered) plan
runDomainChecks domains ordered
where
-- | 跑一条 CHECK
check (name, e) = case evalCondForRow e row of
-- \| 跑一条 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")
-- 校验最终行集的领域、检查与唯一约束。
validateTableRows :: Database -> Table -> Either String ()
validateTableRows db table = do
effective <- effectiveColumns db (tableCols table)
plan <- checkPlan db table
let rows = tableRows table
mapM_ (runChecks plan) rows
ordered <- mapM (orderRow (map fst effective)) rows
enforceConstraints (constraintPlan effective) [] ordered
-- | 只取第一行(报错提示用)
firstLine :: String -> String
firstLine = takeWhile (/= '\n')
-- | NOT NULL 检查
enforceNotNull :: [(String, Column)] -> [Row] -> Either String ()
enforceNotNull cols rows = mapM_ check cols
-- | 保存非空及唯一键的固定列槽位
data ConstraintPlan = ConstraintPlan [String] [(String, Expr)] [(String, Expr)]
-- | 按 schema 一次绑定行集约束目标
constraintPlan :: [(String, Column)] -> ConstraintPlan
constraintPlan columns = ConstraintPlan (map fst columns) required unique
where
-- | 查这一列的 NOT NULL
check (name, col)
| columnNullable col = Right ()
| any (\r -> lookup name r == Just VNull) rows = Left ("NOT NULL: column " ++ name ++ " cannot be null")
| otherwise = Right ()
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, Column)] -> [Row] -> Either String ()
enforceUnique cols rows = mapM_ check targets
enforceUnique :: [(String, Expr)] -> [Row] -> Either String ()
enforceUnique targets rows = mapM_ check targets
where
targets = [(n, c) | (n, c) <- cols, columnUnique c || columnPrimaryKey c]
-- | 查这一列有没有重复值
check (name, _) = go name HS.empty (mapMaybe (lookup name) rows)
-- | 逐个值比过去
-- \| 查这一列有没有重复值
check (name, reference) = mapM (evalExpr reference) rows >>= go name HS.empty
-- \| 逐个值比过去
go _ _ [] = Right ()
-- | NULL 不算冲突,跳过
-- \| NULL 不算冲突,跳过
go name seen (VNull : rest) = go name seen rest
go name seen (v : rest)
| HS.member (canonicalValue v) seen = Left ("UNIQUE: duplicate value in column " ++ name)
| otherwise = go name (HS.insert (canonicalValue v) seen) rest
-- | UPDATE 的一行(条件与赋值都可能带子查询)
updateRowM :: (MonadStorage m) => Database -> Table -> CheckPlan -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row)
updateRowM db table plan cond asgns row = do
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
@@ -292,31 +444,47 @@ updateRowM db table plan cond asgns row = do
Left err -> pure (Left err)
Right False -> pure (Right row)
Right True -> do
row' <- applyUpdatesM db table asgns row
row' <- applyUpdatesM db asgns row
pure (row' >>= \r -> runChecks plan r >> Right r)
-- | 依次求值、收类型并覆盖列(表达式可以带子查询)
applyUpdatesM :: (MonadStorage m) => Database -> Table -> [(String, Expr)] -> Row -> m (Either String Row)
applyUpdatesM _ _ [] row = pure (Right row)
applyUpdatesM db table ((col, e) : rest) row = do
v <- evalExprM db e row
case v of
Left err -> pure (Left err)
Right val -> case colType table col of
Just def -> case coerceValue (columnType def) val of
Left err -> pure (Left err)
Right v' -> applyUpdatesM db table rest (setColumn col v' row)
Nothing -> applyUpdatesM db table rest (setColumn col val row)
-- | 保存赋值目标槽位、列定义和右侧表达式
data BoundAssignment = BoundAssignment Int String Column Expr
-- | 覆盖一列
setColumn :: String -> Value -> Row -> Row
setColumn col v = map (\(k, val) -> if k == col then (k, v) else (k, val))
-- | 按 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
@@ -337,7 +505,7 @@ alterTable db tbl change = case lookupTable db tbl of
Left e -> pure (Left e)
Right table -> do
rowsResult <- scan tbl
case rowsResult of
case rowsResult >>= mapM (orderRow (map fst (tableCols table))) of
Left e -> pure (Left e)
Right rows -> case change table{tableRows = rows} >>= checkAltered of
Left e -> pure (Left e)
@@ -345,24 +513,26 @@ alterTable db tbl change = case lookupTable db tbl of
result <- replaceSchema tbl cols newRows
pure (result >> Right [])
where
-- | 改完再统一查一遍约束
-- \| 改完再统一查一遍约束
checkAltered (cols, rows) = do
let table = Table tbl cols rows Nothing
plan <- checkPlan table
mapM_ (runChecks plan) rows
enforceNotNull cols rows
enforceUnique cols rows
let table = Table tbl cols rows Nothing Nothing Nothing
validateDomainDefaults db cols
validateTableRows db table
Right (cols, rows)
-- | ADD COLUMN:老行补默认值或 NULL
addColumnTo :: (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
addColumnTo (name, col) cols rows
addColumnTo :: Database -> (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
addColumnTo db (name, declared) cols rows
| name `elem` map fst cols = Left ("ADD COLUMN: column already exists: " ++ name)
| otherwise = do
values <- fill
Right (cols ++ [(name, col)], [r ++ [(name, v)] | (r, v) <- zip rows values])
effective <- effectiveColumns db [(name, declared)]
values <- case effective of
[(_, column)] -> fill column
_ -> Left "invalid added column layout"
Right (cols ++ [(name, declared)], [r ++ [(name, v)] | (r, v) <- zip rows values])
where
fill
-- \| 使用领域继承属性填充已有行
fill col
| columnAutoIncrement col = mapM (coerceValue (columnType col) . VInt) [1 .. length rows]
| Just d <- columnDefault col = mapM (\_ -> coerceValue (columnType col) d) rows
| columnNullable col = mapM (\_ -> coerceValue (columnType col) VNull) rows
@@ -386,7 +556,7 @@ retypeColumn col ty cols rows
rows' <- mapM convert rows
Right (map (\entry@(n, c) -> if n == col then (n, c{columnType = ty}) else entry) cols, rows')
where
-- | 把这一列的老值收进新类型
-- \| 把这一列的老值收进新类型
convert row = case lookup col row of
Nothing -> Right row
Just v -> do
@@ -1,6 +1,7 @@
module ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf, probeCost, pointRows, rangeRows, selectivityOf, indexCheaper) where
import ChuSQL.Core.Model
import Data.Maybe (fromMaybe)
-- 统计与成本估算:行数、不同值数、列直方图与索引探路页数。
@@ -32,9 +33,9 @@ estimateRows h lo hi = max 0 (min total (round (sum (zipWith overlap [0 ..] (his
where
total = sum (histBuckets h)
width = if histHigh h > histLow h then (histHigh h - histLow h) / fromIntegral (length (histBuckets h)) else 0
lower = maybe (-1 / 0) id (boundOf lo)
upper = maybe (1 / 0) id (boundOf hi)
-- | 第 i 个桶与区间重叠的行数
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
@@ -1,22 +1,46 @@
{-# LANGUAGE TupleSections #-}
module ChuSQL.Core.Engine.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
import ChuSQL.Core.Engine.Algebra.Cost (tableMetaOf)
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, hasSubquery, quantifiedCompare, subqueryRefsIn)
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
import ChuSQL.Core.Engine.Algebra.Expr (evalCondForRow, evalExpr, hasSubquery, quantifiedCompare, subqueryColumns, subquerySlotsIn)
import ChuSQL.Core.Engine.Algebra.Op
import ChuSQL.Core.Engine.Algebra.Optimize (optimize)
import ChuSQL.Core.Engine.Algebra.Planner (translate)
import ChuSQL.Core.Engine.Algebra.Sort (sortRows)
import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, invokeBuiltin, unsupportedAggregate)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Algebra.Sort (sortBoundRows, sortRows)
import ChuSQL.Core.Engine.Builtin (aggregateArg, builtinOfExpr, inValues, invokeBuiltin, unsupportedAggregate)
import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns, orderRow)
import ChuSQL.Core.Engine.Storage (IndexResult (..), MonadStorage (..))
import ChuSQL.Core.Engine.Storage.Memory (runMemoryStorage)
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..), Subquery (..))
import ChuSQL.Core.Model
import Control.Monad (filterM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (StateT, evalStateT, gets, modify')
import Data.Bifunctor (first)
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.List (nub)
import qualified Data.HashMap.Strict as HM
-- 执行:按算子树算出结果行,外层行供相关子查询引用。
-- | 单次执行共享已物化结果,不跨查询保留
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
@@ -24,7 +48,7 @@ project cs row = [(c, v) | c <- cs, Just v <- [lookup c row]]
-- | 给列名加别名前缀
addPrefix :: Maybe String -> Row -> Row
addPrefix mAlias = map (\(k, v) -> (qualify mAlias k, v))
addPrefix mAlias = map (first (qualify mAlias))
-- | 给一批行加别名前缀
prefixRows :: Maybe String -> [Row] -> [Row]
@@ -36,6 +60,7 @@ valueLiteral (VInt n) = LitInt n
valueLiteral (VFloat d) = LitFloat d
valueLiteral (VStr s) = LitStr s
valueLiteral (VBool b) = LitBool b
valueLiteral (VRuntime tid value) = RuntimeLiteral tid value
valueLiteral VNull = LitNull
-- | 点查退化成扫描时用的条件
@@ -51,7 +76,7 @@ rangeCondition mAlias col lo hi = case (lo, hi) of
(Nothing, Nothing) -> LitBool True
where
c = Col (qualify mAlias col)
-- | 一个端点的比较,闭端再加上等号
-- \| 一个端点的比较,闭端再加上等号
bound rel (v, inclusive)
| inclusive = Or (rel c (valueLiteral v)) (Eq c (valueLiteral v))
| otherwise = rel c (valueLiteral v)
@@ -78,11 +103,31 @@ data EquiKeys = EquiKeys
-- | 认出 a = b 这种两列等值条件,并且能分清谁在左谁在右
equiKeys :: [String] -> [String] -> Expr -> Maybe EquiKeys
equiKeys lcols rcols (Eq (Col a) (Col b))
| a /= b, a `elem` lcols, b `elem` rcols = Just (EquiKeys a b)
| a /= b, b `elem` lcols, a `elem` rcols = Just (EquiKeys b a)
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) =>
@@ -93,7 +138,7 @@ joinRowsIn ::
Expr ->
[Row] ->
[Row] ->
m (Either String [Row])
Execution m (Either String [Row])
joinRowsIn db outer kind rcols cond lrows rrows =
case equiKeys (rowsCols lrows) rcols cond of
Just ks -> pure (Right (hashJoin kind ks ncols lrows rrows))
@@ -102,6 +147,43 @@ joinRowsIn db outer kind rcols cond lrows rrows =
-- 右表为空时行上没有列名,用算子推导出来的列名补 NULL
ncols = if null rrows then rcols else rowsCols rrows
-- | 哈希判定存在性,仅输出原始左行
semiRows :: SemiKind -> Expr -> Expr -> Row -> [Row] -> [Row] -> Either String [Row]
semiRows kind left right outer leftRows rightRows = do
values <- mapM (evalExpr right . (++ outer)) rightRows
let keys = HS.fromList [canonicalValue value | value <- values, value /= VNull]
hasNull = VNull `elem` values
hashSafe = all safeNumber values
-- \| NULL 与数值边界沿用表达式比较规则
keep row = do
value <- evalExpr left (row ++ outer)
if value == VNull
then Right (kind == NonMatching || kind == NotIn && null values)
else
if hashSafe && safeNumber value
then
let found = HS.member (canonicalValue value) keys
in Right
( case kind of
Matching -> found
NonMatching -> not found
NotIn -> not found && not hasNull
)
else do
result <- inValues value values
Right
( case kind of
Matching -> result == VBool True
NonMatching -> result /= VBool True
NotIn -> result == VBool False
)
filterM keep leftRows
where
-- \| 大数混合比较退回既有逐值语义
safeNumber (VInt value) = abs (toInteger value) <= 9007199254740992
safeNumber (VFloat value) = abs value <= 9007199254740992
safeNumber _ = True
-- | 左连接配不上的左行补 NULL,内连接丢弃
unmatched :: JoinKind -> Row -> [String] -> [Row]
unmatched InnerJoin _ _ = []
@@ -112,7 +194,7 @@ hashJoin :: JoinKind -> EquiKeys -> [String] -> [Row] -> [Row] -> [Row]
hashJoin kind ks ncols lrows rrows = concatMap probe lrows
where
buckets = HM.fromListWith (flip (++)) [(v, [r]) | r <- rrows, Just v <- [joinKeyOf (ekRight ks) r]]
-- | 拿左行的键去桶里找
-- \| 拿左行的键去桶里找
probe l =
let miss = case kind of
InnerJoin -> []
@@ -134,11 +216,11 @@ filterPairsM ::
Expr ->
[Row] ->
[Row] ->
m (Either String [Row])
Execution m (Either String [Row])
filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
where
refs = subqueryRefsIn cond
-- | 逐左行配对,左连接没配上就补 NULL
refs = subquerySlotsIn cond
-- \| 逐左行配对,左连接没配上就补 NULL
go [] acc _ = pure (Right (reverse acc))
go (l : ls) acc cache = do
hits <- keep l rrows [] cache
@@ -149,11 +231,13 @@ filterPairsM db outer kind ncols cond lrows rrows = go lrows [] HM.empty
(LeftJoin, []) -> [l ++ nullRow]
_ -> hs
go ls (reverse hs' ++ acc) nextCache
-- | 拿一行右行去比条件
-- \| 拿一行右行去比条件
keep _ [] acc cache = pure (Right (reverse acc, cache))
keep l (r : rs) acc cache = do
let env = l ++ r ++ outer
key = bindingKey refs env
case bindingKey refs env of
Left err -> pure (Left err)
Right key -> do
resolved <- case HM.lookup key cache of
Just expression -> pure (Right expression)
Nothing -> substSubqueries db cond env
@@ -176,27 +260,33 @@ probeIndexJoin ::
[String] ->
Expr ->
Row ->
m (Either String (Maybe [Row]))
Execution m (Either String (Maybe [Row]))
probeIndexJoin db outer kind mAlias t ks rcols cond l = case lookup (ekLeft ks) l of
Nothing -> pure (Right (Just (unmatched kind l rcols)))
Just k
| not (indexSafe db t (unqualify mAlias (ekRight ks)) k) -> pure (Right Nothing)
| otherwise -> do
res <- lookupByColumn t (unqualify mAlias (ekRight ks)) k
res <- lift (lookupByColumn t (unqualify mAlias (ekRight ks)) k)
case res of
Left e -> pure (Left e)
Right NoIndex -> pure (Right Nothing)
Right (IndexRows rows) -> do
pairs <- joinRowsIn db outer kind rcols cond [l] (prefixRows mAlias rows)
pure (fmap Just pairs)
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)
Just c -> scalarKey k && not (floatType (columnType c)) && not (floatValue k)
where
-- \| 只有已实现编码的键可以点查
scalarKey VInt{} = True
scalarKey VStr{} = True
scalarKey _ = False
-- | 是不是浮点列类型
floatType :: ColumnType -> Bool
@@ -212,26 +302,23 @@ floatValue (VFloat _) = True
floatValue _ = False
-- | 分组键的值
groupKey :: [String] -> Row -> Either String [Value]
groupKey keys row = mapM get keys
where
-- | 取这一列的分组值
get c = maybe (Left ("unknown column: " ++ c)) Right (lookup c row)
groupKey :: Row -> [Expr] -> Row -> Either String [Value]
groupKey outer keys row = mapM (\key -> evalExpr key (row ++ outer)) keys
-- | 按分组键把行分组,保留分组首次出现的顺序
groupRows :: [String] -> [Row] -> Either String [([Value], [Row])]
groupRows keys rows = go rows (HM.empty, [])
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 keys r
k <- groupKey outer keys r
let order' = if HM.member k acc then order else k : order
go rs (HM.insertWith (++) k [r] acc, order')
-- | 一组行上求同一个表达式(外层列从 outer 取)
valuesOf :: Row -> Expr -> [Row] -> Either String [Value]
valuesOf outer e rows = mapM (evalExpr e . (++ outer)) rows
valuesOf outer e = mapM (evalExpr e . (++ outer))
-- | 一个聚合算子在一组行上的结果,统一走内置函数权威
evalAgg :: Row -> Expr -> [Row] -> Either String Value
@@ -248,15 +335,22 @@ oneGroup outer keys aggs (keyValues, rows) = do
Right (zip keys keyValues ++ zip (map fst aggs) values)
-- | 分组求值:没有分组列时,即使没有行也要出一行
evalAggregate :: Row -> [String] -> [(String, Expr)] -> [Row] -> Either String [Row]
evalAggregate :: Row -> [(String, Expr)] -> [(String, Expr)] -> [Row] -> Either String [Row]
evalAggregate outer keys aggs rows = do
groups <- groupRows keys rows
groups <- groupRows outer (map snd keys) rows
let top = if null keys && null groups then [([], [])] else groups
mapM (oneGroup outer keys aggs) top
mapM (oneGroup outer (map fst keys) aggs) top
-- | 绑定键:子查询引用的外层列在这一行上的取值
bindingKey :: [String] -> Row -> String
bindingKey refs env = show [(c, bindingValue c env) | c <- refs]
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
@@ -266,15 +360,15 @@ bindingValue column env = case lookup column env of
Nothing -> Nothing
-- | 每个绑定留第一行当样本,去掉重复绑定
bindingSamples :: [String] -> Row -> [Row] -> [(String, Row)]
bindingSamples :: [Expr] -> Row -> [Row] -> Either String [(String, Row)]
bindingSamples refs outer rows = go rows HM.empty []
where
-- | 逐行按绑定键去重
go [] _ acc = reverse acc
go (r : rs) seen acc =
-- \| 逐行按绑定键去重
go [] _ acc = Right (reverse acc)
go (r : rs) seen acc = do
let env = r ++ outer
k = bindingKey refs env
in case HM.lookup k seen of
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)
@@ -285,34 +379,40 @@ bindingsTableM ::
Row ->
[Expr] ->
[Row] ->
m (Either String (HM.HashMap String [Expr]))
bindingsTableM db outer exprs rows = do
built <- mapM swap (bindingSamples refs outer rows)
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 subqueryRefsIn exprs)
-- | 一个绑定样本上把子查询全换成字面量
refs = nub (concatMap subquerySlotsIn exprs)
-- \| 一个绑定样本上把子查询全换成字面量
swap (key, env) = do
es <- mapM (\e -> substSubqueries db e env) exprs
pure (fmap (\xs -> (key, xs)) (sequence es))
pure (fmap (key,) (sequence es))
-- | 取这一行绑定换好的表达式;没有这个绑定就是内部错误
boundExprs :: [String] -> Row -> HM.HashMap String [Expr] -> Either String [Expr]
boundExprs refs env table = case HM.lookup (bindingKey refs env) table of
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 :: [String] -> Row -> HM.HashMap String [Expr] -> Either String Expr
boundExpr refs env table = case boundExprs refs env table of
Right [x] -> Right x
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
@@ -322,26 +422,34 @@ filterRowsM p = go []
Right False -> go acc rs
-- | 按投影顺序逐项求值(可以带子查询)
computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> m (Either String Row)
computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> Execution m (Either String Row)
computeM db outer items row = go items []
where
-- | 逐项求值并攒成一行
-- \| 逐项求值并攒成一行
go [] acc = pure (Right (reverse acc))
go ((label, e) : rest) acc = do
v <- evalExprM db e (row ++ outer)
v <- evalExprIn db e (row ++ outer)
case v of
Left err -> pure (Left err)
Right val -> go rest ((label, val) : acc)
-- | 表达式求值(先把子查询求成字面量)
evalExprM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Value)
evalExprM db e env = do
evalExprM db e env = evalStateT (evalExprIn db e env) HM.empty
-- | 在当前执行中求值并共享子查询物化
evalExprIn :: (MonadStorage m) => Database -> Expr -> Row -> Execution m (Either String Value)
evalExprIn db e env = do
e' <- substSubqueries db e env
pure (e' >>= \x -> evalExpr x env)
-- | 条件求值(先把子查询求成字面量)
evalCondForRowM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Bool)
evalCondForRowM db e env = do
evalCondForRowM db e env = evalStateT (evalCondIn db e env) HM.empty
-- | 在当前执行中判定条件并共享物化
evalCondIn :: (MonadStorage m) => Database -> Expr -> Row -> Execution m (Either String Bool)
evalCondIn db e env = do
e' <- substSubqueries db e env
pure (e' >>= \x -> evalCondForRow x env)
@@ -360,35 +468,53 @@ scalarResult rows = do
_ -> Left "scalar subquery returned more than one row"
-- | 把子查询求值成字面量;子查询的错直接往上传
substSubqueries :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Expr)
substSubqueries :: (MonadStorage m) => Database -> Expr -> Row -> Execution m (Either String Expr)
substSubqueries db e env = case e of
Construct tid arguments -> do
bound <- mapM (\argument -> substSubqueries db argument env) arguments
pure (Construct tid <$> sequence bound)
BoundConstruct tid arguments -> do
bound <- mapM (\argument -> substSubqueries db argument env) arguments
pure (BoundConstruct tid <$> sequence bound)
FunctionCall name arguments -> do
bound <- mapM (\argument -> substSubqueries db argument env) arguments
pure (FunctionCall name <$> sequence bound)
BoundFunction fid tid arguments -> do
bound <- mapM (\argument -> substSubqueries db argument env) arguments
pure (BoundFunction fid tid <$> sequence bound)
ScalarSub sq -> scalarResult <$> runSubqueryRows db sq env
InSub a sq negated -> do
lhs <- substSubqueries db a env
rows <- runSubqueryRows db sq env
pure (do
pure
( do
a' <- lhs
rs <- rows
vs <- mapM rowValue rs
Right (InList a' (map valueLiteral vs) negated))
Right (InList a' (map valueLiteral vs) negated)
)
ExistsSub sq negated -> do
rows <- runSubqueryRows db sq env
pure (fmap (\rs -> LitBool (if negated then null rs else not (null rs))) rows)
QuantCmp op a sq q -> do
lhs <- substSubqueries db a env
rows <- runSubqueryRows db sq env
pure (do
pure
( do
a' <- lhs
rs <- rows
vs <- mapM rowValue rs
Right (quantifiedCompare op a' (map valueLiteral vs) q))
Right (quantifiedCompare op a' (map valueLiteral vs) q)
)
InList a es negated -> do
lhs <- substSubqueries db a env
es' <- mapM (\x -> substSubqueries db x env) es
pure (do
pure
( do
a' <- lhs
items <- sequence es'
Right (InList a' items negated))
Right (InList a' items negated)
)
Add a b -> bin Add a b
Sub a b -> bin Sub a b
Mul a b -> bin Mul a b
@@ -411,44 +537,51 @@ substSubqueries db e env = case e of
MaxOf a -> un MaxOf a
_ -> pure (Right e)
where
-- | 递归处理两个子表达式
-- \| 递归处理两个子表达式
bin ctor a b = do
ra <- substSubqueries db a env
case ra of
Left err -> pure (Left err)
Right a' -> do
rb <- substSubqueries db b env
pure ((ctor a') <$> rb)
-- | 递归处理一个子表达式
pure (ctor a' <$> rb)
-- \| 递归处理一个子表达式
un ctor a = do
ra <- substSubqueries db a env
pure (ctor <$> ra)
-- | 跑子查询:翻译成算子树再求值,外层行做相关子查询的绑定
runSubqueryRows :: (MonadStorage m) => Database -> Subquery -> Row -> m (Either String [Row])
runSubqueryRows :: (MonadStorage m) => Database -> Subquery -> Row -> Execution m (Either String [Row])
runSubqueryRows db sq outer = case translate (subqueryStatement sq) of
Left e -> pure (Left e)
Right op -> case mapM bind (subqueryRefs sq) of
Right op -> case mapM bind (subqueryColumns sq) of
Left err -> pure (Left err)
Right bindings -> evalRelOpIn db (bindings ++ outer) (optimize db op)
Right bindings -> case bindRelOpColumns db (map fst (bindings ++ outer)) (optimize db op) of
Left err -> pure (Left err)
Right bound ->
materialize
(show ("subquery", subqueryStatement sq, bindings, fallback))
(evalRelOpIn db (bindings ++ outer) bound)
where
-- | 给外层物理列补回已解析的限定名
bind column = case bindingValue column outer of
Just value -> Right (column, value)
Nothing -> Left ("unknown outer column: " ++ column)
-- \| 原始调用未证明依赖完整,保留整个外层行
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 = evalRelOpIn db []
evalRelOpM db op = evalStateT (evalRelOpIn db [] op) HM.empty
-- | 纯求值(内存存储,子查询走同一条路径)
evalRelOp :: Database -> RelOp -> Either String [Row]
evalRelOp db op = do
(result, _) <- runMemoryStorage (evalRelOpIn db [] op) db
(result, _) <- runMemoryStorage (evalRelOpM db op) db
result
-- | 带外层行的执行器
evalRelOpIn :: (MonadStorage m) => Database -> Row -> RelOp -> m (Either String [Row])
evalRelOpIn :: (MonadStorage m) => Database -> Row -> RelOp -> Execution m (Either String [Row])
evalRelOpIn _ _ Unit = pure (Right [[]])
evalRelOpIn db outer (Compute items op) = do
rows <- evalRelOpIn db outer op
@@ -462,56 +595,77 @@ evalRelOpIn db outer (Compute items op) = do
table <- bindingsTableM db outer (map snd items) rs
pure (table >>= \t -> traverse (computeBound t) rs)
where
refs = nub (concatMap (subqueryRefsIn . snd) items)
-- | 用这一行绑定换好的表达式算出一行
refs = nub (concatMap (subquerySlotsIn . snd) items)
-- \| 用这一行绑定换好的表达式算出一行
computeBound table r = do
es <- boundExprs refs (r ++ outer) table
mapM (\(label, e) -> (,) label <$> evalExpr e (r ++ outer)) (zip (map fst items) es)
evalRelOpIn db outer (Aggregate keys aggs op) = do
rows <- evalRelOpIn db outer op
pure (rows >>= evalAggregate outer [(name, Col name) | name <- keys] aggs)
evalRelOpIn db outer (BoundAggregate keys aggs op) = do
rows <- evalRelOpIn db outer op
pure (rows >>= evalAggregate outer keys aggs)
evalRelOpIn db _ (Scan mAlias tbl cols) = do
res <- scanTable db tbl cols
pure (fmap (prefixRows mAlias) res)
pure (res >>= orderedRows (relOpCols db (Scan mAlias tbl cols)) . prefixRows mAlias)
evalRelOpIn db outer (Lookup mAlias tbl col k) = do
res <- lookupByColumn tbl col k
res <- lift (lookupByColumn tbl col k)
case res of
Left e -> pure (Left e)
Right NoIndex -> scanFiltered db outer mAlias tbl (lookupCondition mAlias col k)
Right (IndexRows rows) -> pure (Right (prefixRows mAlias rows))
Right (IndexRows rows) -> pure (orderedRows (relOpCols db (Lookup mAlias tbl col k)) (prefixRows mAlias rows))
evalRelOpIn db outer (Range mAlias tbl col lo hi) = do
res <- scanRange tbl col lo hi
res <- lift (scanRange tbl col lo hi)
case res of
Left e -> pure (Left e)
Right Nothing -> scanFiltered db outer mAlias tbl (rangeCondition mAlias col lo hi)
Right (Just rows) -> pure (Right (prefixRows mAlias rows))
Right (Just rows) -> pure (orderedRows (relOpCols db (Range mAlias tbl col lo hi)) (prefixRows mAlias rows))
evalRelOpIn db outer (Filter e op) = do
rows <- evalRelOpIn db outer op
case rows of
Left err -> pure (Left err)
Right rs
| not (hasSubquery e) -> filterRowsM (\r -> evalCondForRowM db e (r ++ outer)) rs
| not (hasSubquery e) -> filterRowsM (\r -> evalCondIn db e (r ++ outer)) rs
| otherwise -> do
table <- bindingsTableM db outer [e] rs
pure (table >>= \t -> filterM (keepBound t) rs)
where
refs = nub (subqueryRefsIn e)
-- | 用这一行绑定换好的条件判定
refs = nub (subquerySlotsIn e)
-- \| 用这一行绑定换好的条件判定
keepBound table r = do
e' <- boundExpr refs (r ++ outer) table
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 <- evalRelOpIn db outer op
rows <- materialize (show ("derived", op, outer)) (evalRelOpIn db outer op)
pure (fmap (prefixRows mAlias) rows)
evalRelOpIn db outer (SemiJoin kind left right l r query) = do
rows <- evalRelOpIn db outer l
case rows of
Left err -> pure (Left err)
Right [] -> pure (Right [])
Right leftRows -> do
-- \| 独立 IN 沿用子查询身份,跨算子复用结果
let key = case query of
Just statement -> show ("subquery", statement, [] :: Row, Nothing :: Maybe Row)
Nothing -> show ("derived", r, outer)
rightRows <- materialize key (evalRelOpIn db outer r)
pure (rightRows >>= semiRows kind left right outer leftRows)
evalRelOpIn db outer (Join kind l r c) = do
lres <- evalRelOpIn db outer l
case lres of
@@ -540,24 +694,36 @@ scanFiltered ::
Maybe String ->
String ->
Expr ->
m (Either String [Row])
Execution m (Either String [Row])
scanFiltered db outer mAlias tbl cond = do
res <- scanTable db tbl Nothing
pure $ do
rows <- res
filterM (evalCondForRow cond . (++ outer)) (prefixRows mAlias rows)
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] -> m (Either String [Row])
scanTable :: (MonadStorage m) => Database -> String -> Maybe [String] -> Execution m (Either String [Row])
scanTable db tbl cols = do
width <- parallelShards
width <- lift parallelShards
if width > 1 && rows >= parallelRowThreshold
then scanShards width tbl cols
else maybe (scan tbl) (scanColumns tbl) cols
then lift (scanShards width tbl cols)
else lift (maybe (scan tbl) (scanColumns tbl) cols)
where
-- | 统计里的行数,没有统计算 0
-- \| 统计里的行数,没有统计算 0
rows = maybe 0 metaRowCount (tableMetaOf db tbl)
-- | 按输出值去重并保留首次行序
distinctRows :: [Row] -> [Row]
distinctRows = go HS.empty
where
-- \| 只输出尚未遇到的值组合
go _ [] = []
go seen (row : rows)
| HS.member key seen = go seen rows
| otherwise = row : go (HS.insert key seen) rows
where
key = map (canonicalValue . snd) row
@@ -1,8 +1,9 @@
module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, subqueryRefsIn, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot, quantifiedCompare) where
module ChuSQL.Core.Engine.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, subqueryRefsIn, subquerySlotsIn, subqueryColumns, aggregatesIn, hasAggregate, bareColumns, hasSubquery, hasDivision, inValues, threeValuedNot, quantifiedCompare) where
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator, inValues, threeValuedNot)
import ChuSQL.Core.Engine.Runtime.SQL (constructSQLValue, invokeSQLFunction)
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Model
-- 表达式求值:三值逻辑,NULL 参与运算结果仍是 NULL。
@@ -10,6 +11,19 @@ import ChuSQL.Core.Engine.Builtin (Operator (..), compareNode, executeOperator,
evalExpr :: Expr -> Row -> Either String Value
evalExpr (Col name) row =
maybe (Left ("unknown column: " ++ name)) Right (lookup name row)
evalExpr (ColumnSlot slot name) row = case drop slot row of
(key, value) : _ | slot >= 0, key == name -> Right value
[] -> Left ("missing bound column: " ++ name)
_ -> Left ("bound column position mismatch: " ++ name)
evalExpr (OuterColumnSlot localWidth slot name) row
| localWidth < 0 || slot < 0 = Left ("bound column position mismatch: " ++ name)
| otherwise = evalExpr (ColumnSlot slot name) (drop localWidth row)
evalExpr (FunctionCall name _) _ = Left ("unbound function call: " ++ name)
evalExpr (Construct _ _) _ = Left "unbound runtime constructor"
evalExpr (BoundConstruct tid arguments) row = mapM (`evalExpr` row) arguments >>= constructSQLValue tid
evalExpr (RuntimeLiteral tid value) _ = coerceValue (CRuntime tid) (VRuntime tid value)
evalExpr (BoundFunction fid tid arguments) row =
mapM (`evalExpr` row) arguments >>= invokeSQLFunction fid tid
evalExpr LitNull _ = Right VNull
evalExpr (LitInt n) _ = Right (VInt n)
evalExpr (LitFloat d) _ = Right (VFloat d)
@@ -41,13 +55,13 @@ evalExpr (IsNotNull a) row = do
Right (VBool (v /= VNull))
evalExpr (InList a es negated) row = do
v <- evalExpr a row
vs <- mapM (\e -> evalExpr e row) es
vs <- mapM (`evalExpr` row) es
r <- inValues v vs
Right (if negated then threeValuedNot r else r)
evalExpr (ScalarSub _) _ = Left subqueryNeedsDatabase
evalExpr (InSub _ _ _) _ = Left subqueryNeedsDatabase
evalExpr (InSub{}) _ = Left subqueryNeedsDatabase
evalExpr (ExistsSub _ _) _ = Left subqueryNeedsDatabase
evalExpr (QuantCmp _ _ _ _) _ = Left subqueryNeedsDatabase
evalExpr (QuantCmp{}) _ = Left subqueryNeedsDatabase
evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
-- | 子查询要连上存储才能跑
@@ -63,6 +77,12 @@ quantifiedCompare op lhs vs q = case vs of
-- | 表达式用到了哪些列
colsInExpr :: Expr -> [String]
colsInExpr (Col c) = [c]
colsInExpr (ColumnSlot _ c) = [c]
colsInExpr (OuterColumnSlot _ _ c) = [c]
colsInExpr (Construct _ arguments) = concatMap colsInExpr arguments
colsInExpr (BoundConstruct _ arguments) = concatMap colsInExpr arguments
colsInExpr (FunctionCall _ arguments) = concatMap colsInExpr arguments
colsInExpr (BoundFunction _ _ arguments) = concatMap colsInExpr arguments
colsInExpr (Add a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Sub a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Mul a b) = colsInExpr a ++ colsInExpr b
@@ -92,17 +112,34 @@ colsInExpr _ = []
-- | 表达式里子查询引用的外层列
subqueryRefsIn :: Expr -> [String]
subqueryRefsIn e = case e of
ScalarSub sq -> subqueryRefs sq
InSub a sq _ -> subqueryRefsIn a ++ subqueryRefs sq
InList a es _ -> concatMap subqueryRefsIn (a : es)
ExistsSub sq _ -> subqueryRefs sq
QuantCmp _ a sq _ -> subqueryRefsIn a ++ subqueryRefs sq
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 -> subqueryRefsIn a
Neg a -> collect a
Gt a b -> both a b
Lt a b -> both a b
Eq a b -> both a b
@@ -111,21 +148,27 @@ subqueryRefsIn e = case e of
NotEq a b -> both a b
And a b -> both a b
Or a b -> both a b
IsNull a -> subqueryRefsIn a
IsNotNull a -> subqueryRefsIn a
CountOf a -> subqueryRefsIn a
SumOf a -> subqueryRefsIn a
AvgOf a -> subqueryRefsIn a
MinOf a -> subqueryRefsIn a
MaxOf a -> subqueryRefsIn a
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
-- | 两个子表达式的外层列拼起来
both a b = subqueryRefsIn a ++ subqueryRefsIn b
-- \| 递归收集当前提取器的引用
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
@@ -142,17 +185,21 @@ hasDivision e = case e of
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
InSub{} -> True
InList a es _ -> any hasSubquery (a : es)
ExistsSub _ _ -> True
QuantCmp _ _ _ _ -> True
QuantCmp{} -> True
Add a b -> both a b
Sub a b -> both a b
Mul a b -> both a b
@@ -175,12 +222,16 @@ hasSubquery e = case e of
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]
@@ -188,6 +239,8 @@ aggregatesIn e = case e of
a@(MinOf _) -> [a]
a@(MaxOf _) -> [a]
QuantCmp _ a _ _ -> aggregatesIn a
InSub a _ _ -> aggregatesIn a
InList a values _ -> aggregatesIn a ++ concatMap aggregatesIn values
Add a b -> both a b
Sub a b -> both a b
Mul a b -> both a b
@@ -205,7 +258,7 @@ aggregatesIn e = case e of
IsNotNull a -> aggregatesIn a
_ -> []
where
-- | 两个子表达式的聚合拼起来
-- \| 两个子表达式的聚合拼起来
both a b = aggregatesIn a ++ aggregatesIn b
-- | 表达式里有没有聚合调用
@@ -215,7 +268,13 @@ hasAggregate = not . null . aggregatesIn
-- | 聚合之外的列引用(聚合参数里的列不算)
bareColumns :: Expr -> [String]
bareColumns e = case e of
Construct _ arguments -> concatMap bareColumns arguments
BoundConstruct _ arguments -> concatMap bareColumns arguments
FunctionCall _ arguments -> concatMap bareColumns arguments
BoundFunction _ _ arguments -> concatMap bareColumns arguments
Col c -> [c]
ColumnSlot _ c -> [c]
OuterColumnSlot _ _ c -> [c]
Add a b -> both a b
Sub a b -> both a b
Mul a b -> both a b
@@ -238,7 +297,7 @@ bareColumns e = case e of
QuantCmp _ a sq _ -> bareColumns a ++ subqueryRefs sq
_ -> []
where
-- | 两个子表达式的裸列拼起来
-- \| 两个子表达式的裸列拼起来
both a b = bareColumns a ++ bareColumns b
-- | 判断条件真假:只有 TRUE 通过,NULL 当作不通过
@@ -6,6 +6,7 @@ import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
import ChuSQL.Core.Model
import Data.List (partition)
import Data.Maybe (fromMaybe)
-- 内连接链顺序优化:按统计估算中间结果,只在行序不可观察处重排。
@@ -15,6 +16,7 @@ reorderJoins db = pass db False
-- | 往下带“行序是否不可观察”,可观察时不动内连接
pass :: Database -> Bool -> RelOp -> RelOp
pass db free (Distinct x) = Distinct (pass db free x)
pass db _ (Sort spec x) = Sort spec (pass db True x)
pass db _ (Limit n x) = Limit n (pass db False x)
pass db _ (Aggregate keys aggs x) = Aggregate keys aggs (pass db False x)
@@ -22,6 +24,7 @@ pass db free (Project cols x) = Project cols (pass db free x)
pass db free (Compute items x) = Compute items (pass db free x)
pass db free (Filter p x) = Filter p (pass db free x)
pass db free (Derived a x) = Derived a (pass db free x)
pass db free (SemiJoin kind left right l r query) = SemiJoin kind left right (pass db free l) (pass db False r) query
pass db free (Join kind l r c)
| free
, Just (leaves, conds) <- innerChain (Join kind l r c)
@@ -37,7 +40,7 @@ innerChain (Join InnerJoin l r c) = do
(ls, lcs) <- innerChain l
(rs, rcs) <- innerChain r
pure (ls ++ rs, lcs ++ rcs ++ [c])
innerChain (Join _ _ _ _) = Nothing
innerChain (Join{}) = Nothing
innerChain op = Just ([op], [])
-- | 叶子算子的估算行数,拿不到统计就是 Nothing
@@ -78,7 +81,7 @@ scaleRows db p x rows = case p of
GtE _ _ -> quarter
LtE _ _ -> quarter
NotEq _ _ -> quarter
QuantCmp _ _ _ _ -> quarter
QuantCmp{} -> quarter
And a b -> max 1 (min (scaleRows db a x rows) (scaleRows db b x rows))
_ -> quarter
where
@@ -86,7 +89,8 @@ scaleRows db p x rows = case p of
pick k lo hi = case leafSource x of
Just (alias, t)
| Just m <- tableMetaOf db t
, Just s <- selectivityOf m (unqualify alias k) lo hi -> max 1 (round (fromIntegral rows * s))
, Just s <- selectivityOf m (unqualify alias k) lo hi ->
max 1 (round (fromIntegral rows * s))
_ -> quarter
-- | 叶子对应的别名与表名
@@ -103,8 +107,7 @@ distinctOf :: Database -> RelOp -> String -> Maybe Int
distinctOf db leaf col = do
(alias, t) <- leafSource leaf
m <- tableMetaOf db t
num <- lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
pure num
lookup (unqualify alias col) [(c, n) | (c, n, _) <- metaDistinct m]
-- | 若干叶子里某列最大的不同值数
distinctOn :: Database -> [RelOp] -> String -> Maybe Int
@@ -120,12 +123,12 @@ keyDistinct db have x conds = case [v | Eq (Col a) (Col b) <- conds, Just v <- [
where
haveCols = concatMap (relOpCols db) have
xCols = relOpCols db x
-- | 这一对列是不是两侧之间的等值键
-- \| 这一对列是不是两侧之间的等值键
pair a b
| a `elem` haveCols, b `elem` xCols = bigger (distinctOn db have a) (distinctOf db x b)
| b `elem` haveCols, a `elem` xCols = bigger (distinctOn db have b) (distinctOf db x a)
| otherwise = Nothing
-- | 两个可选统计取大的那个
-- \| 两个可选统计取大的那个
bigger (Just a) (Just b) = Just (max a b)
bigger (Just a) Nothing = Just a
bigger Nothing (Just b) = Just b
@@ -137,13 +140,13 @@ stepRows db have acc x conds = case keyDistinct db have x conds of
Just v | v > 1 -> max 1 (acc * rows `div` v)
_ -> acc * rows
where
rows = maybe 1 id (leafRows db x)
rows = fromMaybe 1 (leafRows db x)
-- | 一批叶子按给定顺序连接,累加每一步的中间结果
chainCost :: Database -> [RelOp] -> [Expr] -> Int
chainCost db (l : ls) conds = go [l] (maybe 1 id (leafRows db l)) ls
chainCost db (l : ls) conds = go [l] (fromMaybe 1 (leafRows db l)) ls
where
-- | 逐步接上后面的叶子
-- \| 逐步接上后面的叶子
go _ _ [] = 0
go have acc (x : xs) =
let card = stepRows db have acc x conds
@@ -158,11 +161,11 @@ growOrder db leaves conds have rest = case rest of
let next = pick rest
in growOrder db leaves conds (have ++ [next]) (filter (/= next) rest)
where
-- | 候选里成本最低的那个,同价取序号小的
-- \| 候选里成本最低的那个,同价取序号小的
pick (i : is) = foldl cheaper i is
pick [] = 0
cheaper i j = if costOf j < costOf i then j else i
-- | 这个前缀的估算成本
-- \| 这个前缀的估算成本
costOf i = chainCost db [leaves !! k | k <- have ++ [i]] conds
-- | 每个起点贪心一遍,取最便宜的顺序
@@ -170,13 +173,13 @@ bestOrder :: Database -> [RelOp] -> [Expr] -> [RelOp]
bestOrder db leaves conds = pick (map start [0 .. n - 1])
where
n = length leaves
-- | 从第 i 张表开始的贪心顺序
-- \| 从第 i 张表开始的贪心顺序
start i = [leaves !! k | k <- growOrder db leaves conds [i] (filter (/= i) [0 .. n - 1])]
-- | 成本最低的那个
-- \| 成本最低的那个
pick (o : os) = foldl cheaper o os
pick [] = []
cheaper o o' = if cost o' < cost o then o' else o
-- | 一个顺序的估算成本
-- \| 一个顺序的估算成本
cost o = chainCost db o conds
-- | 统计齐全、没有除法且确实更省时给出新顺序
@@ -187,7 +190,7 @@ cheaperOrder db leaves conds
| bestCost < textCost = Just best
| otherwise = Nothing
where
-- | 这个叶子是不是拿不到统计
-- \| 这个叶子是不是拿不到统计
unknown x = case leafRows db x of
Just _ -> False
Nothing -> True
@@ -199,21 +202,20 @@ cheaperOrder db leaves conds
rebuildChain :: Database -> [RelOp] -> [Expr] -> RelOp
rebuildChain db (l : ls) conds = go (relOpCols db l) l ls conds
where
-- | 逐个接上后面的叶子
-- \| 逐个接上后面的叶子
go _ acc [] rest = applyConds rest acc
go have acc (x : xs) rest =
let have' = have ++ relOpCols db x
(now, later) = partition (\c -> colsInExpr c `subsetOf` have') rest
in go have' (Join InnerJoin acc x (conjOf now)) xs later
-- | 若干条件用 AND 串起来
-- \| 若干条件用 AND 串起来
conjOf [] = LitBool True
conjOf (c : cs) = foldl And c cs
rebuildChain _ [] _ = Unit
-- | 挂不上去的条件套成 Filter
applyConds :: [Expr] -> RelOp -> RelOp
applyConds [] op = op
applyConds (c : cs) op = Filter c (applyConds cs op)
applyConds cs op = foldr Filter op cs
-- | 条件的列是不是都在可用列里
subsetOf :: [String] -> [String] -> Bool
@@ -1,10 +1,13 @@
module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols, renderPlan) where
module ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols, renderPlan) where
import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir, Statement)
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST (Expr, JoinKind (..), SortDir)
-- 关系代数算子定义、输出列推导与算子树文本渲染。
-- | 区分存在匹配、无匹配与 NULL 感知排除
data SemiKind = Matching | NonMatching | NotIn deriving (Show, Eq)
data RelOp
= Scan (Maybe String) String (Maybe [String])
| Lookup (Maybe String) String String Value
@@ -13,10 +16,15 @@ data RelOp
| Project [String] RelOp
| Compute [(String, Expr)] RelOp
| Aggregate [String] [(String, Expr)] RelOp
| BoundAggregate [(String, Expr)] [(String, Expr)] RelOp
| Distinct RelOp
| Unit
| Sort [(String, SortDir)] RelOp
| BoundSort [(Expr, SortDir)] RelOp
| Limit Int RelOp
| Join JoinKind RelOp RelOp Expr
| -- | 末项仅保存独立 IN 的物化身份
SemiJoin SemiKind Expr Expr RelOp RelOp (Maybe Statement)
| Derived (Maybe String) RelOp
deriving (Show, Eq)
@@ -25,6 +33,7 @@ relOpCols :: Database -> RelOp -> [String]
relOpCols _ Unit = []
relOpCols _ (Compute items _) = map fst items
relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs
relOpCols _ (BoundAggregate keys aggs _) = map fst keys ++ map fst aggs
relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols
relOpCols db (Scan mAlias tbl Nothing) =
case lookup tbl db of
@@ -37,9 +46,12 @@ relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing)
relOpCols db (Filter _ x) = relOpCols db x
relOpCols _ (Project ["*"] _) = ["*"]
relOpCols _ (Project cols _) = cols
relOpCols db (Distinct x) = relOpCols db x
relOpCols db (Sort _ x) = relOpCols db x
relOpCols db (BoundSort _ x) = relOpCols db x
relOpCols db (Limit _ x) = relOpCols db x
relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r
relOpCols db (SemiJoin _ _ _ l _ _) = relOpCols db l
relOpCols db (Derived mAlias x) = map (qualify mAlias) (relOpCols db x)
-- | 连接的显示名
@@ -51,7 +63,7 @@ kindLabel LeftJoin = "LeftJoin"
renderPlan :: RelOp -> String
renderPlan = go 0
where
-- | 按缩进渲染一个算子
-- \| 按缩进渲染一个算子
go ind op = case op of
Scan a t cols -> pad ++ "Scan " ++ show a ++ " " ++ show t ++ maybe "" ((" columns=" ++) . show) cols
Lookup _ t c k -> pad ++ "Lookup " ++ show t ++ "." ++ show c ++ " = " ++ show k
@@ -67,10 +79,30 @@ renderPlan = go 0
++ show [label ++ " <- " ++ show e | (label, e) <- aggs]
++ "\n"
++ go (ind + 1) x
Distinct x -> pad ++ "Distinct\n" ++ go (ind + 1) x
BoundAggregate keys aggs x ->
pad
++ "BoundAggregate keys="
++ show keys
++ " aggs="
++ show aggs
++ "\n"
++ go (ind + 1) x
Unit -> pad ++ "Unit"
Sort s x -> pad ++ "Sort " ++ show s ++ "\n" ++ go (ind + 1) x
BoundSort s x -> pad ++ "BoundSort " ++ show s ++ "\n" ++ go (ind + 1) x
Limit n x -> pad ++ "Limit " ++ show n ++ "\n" ++ go (ind + 1) x
Join k l r c -> pad ++ kindLabel k ++ " on " ++ show c ++ "\n" ++ go (ind + 1) l ++ "\n" ++ go (ind + 1) r
SemiJoin k left right l r _ ->
pad
++ "SemiJoin "
++ show k
++ " keys="
++ show (left, right)
++ "\n"
++ go (ind + 1) l
++ "\n"
++ go (ind + 1) r
Derived a x -> pad ++ "Derived " ++ show a ++ "\n" ++ go (ind + 1) x
where
pad = replicate (ind * 2) ' '
@@ -3,9 +3,10 @@ module ChuSQL.Core.Engine.Algebra.Optimize (optimize, pushProject) where
import ChuSQL.Core.Engine.Algebra.Cost (indexCheaper, pointRows, rangeRows, tableMetaOf)
import ChuSQL.Core.Engine.Algebra.Expr (colsInExpr, evalExpr, hasDivision)
import ChuSQL.Core.Engine.Algebra.JoinOrder (reorderJoins)
import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), relOpCols)
import ChuSQL.Core.Engine.Algebra.Op (RelOp (..), SemiKind (..), relOpCols)
import ChuSQL.Core.Engine.Algebra.Planner (translate)
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), FromClause (..), JoinKind (..), Statement (..), Subquery (..))
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Syntax.AST (Expr (..), JoinKind (..))
import Data.List (nub)
-- 查询优化:谓词下推、投影下推、常量折叠、扫描方式与连接顺序选择。
@@ -29,15 +30,14 @@ 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 [] op = op
applyFilters (e : es) op = applyFilters es (Filter e op)
applyFilters es op = foldl (flip Filter) op es
-- | Filter 压在内连接上时下推
pushJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
@@ -75,8 +75,10 @@ pushOne _ op = op
planHasDivision :: RelOp -> Bool
planHasDivision (Filter p x) = hasDivision p || planHasDivision x
planHasDivision (Join _ l r c) = hasDivision c || planHasDivision l || planHasDivision r
planHasDivision (SemiJoin _ left right l r _) = hasDivision left || hasDivision right || planHasDivision l || planHasDivision r
planHasDivision (Compute items x) = any (hasDivision . snd) items || planHasDivision x
planHasDivision (Project _ x) = planHasDivision x
planHasDivision (Distinct x) = planHasDivision x
planHasDivision (Sort _ x) = planHasDivision x
planHasDivision (Limit _ x) = planHasDivision x
planHasDivision (Derived _ x) = planHasDivision x
@@ -96,6 +98,8 @@ pushProjectLeaf db need leaf
-- | 把需要哪些列往下传
pushProject :: Database -> [String] -> RelOp -> RelOp
pushProject _ _ Unit = Unit
pushProject _ _ op@BoundSort{} = op
pushProject _ _ op@BoundAggregate{} = op
pushProject db _ (Compute items x) = Compute items (pushProject db (concatMap (colsInExpr . snd) items) x)
pushProject db _ (Aggregate keys aggs x) =
Aggregate keys aggs (pushProject db (keys ++ concatMap (colsInExpr . snd) aggs) x)
@@ -103,8 +107,17 @@ 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 =
@@ -120,15 +133,15 @@ pushProject db need leaf@(Scan a t _)
| otherwise = Scan a t (Just (nub [column | requested <- need, let column = physicalColumn requested, column `elem` available]))
where
available = map (unqualify a) (relOpCols db (Scan a t Nothing))
-- | 把扫描限定列换成存储物理列名
-- \| 把扫描限定列换成存储物理列名
physicalColumn column = unqualify (Just (deriveQualifier a t)) (unqualify a column)
pushProject db need (Derived a x)
| needsAll need || all (`elem` wanted) (relOpCols db x) = Derived a (pushProject db ["*"] x)
| otherwise = Derived a (Project wanted (pushProject db wanted x))
where
wanted = nub (map (unqualify a) need)
pushProject db need leaf@(Lookup _ _ _ _) = pushProjectLeaf db need leaf
pushProject db need leaf@(Range _ _ _ _ _) = pushProjectLeaf db need leaf
pushProject db need leaf@(Lookup{}) = pushProjectLeaf db need leaf
pushProject db need leaf@(Range{}) = pushProjectLeaf db need leaf
-- | 折一个表达式节点
foldNode :: Expr -> Expr
@@ -139,6 +152,7 @@ foldNode e
Right (VFloat d) -> LitFloat d
Right (VStr s) -> LitStr s
Right (VBool b) -> LitBool b
Right (VRuntime tid value) -> RuntimeLiteral tid value
Left _ -> e
| otherwise = e
@@ -149,6 +163,8 @@ foldConstants (Sub a b) = foldNode (Sub (foldConstants a) (foldConstants b))
foldConstants (Mul a b) = foldNode (Mul (foldConstants a) (foldConstants b))
foldConstants (Div a b) = foldNode (Div (foldConstants a) (foldConstants b))
foldConstants (Neg a) = foldNode (Neg (foldConstants a))
foldConstants (BoundConstruct tid arguments) = BoundConstruct tid (map foldConstants arguments)
foldConstants (BoundFunction fid tid arguments) = foldNode (BoundFunction fid tid (map foldConstants arguments))
foldConstants (Gt a b) = foldNode (Gt (foldConstants a) (foldConstants b))
foldConstants (Lt a b) = foldNode (Lt (foldConstants a) (foldConstants b))
foldConstants (Eq a b) = foldNode (Eq (foldConstants a) (foldConstants b))
@@ -172,8 +188,61 @@ 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))
@@ -242,14 +311,16 @@ 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
@@ -1,3 +1,5 @@
{-# LANGUAGE TupleSections #-}
module ChuSQL.Core.Engine.Algebra.Planner (translate) where
import ChuSQL.Core.Engine.Algebra.Expr (aggregatesIn, colsInExpr)
@@ -25,18 +27,22 @@ source fromC mWhere = do
nameAggs :: [(String, Expr)] -> [(String, Expr)]
nameAggs items = go (1 :: Int) [] (concatMap (aggregatesIn . snd) items)
where
-- | 逐个聚合起名,重复的不再起名
-- \| 逐个聚合起名,重复的不再起名
go :: Int -> [(String, Expr)] -> [Expr] -> [(String, Expr)]
go _ acc [] = reverse acc
go n acc (e : es)
| any ((== e) . snd) acc = go n acc es
| otherwise = go (n + 1) (("agg" ++ show n, e) : acc) es
| otherwise = go (n + 1) (("$agg" ++ show n, e) : acc) es
-- | 把聚合调用换成对聚合结果的引用
rewriteAggs :: [(String, Expr)] -> Expr -> Expr
rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
(label : _) -> Col label
[] -> case e of
Construct tid arguments -> Construct tid (map go arguments)
BoundConstruct tid arguments -> BoundConstruct tid (map go arguments)
FunctionCall name arguments -> FunctionCall name (map go arguments)
BoundFunction fid tid arguments -> BoundFunction fid tid (map go arguments)
Add a b -> Add (go a) (go b)
Sub a b -> Sub (go a) (go b)
Mul a b -> Mul (go a) (go b)
@@ -49,22 +55,17 @@ rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
LtE a b -> LtE (go a) (go b)
NotEq a b -> NotEq (go a) (go b)
QuantCmp op a sq q -> QuantCmp op (go a) sq q
InSub a sq negated -> InSub (go a) sq negated
InList a values negated -> InList (go a) (map go values) negated
And a b -> And (go a) (go b)
Or a b -> Or (go a) (go b)
IsNull a -> IsNull (go a)
IsNotNull a -> IsNotNull (go a)
other -> other
where
-- \| 递归替换当前查询层的聚合引用
go = rewriteAggs aggs
-- | 过滤 + 分组:没有分组也没有聚合时原样返回
grouped :: [String] -> [(String, Expr)] -> RelOp -> (RelOp, [(String, Expr)])
grouped keys items base
| null keys && null aggs = (base, items)
| otherwise = (Aggregate keys aggs base, [(label, rewriteAggs aggs e) | (label, e) <- items])
where
aggs = nameAggs items
-- | 排序 + 截断
limited :: [(String, SortDir)] -> Maybe Int -> RelOp -> RelOp
limited orderBy mLimit op = case mLimit of
@@ -75,33 +76,70 @@ limited orderBy mLimit op = case mLimit of
[] -> op
spec -> Sort spec op
-- | 翻成:过滤 -> 分组 -> 排序 -> 截断 -> 取列
-- | 生成过滤、聚合、HAVING、排序和投影计划
translate :: Statement -> Either String RelOp
translate q = case q of
Select
{ selectCols = cols
, selectFrom = fromC
, selectWhere = mWhere
, selectGroupBy = groupBy
, selectOrderBy = orderBy
, selectLimit = mLimit
} -> do
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
let (plan, _) = grouped groupBy [] plan0
Right (Project cols (limited orderBy mLimit plan))
SelectExpr items fromC mWhere groupBy orderBy mLimit -> do
plan0 <- source fromC mWhere
let (plan, items') = grouped groupBy items plan0
Right $ if any (\(c, _) -> c `elem` map fst items') orderBy
then orderedProjection items' orderBy mLimit plan
else Compute items' (limited orderBy mLimit plan)
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)] -> [(String, SortDir)] -> Maybe Int -> RelOp -> RelOp
orderedProjection :: [(String, Expr)] -> [(Expr, SortDir)] -> Maybe Int -> RelOp -> RelOp
orderedProjection items orderBy mLimit plan =
Compute items (limited ordering mLimit (Compute (carried ++ keys) plan))
where
carried = [(column, Col column) | column <- nub (concatMap (colsInExpr . snd) items)]
keys = [("$order" ++ show n, maybe (Col c) id (lookup c items)) | (n, (c, _)) <- zip [1 :: Int ..] orderBy]
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)]
@@ -1,7 +1,8 @@
module ChuSQL.Core.Engine.Algebra.Sort (sortRows, compareValue) where
module ChuSQL.Core.Engine.Algebra.Sort (sortRows, sortBoundRows, compareValue) where
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Algebra.Expr (evalExpr)
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Model
import Data.List (sortBy)
-- 排序:按多列规格排出结果行,每列可升可降。
@@ -17,9 +18,9 @@ sortKey :: [(String, SortDir)] -> Row -> [Maybe Value]
sortKey spec row = [lookup col row | (col, _) <- spec]
-- | 比较两个排序键
compareKeys :: [(String, SortDir)] -> [Maybe Value] -> [Maybe Value] -> Ordering
compareKeys :: [SortDir] -> [Maybe Value] -> [Maybe Value] -> Ordering
compareKeys [] _ _ = EQ
compareKeys ((_, dir) : rest) (a : as) (b : bs) =
compareKeys (dir : rest) (a : as) (b : bs) =
case (a, b) of
(Just v1, Just v2) ->
case compareValue v1 v2 of
@@ -33,7 +34,22 @@ 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 spec k1 k2
-- \| 比较两个带键的行
cmp (k1, _) (k2, _) = compareKeys (map snd spec) k1 k2
-- | 用绑定槽位取键并稳定排序
sortBoundRows :: [(Expr, SortDir)] -> Row -> [Row] -> Either String [Row]
sortBoundRows [] _ rows = Right rows
sortBoundRows spec outer rows = do
decorated <- mapM decorate rows
Right (map snd (sortBy compareRows decorated))
where
directions = map snd spec
-- \| 每行只计算一次绑定排序键
decorate row = do
keys <- mapM (\(expression, _) -> evalExpr expression (row ++ outer)) spec
Right (map Just keys, row)
-- \| 比较排序键并保留同键行序
compareRows (left, _) (right, _) = compareKeys directions left right
@@ -1,25 +1,26 @@
module ChuSQL.Core.Engine.Builtin
( Builtin (..)
, builtinNames
, resolveBuiltin
, builtinName
, invokeBuiltin
, builtinOfExpr
, builtinNode
, aggregateArg
, unsupportedAggregate
, Operator (..)
, operatorOfExpr
, operatorSymbol
, operatorOfCompare
, compareNode
, executeOperator
, threeValuedNot
, inValues
) where
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.Model (Value (..), compareValue)
import ChuSQL.Core.Engine.Syntax.AST (CompareOp (..), Expr (..))
import ChuSQL.Core.Model (ColumnType (..), Value (..), compareValue, hasTypeCapability)
import ChuSQL.Core.Runtime (TypeCapability (..), builtinTypes, validateValue)
import Control.Monad (foldM)
import Data.Char (toLower)
@@ -201,12 +202,12 @@ compareNode CmpLtE = LtE
executeOperator :: Operator -> [Value] -> Either String Value
executeOperator op vs = case (op, vs) of
(OpNeg, [x]) -> evalNeg x
(OpGt, [x, y]) -> compareValues (== GT) x y
(OpLt, [x, y]) -> compareValues (< EQ) x y
(OpEq, [x, y]) -> compareValues (== EQ) x y
(OpGtE, [x, y]) -> compareValues (>= EQ) x y
(OpLtE, [x, y]) -> compareValues (<= EQ) x y
(OpNe, [x, y]) -> compareValues (/= EQ) x y
(OpGt, [x, y]) -> compareValues OrdCapability (== GT) x y
(OpLt, [x, y]) -> compareValues OrdCapability (< EQ) x y
(OpEq, [x, y]) -> compareValues EqCapability (== EQ) x y
(OpGtE, [x, y]) -> compareValues OrdCapability (>= EQ) x y
(OpLtE, [x, y]) -> compareValues OrdCapability (<= EQ) x y
(OpNe, [x, y]) -> compareValues EqCapability (/= EQ) x y
(OpAnd, [x, y]) -> andValues x y
(OpOr, [x, y]) -> orValues x y
(_, [x, y]) | Just a <- arithOf op -> evalArith a x y
@@ -246,12 +247,12 @@ evalArith ops x y = case (asDouble x, asDouble y) of
divArith :: Arith
divArith = Arith intDiv floatDiv
where
-- | 整数除法:除零与溢出都报错
-- \| 整数除法:除零与溢出都报错
intDiv _ 0 = Left "division by zero"
intDiv x y
| x == minBound && y == -1 = Left "integer division overflow"
| otherwise = Right (x `quot` y)
-- | 浮点除法:不能除以零
-- \| 浮点除法:不能除以零
floatDiv _ 0 = Left "division by zero"
floatDiv x y = Right (x / y)
@@ -262,21 +263,26 @@ asDouble (VFloat d) = Just d
asDouble _ = Nothing
-- | 比较两个值:NULL 给 NULL,其余按全序比
compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
compareValues rel x y
compareValues :: TypeCapability -> (Ordering -> Bool) -> Value -> Value -> Either String Value
compareValues capability rel x y
| x == VNull || y == VNull = Right VNull
| comparableValue x y = Right (VBool (rel (compareValue x y)))
| comparableValue capability x y = Right (VBool (rel (compareValue x y)))
| otherwise = Left "type error: cannot compare these values"
-- | 两个值是否落在可以用全序比较的同一族里
comparableValue :: Value -> Value -> Bool
comparableValue (VInt _) (VFloat _) = True
comparableValue (VFloat _) (VInt _) = True
comparableValue (VInt _) (VInt _) = True
comparableValue (VFloat _) (VFloat _) = True
comparableValue (VStr _) (VStr _) = True
comparableValue (VBool _) (VBool _) = True
comparableValue _ _ = False
comparableValue :: TypeCapability -> Value -> Value -> Bool
comparableValue _ (VInt _) (VFloat _) = True
comparableValue _ (VFloat _) (VInt _) = True
comparableValue _ (VInt _) (VInt _) = True
comparableValue _ (VFloat _) (VFloat _) = True
comparableValue _ (VStr _) (VStr _) = True
comparableValue _ (VBool _) (VBool _) = True
comparableValue capability (VRuntime left x) (VRuntime right y) =
left == right
&& hasTypeCapability capability (CRuntime left)
&& validateValue builtinTypes left x == Right ()
&& validateValue builtinTypes right y == Right ()
comparableValue _ _ _ = False
-- | 逻辑与的三值真值表
andValues :: Value -> Value -> Either String Value
@@ -303,8 +309,9 @@ threeValuedNot :: Value -> Value
threeValuedNot (VBool b) = VBool (not b)
threeValuedNot _ = VNull
-- | IN 三值逻辑:命中为真,碰 NULL 得 NULL
-- | IN 空集为假,非空集按三值逻辑比较
inValues :: Value -> [Value] -> Either String Value
inValues _ [] = Right (VBool False)
inValues VNull _ = Right VNull
inValues v vs = do
results <- mapM (\x -> executeOperator OpEq [v, x]) vs
@@ -0,0 +1,235 @@
module ChuSQL.Core.Engine.Domain (
domainColumns,
domainDefinition,
canonicalDomain,
effectiveColumns,
domainCheckPlan,
runDomainChecks,
validateDomainDefaults,
prepareDomainAlter,
) where
import ChuSQL.Core.Engine.Algebra.Expr (evalExpr)
import ChuSQL.Core.Engine.Runtime.Relation (orderRow)
import ChuSQL.Core.Engine.Semantic (prepareDomainCheckExpression)
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
import ChuSQL.Core.Model
import Control.Applicative ((<|>))
import Control.Monad (when)
import Data.Char (isAlphaNum, isAscii, toLower)
import Data.List (isPrefixOf, nub)
import Data.Maybe (fromMaybe)
-- 领域元数据、约束继承、默认值及结构变更的纯校验。
-- | 将领域定义编码为目录列
domainColumns :: DomainDefinition -> [(String, Column)]
domainColumns (DomainDefinition base checks) =
("base", base{columnCheck = Nothing})
: [("check_" ++ name, (plainColumn CBool){columnCheck = Just text}) | (name, text) <- checks]
-- | 从新旧目录恢复领域定义
domainDefinition :: Table -> Either String DomainDefinition
domainDefinition table = do
base <- maybe (Left "invalid domain catalog: missing base") Right (lookup "base" (tableCols table))
checks <- mapM readCheck [(name, col) | (name, col) <- tableCols table, name /= "base"]
let legacy = maybe [] (\text -> [("domain_check_0", text)]) (columnCheck base)
Right (DomainDefinition base{columnCheck = Nothing} (legacy ++ checks))
where
-- \| 恢复一条具名检查条件
readCheck (name, col)
| "check_" `isPrefixOf` name, Just text <- columnCheck col = Right (drop 6 name, text)
| otherwise = Left "invalid domain constraint catalog"
-- | 为匿名约束命名并验证完整定义
canonicalDomain :: Database -> String -> DomainDefinition -> Either String DomainDefinition
canonicalDomain db name definition = do
normalized <- normalize definition
let candidate = install name normalized db
validateOwn candidate name
Right normalized
where
-- \| 规范化约束名称并拒绝重复声明
normalize (DomainDefinition base checks) = do
when
(columnAutoIncrement base || columnUnique base || columnPrimaryKey base)
(Left "DOMAIN does not support row-set constraints")
let named = [map toLower key | (key, _) <- checks, not (null key)]
when (length named /= length (nub named)) (Left "duplicate domain constraint name")
mapM_ validName named
assigned <- assign named 1 checks
Right (DomainDefinition base assigned)
-- \| 验证约束标识符
validName key
| null key || length key > 48 || not (all (\c -> isAscii c && (isAlphaNum c || c == '_')) key) =
Left "invalid domain constraint name"
| otherwise = Right ()
-- \| 为未命名约束分配稳定名称
assign _ _ [] = Right []
assign used index ((key, text) : rest)
| null key =
let (chosen, next) = fresh used index
in ((chosen, text) :) <$> assign (chosen : used) next rest
| otherwise = ((map toLower key, text) :) <$> assign used index rest
-- \| 跳过已有的自动约束名称
fresh used index
| chosen `elem` used = fresh used (index + 1)
| otherwise = (chosen, index + 1)
where
chosen = "domain_check_" ++ show (index :: Int)
-- | 在纯目录中安装候选领域定义
install :: String -> DomainDefinition -> Database -> Database
install name definition db = (key, table{tableCols = domainColumns definition}) : filter ((/= key) . fst) db
where
key = domainTableName name
table = fromMaybe (Table key [] [] Nothing Nothing Nothing) (lookup key db)
-- | 沿目录解析领域链并拒绝循环
chain :: Database -> ColumnType -> Either String [(String, DomainDefinition)]
chain db = go []
where
-- \| 逐层读取当前定义而非缓存属性
go seen (CDomain name _)
| name `elem` seen = Left ("cyclic domain definition: " ++ name)
| otherwise = do
table <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
definition@(DomainDefinition base _) <- domainDefinition table
rest <- go (name : seen) (columnType base)
Right ((name, definition) : rest)
go _ _ = Right []
-- | 合并列声明与继承的非空和默认值
effectiveColumns :: Database -> [(String, Column)] -> Either String [(String, Column)]
effectiveColumns db = mapM effective
where
-- \| 保留最近默认值并收紧可空属性
effective (name, column) = do
definitions <- chain db (columnType column)
let bases = [base | (_, DomainDefinition base _) <- definitions]
Right
( name
, column
{ columnNullable = columnNullable column && all columnNullable bases
, columnDefault = foldl (<|>) (columnDefault column) (map columnDefault bases)
}
)
-- | 绑定领域 VALUE 到独立的单值布局
domainCheckPlan :: Database -> [(String, Column)] -> Either String [(String, Int, Expr)]
domainCheckPlan db columns = concat <$> mapM checks (zip [0 ..] columns)
where
-- \| 按基础领域到外层领域绑定条件
checks (slot, (_, column)) = do
definitions <- chain db (columnType column)
mapM
(bind slot column)
[ (name ++ "." ++ key, text)
| (name, DomainDefinition _ constraints) <- reverse definitions
, (key, text) <- constraints
]
-- \| 拒绝聚合及子查询并固定类型槽位
bind slot column (name, text) = do
expression <- parseExpression text
bound <- prepareDomainCheckExpression (columnType column) expression
Right (name, slot, bound)
-- | SQL CHECK 的 UNKNOWN 与 TRUE 都通过
runDomainChecks :: [(String, Int, Expr)] -> Row -> Either String ()
runDomainChecks plan row = mapM_ check plan
where
-- \| 在单值作用域执行一条领域约束
check (name, slot, expression) = case drop slot row of
(_, value) : _ -> do
result <- evalExpr expression [("value", value)]
case result of
VBool True -> Right ()
VNull -> Right ()
VBool False -> Left ("CHECK on DOMAIN " ++ name ++ " failed")
_ -> Left ("CHECK on DOMAIN " ++ name ++ " is not boolean")
[] -> Left "missing bound domain value"
-- | 检查有效默认值是否满足领域约束
validateDomainDefaults :: Database -> [(String, Column)] -> Either String ()
validateDomainDefaults db columns = do
effective <- effectiveColumns db columns
mapM_ validate [entry | entry@(_, column) <- effective, CDomain{} <- [columnType column]]
where
-- \| 默认值不改变已有行但必须可赋值
validate entry@(name, column) = case columnDefault column of
Nothing -> Right ()
Just value -> do
coerced <- coerceValue (columnType column) value
checkNull name column coerced
plan <- domainCheckPlan db [entry]
runDomainChecks plan [(name, coerced)]
-- | 拒绝领域或列要求非空时的 NULL
checkNull :: String -> Column -> Value -> Either String ()
checkNull name column value
| value == VNull && not (columnNullable column) = Left ("DOMAIN NOT NULL: " ++ name)
| otherwise = Right ()
-- | 检查领域本身的定义及继承默认值
validateOwn :: Database -> String -> Either String ()
validateOwn db name = do
table <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
DomainDefinition base _ <- domainDefinition table
let columns = [("value", plainColumn (CDomain name (columnType base)))]
_ <- domainCheckPlan db columns
validateDomainDefaults db columns
-- | 在完整快照上校验并生成领域替换定义
prepareDomainAlter :: String -> DomainAlter -> Database -> Either String [(String, Column)]
prepareDomainAlter rawName action db = do
table <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
definition <- domainDefinition table >>= change
normalized <- canonicalDomain db name definition
let candidate = install name normalized db
mapM_ (validateDependent candidate) [key | (key, _) <- candidate, isDomainTable key]
mapM_ (validateTable candidate) [(key, value) | (key, value) <- candidate, not (isDomainTable key)]
Right (domainColumns normalized)
where
name = map toLower rawName
-- \| 修改单个属性且保留其他约束
change (DomainDefinition base checks) = case action of
DomainDefault value -> Right (DomainDefinition base{columnDefault = value} checks)
DomainNullable nullable -> Right (DomainDefinition base{columnNullable = nullable} checks)
DomainAddCheck key text -> Right (DomainDefinition base (checks ++ [(fromMaybe "" key, text)]))
DomainDropCheck key
| map toLower key `elem` map fst checks -> Right (DomainDefinition base (filter ((/= map toLower key) . fst) checks))
| otherwise -> Left ("unknown domain constraint: " ++ key)
-- \| 判断传递引用是否包含目标领域
affected candidate ty = any ((== name) . fst) <$> chain candidate ty
-- \| 校验依赖领域的继承默认值
validateDependent candidate key = do
let domain = drop (length (domainTableName "")) key
applies <- affected candidate (CDomain domain CStr)
when applies (validateOwn candidate domain)
-- \| 只校验受领域变化影响的列与数据
validateTable candidate (_, table) = do
selected <-
mapM
( \entry@(_, column) -> do
applies <- affected candidate (columnType column)
Right [entry | applies]
)
(tableCols table)
let columns = concat selected
effective <- effectiveColumns candidate columns
validateDomainDefaults candidate columns
plan <- domainCheckPlan candidate columns
mapM_ (validateRow effective plan) (tableRows table)
-- \| 按列布局检查非空与全部继承条件
validateRow columns plan row = do
selected <- orderRow (map fst columns) row
values <-
mapM
( \((key, column), (_, value)) -> do
coerced <- coerceValue (columnType column) value
checkNull key column coerced
Right (key, coerced)
)
(zip columns selected)
runDomainChecks plan values
@@ -1,12 +1,12 @@
module ChuSQL.Core.Engine.Error
( ErrorCategory (..)
, ErrorRule (..)
, errorRules
, errorCategory
, errorCode
, errorLike
, accountErrorCode
) where
module ChuSQL.Core.Engine.Error (
ErrorCategory (..),
ErrorRule (..),
errorRules,
errorCategory,
errorCode,
errorLike,
accountErrorCode,
) where
import Data.List (isInfixOf)
@@ -33,8 +33,14 @@ data ErrorRule = ErrorRule
-- | 唯一的错误识别表,顺序即优先级
errorRules :: [ErrorRule]
errorRules =
[ ErrorRule "no database selected" NoDatabaseError "no_database"
[ ErrorRule "deadlock_detected:" StorageError "deadlock_detected"
, ErrorRule "lock_timeout:" StorageError "lock_timeout"
, ErrorRule "serialization_failure:" CatalogError "serialization_failure"
, ErrorRule "no database selected" NoDatabaseError "no_database"
, ErrorRule "administrator required" PermissionError "forbidden"
, ErrorRule "serialization_failure: domain snapshot changed" CatalogError "serialization_failure"
, ErrorRule "bound query object changed" CatalogError "serialization_failure"
, ErrorRule "bound query schema changed" CatalogError "serialization_failure"
, ErrorRule "unknown table" CatalogError "not_found"
, ErrorRule "unknown domain" CatalogError "not_found"
, ErrorRule "domain is still used" CatalogError "query_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
@@ -6,8 +6,10 @@ module ChuSQL.Core.Engine.Parallel (
) where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, takeMVar)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Control.Concurrent.MVar (MVar, modifyMVar, newEmptyMVar, newMVar, putMVar, takeMVar)
import Control.Exception (SomeException, throwIO, try)
import Control.Monad (forever, join)
import System.IO.Unsafe (unsafePerformIO)
-- 并行执行:常驻工作线程池,结果按提交顺序收回。
@@ -16,13 +18,11 @@ import System.IO.Unsafe (unsafePerformIO)
parallelShardLimit :: Int
parallelShardLimit = 8
-- | 池:待办队列与唤醒信号
data Pool = Pool
{ poolJobs :: MVar [IO ()]
, poolReady :: MVar ()
}
-- | 池:工作线程共享的待办队列
newtype Pool = Pool (Chan (IO ()))
{-# NOINLINE poolRef #-}
-- | 进程全局的池,按容量复用
poolRef :: MVar (Maybe (Int, Pool))
poolRef = unsafePerformIO (newMVar Nothing)
@@ -31,42 +31,33 @@ poolRef = unsafePerformIO (newMVar Nothing)
workerPool :: Int -> IO Pool
workerPool size = modifyMVar poolRef reuse
where
-- | 现有池够大就留着,否则换新的
-- \| 复用队列并按需补充工作线程
reuse current = case current of
Just (capacity, pool)
Just (capacity, pool@(Pool jobs))
| capacity >= wanted -> pure (current, pool)
_ -> do
| otherwise -> do
sequence_ [forkIO (worker jobs) | _ <- [capacity + 1 .. wanted]]
pure (Just (wanted, pool), pool)
Nothing -> do
pool <- startPool wanted
pure (Just (wanted, pool), pool)
-- | 池的线程数至少一个
-- \| 池的线程数至少一个
wanted = max 1 size
-- | 起 wanted 个常驻线程吃队列
-- \| 起 wanted 个常驻线程吃队列
startPool n = do
jobs <- newMVar []
ready <- newMVar ()
sequence_ [forkIO (worker jobs ready) | _ <- [1 .. n]]
pure (Pool jobs ready)
jobs <- newChan
sequence_ [forkIO (worker jobs) | _ <- [1 .. n]]
pure (Pool jobs)
-- | 一个工作线程:被唤醒一次就取一个待办
worker :: MVar [IO ()] -> MVar () -> IO ()
worker jobs ready = do
takeMVar ready
job <- modifyMVar jobs pick
case job of
Nothing -> worker jobs ready
Just act -> act >> worker jobs ready
where
-- | 取队首,空队列就回 Nothing
pick [] = pure ([], Nothing)
pick (j : js) = pure (js, Just j)
-- | 一个工作线程:等待并执行队首待办
worker :: Chan (IO ()) -> IO ()
worker jobs = forever (join (readChan jobs))
-- | 往池里丢一个待办
submit :: Pool -> IO () -> IO ()
submit pool job = do
modifyMVar_ (poolJobs pool) (pure . (++ [job]))
putMVar (poolReady pool) ()
submit (Pool jobs) = writeChan jobs
-- | 跑一个动作,结果或异常都填进格子
fillCell :: MVar (Either SomeException a) -> IO a -> IO ()
@@ -0,0 +1,209 @@
module ChuSQL.Core.Engine.Runtime.Binding (
Expression (..),
TypedExpression,
expressionType,
bindExpression,
evaluateExpression,
Plan (..),
TypedPlan,
planSchema,
bindPlan,
executePlan,
) where
import ChuSQL.Core.Engine.Runtime.Functions
import ChuSQL.Core.Engine.Runtime.Types
import Control.Monad (filterM)
import Data.List (nub, sort)
-- 仅依据 schema 绑定表达式与查询,执行已解析的类型和函数身份。
-- | 表达未绑定的类型化语言
data Expression
= Literal TypeExpr RuntimeValue
| Reference String
| Apply String [Expression]
| ListLiteral TypeExpr [Expression]
| NothingLiteral TypeExpr
| JustLiteral Expression
| TupleLiteral [Expression]
deriving (Show, Eq)
-- | 保存绑定后的表达式节点
data 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,131 @@
module ChuSQL.Core.Engine.Runtime.Dependencies (queryTables, domainDependencies, typeDependencies, validateDependencies) where
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Model (ColumnType (..), Database, columnType, domainTableName, lastTablePart, tableCols, tableIdentity, tableSchemaVersion)
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,97 @@
module ChuSQL.Core.Engine.Runtime.Functions (
FunctionId (..),
FunctionSignature (..),
FunctionRegistry,
builtinFunctions,
resolveFunction,
resolveNullableFunction,
functionSignature,
invokeFunction,
) where
import ChuSQL.Core.Engine.Runtime.Types
import Control.Monad (zipWithM_)
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,86 @@
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.Runtime.Dependencies (domainDependencies, queryTables, validateDependencies)
import ChuSQL.Core.Engine.Runtime.Relation (bindRelOpColumns)
import ChuSQL.Core.Engine.Runtime.SQL (sqlType)
import ChuSQL.Core.Engine.Runtime.Types (TypeId)
import ChuSQL.Core.Engine.Semantic (prepare, querySchema)
import ChuSQL.Core.Engine.Storage (MonadStorage (schema, withSchemaGuard))
import ChuSQL.Core.Engine.Syntax.AST (Statement)
import ChuSQL.Core.Model
-- SQL 查询绑定边界:保存解析后的类型、函数身份及输出 schema。
-- | 保存运行时或兼容列类型
data QueryType
= RuntimeType TypeId
| CompatibilityType ColumnType
| DomainType String QueryType
| NullType
deriving (Show, Eq)
-- | 保存仅由 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,154 @@
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,101 @@
module ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, invokeSQLFunction, sqlType, constructSQLValue) where
import ChuSQL.Core.Engine.Runtime.Functions
import ChuSQL.Core.Engine.Runtime.Types
import ChuSQL.Core.Model (ColumnType (..), Value (..))
import Control.Monad (zipWithM_)
-- 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
-- 导出共享的运行时类型身份和物理编码契约。
@@ -1,9 +1,16 @@
module ChuSQL.Core.Engine.Semantic (check, prepare) where
{-# LANGUAGE TupleSections #-}
import ChuSQL.Core.Engine.Algebra.Expr (bareColumns, colsInExpr, hasAggregate)
import ChuSQL.Core.Model
module ChuSQL.Core.Engine.Semantic (check, prepare, prepareRowExpression, prepareCheckExpression, prepareDomainCheckExpression, querySchema) where
import ChuSQL.Core.Engine.Algebra.Expr (bareColumns, colsInExpr, hasAggregate, hasSubquery)
import ChuSQL.Core.Engine.Runtime.Functions (FunctionSignature (..), builtinFunctions, functionSignature)
import ChuSQL.Core.Engine.Runtime.Relation (bindSlots)
import ChuSQL.Core.Engine.Runtime.SQL (resolveSQLFunction, sqlResultType, sqlType)
import ChuSQL.Core.Engine.Runtime.Types
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Engine.Syntax.Parser (parseExpression)
import ChuSQL.Core.Model
import Control.Monad (void)
import Data.Char (isAlphaNum, isAscii, toLower)
import Data.List (intercalate, isInfixOf, isPrefixOf, isSuffixOf, nub)
@@ -21,24 +28,35 @@ prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
where
prefix = maybe "" (++ ".") mAlias
-- | 检查期的作用域:本层优先,外层兜底
-- | 从 schema 推导查询输出列
querySchema :: Database -> Statement -> Either String [(String, Column)]
querySchema db statement = do
columns <- inferSubqueryOutput db (Scope [] []) (Subquery statement [])
Right [(name, plainColumn (derivedType ty)) | (name, ty) <- columns]
-- | 从最近层到最远层保存外部作用域
type EnclosingScopes = [[(String, Column)]]
-- | 保存本层与各层外部列
data Scope = Scope
{ scopeInner :: [(String, Column)]
, scopeOuter :: [(String, Column)]
, scopeOuter :: EnclosingScopes
}
-- | 本层先查,查不到再落外层;本层同名引起歧义时不往外层让
-- | 逐层解析列,本层歧义不向外层回退
scopeAt :: String -> Scope -> String -> Either String (String, Column)
scopeAt place scope c
| null (scopeOuter scope) = columnAt place (scopeInner scope) c
| otherwise = case columnAt place (scopeInner scope) c of
scopeAt place scope c = search (scopeFrames scope)
where
-- \| 在最近的可见列层停止查找
search [] = Left (missingColumn place c (concat (scopeFrames scope)))
search (columns : rest) = case columnAt place columns c of
Right entry -> Right entry
Left err
| "ambiguous column:" `isInfixOf` err -> Left err
| otherwise -> columnAt place (scopeOuter scope) c
| otherwise -> search rest
-- | 收集 FROM 的列,列前缀由表名推导
checkFrom :: Database -> [(String, Column)] -> FromClause -> Either String [(String, Column)]
checkFrom :: Database -> EnclosingScopes -> FromClause -> Either String [(String, Column)]
checkFrom _ _ FromUnit = Right []
checkFrom db _ (FromTable mAlias tbl) = do
(key, t) <- resolveTable db tbl
@@ -63,13 +81,9 @@ inferredColumnType :: ColumnType -> InferredType
inferredColumnType CNull = InferNull
inferredColumnType ty = InferType ty
-- | 合并两层列,本层优先且不重复
scopedEnv :: [(String, Column)] -> [(String, Column)] -> [(String, Column)]
scopedEnv env outer = env ++ [o | o <- outer, o `notElem` env]
-- | 把作用域摊平成一层的列清单
scopeFlat :: Scope -> [(String, Column)]
scopeFlat scope = scopedEnv (scopeInner scope) (scopeOuter scope)
-- | 进入子查询时保留每层的列边界
scopeFrames :: Scope -> EnclosingScopes
scopeFrames scope = scopeInner scope : scopeOuter scope
-- | 拼“列不存在”的报错
missingColumn :: String -> String -> [(String, Column)] -> String
@@ -82,7 +96,7 @@ missingColumn place c env =
-- | 检查列是否都在环境里
checkColumns :: String -> Scope -> [String] -> Either String ()
checkColumns place env = mapM_ (\c -> if c == allColumns then Right () else () <$ scopeAt place env c)
checkColumns place env = mapM_ (\c -> if c == allColumns then Right () else void (scopeAt place env c))
-- | 在一层里查一列,报错时带上子句名与可用列
columnAt :: String -> [(String, Column)] -> String -> Either String (String, Column)
@@ -98,17 +112,24 @@ checkNoAggregate place e
| otherwise = Right ()
-- | 分组查询里,没被聚合的列必须出现在 GROUP BY 里
checkGrouping :: Scope -> [String] -> [(String, Expr)] -> Either String ()
checkGrouping env keys items
| null keys && not (any (hasAggregate . snd) items) = Right ()
checkGrouping :: Scope -> [String] -> [(String, Expr)] -> Maybe Expr -> Either String ()
checkGrouping env keys items having
| null keys && null having && not (any (hasAggregate . snd) items) = Right ()
| otherwise = do
checkColumns "GROUP BY" env keys
mapM_ okCol (nub (concatMap (bareColumns . snd) items))
mapM_
( \column -> do
(_, definition) <- scopeAt "GROUP BY" env column
void (requireHashing "GROUP BY" (InferType (columnType definition)))
)
keys
mapM_ okCol (nub (concatMap (bareColumns . snd) items ++ concatMap bareColumns having))
where
-- | 这一列能不能出现在分组查询里
-- \| 这一列能不能出现在分组查询里
okCol c
| c == allColumns = Left "SELECT: * cannot be selected together with GROUP BY"
| c `elem` keys = Right ()
| Left _ <- resolveColumn c (scopeInner env) = Right ()
| otherwise = Left ("SELECT: column " ++ c ++ " must appear in GROUP BY or be aggregated")
-- | 渲染一个推导类型
@@ -119,6 +140,8 @@ renderType (InferType t) = typeLabel t
-- | 推导表达式的类型(子查询也在这里整条查一遍)
inferExpr :: Database -> String -> Scope -> Expr -> Either String InferredType
inferExpr _ place env (Col c) = inferredColumnType . columnType . snd <$> scopeAt place env c
inferExpr _ _ _ ColumnSlot{} = Left "execution column cannot be used in semantic input"
inferExpr _ _ _ OuterColumnSlot{} = Left "execution column cannot be used in semantic input"
inferExpr _ _ _ LitNull = Right InferNull
inferExpr _ _ _ (LitInt _) = Right (InferType CInt)
inferExpr _ _ _ (LitFloat _) = Right (InferType CFloat)
@@ -127,6 +150,23 @@ inferExpr _ _ _ (LitBool _) = Right (InferType CBool)
inferExpr _ _ _ (LitDate _) = Right (InferType CDate)
inferExpr _ _ _ (LitTimestamp _) = Right (InferType CTimestamp)
inferExpr _ _ _ (LitBlob _) = Right (InferType CBlob)
inferExpr db place env (Construct ty arguments) = InferType . CRuntime <$> inferConstruction db place env ty arguments
inferExpr db place env (BoundConstruct tid arguments) = do
inferred <- inferConstruction db place env (typeExpression tid) arguments
if inferred == tid then Right (InferType (CRuntime tid)) else Left "constructor result identity mismatch"
inferExpr _ _ _ (RuntimeLiteral tid value) = validateValue builtinTypes tid value >> Right (InferType (CRuntime tid))
inferExpr db place env (FunctionCall name arguments) = do
inferred <- mapM (inferExpr db place env) arguments
sig <- resolveSQLFunction name (map inferredArgument inferred)
InferType <$> sqlResultType (signatureResult sig)
inferExpr db place env (BoundFunction fid tid arguments) = do
functions <- builtinFunctions builtinTypes
expected <- functionSignature functions fid
inferred <- mapM (inferExpr db place env) arguments
resolved <- resolveSQLFunction (signatureName expected) (map inferredArgument inferred)
if signatureId resolved == fid && signatureResult resolved == tid
then InferType <$> sqlResultType tid
else Left "bound function signature identity mismatch"
inferExpr db place env (Add a b) = arithmetic db place env a b
inferExpr db place env (Sub a b) = arithmetic db place env a b
inferExpr db place env (Mul a b) = arithmetic db place env a b
@@ -138,12 +178,12 @@ inferExpr db place env (Neg a) = do
InferType x
| numericType x -> Right t
| otherwise -> Left (place ++ ": operator needs TInt on both sides, got TInt and " ++ typeLabel x)
inferExpr db place env (Gt a b) = comparison db place env a b
inferExpr db place env (Lt a b) = comparison db place env a b
inferExpr db place env (Eq a b) = comparison db place env a b
inferExpr db place env (GtE a b) = comparison db place env a b
inferExpr db place env (LtE a b) = comparison db place env a b
inferExpr db place env (NotEq a b) = comparison db place env a b
inferExpr db place env (Gt a b) = comparison OrdCapability db place env a b
inferExpr db place env (Lt a b) = comparison OrdCapability db place env a b
inferExpr db place env (Eq a b) = comparison EqCapability db place env a b
inferExpr db place env (GtE a b) = comparison OrdCapability db place env a b
inferExpr db place env (LtE a b) = comparison OrdCapability db place env a b
inferExpr db place env (NotEq a b) = comparison EqCapability db place env a b
inferExpr db place env (And a b) = boolean db place env a b
inferExpr db place env (Or a b) = boolean db place env a b
inferExpr db place env (IsNull a) = inferExpr db place env a >> Right (InferType CBool)
@@ -160,8 +200,8 @@ inferExpr db place env (AvgOf a) = do
InferType x
| numericType x -> Right (InferType CFloat)
| otherwise -> Left (place ++ ": AVG needs a number, got " ++ typeLabel x)
inferExpr db place env (MinOf a) = aggregateArg db place env a
inferExpr db place env (MaxOf a) = aggregateArg db place env a
inferExpr db place env (MinOf a) = aggregateArg db place env a >>= requireOrdering "MIN"
inferExpr db place env (MaxOf a) = aggregateArg db place env a >>= requireOrdering "MAX"
inferExpr db place env (ScalarSub sq) = do
cols <- inferSubqueryOutput db env sq
case cols of
@@ -181,12 +221,15 @@ inferExpr db place env (InList a es _) = do
mapM_ (itemType place ta) ts
Right (InferType CBool)
inferExpr _ _ _ (ExistsSub _ _) = Right (InferType CBool)
inferExpr db place env (QuantCmp _ a sq q) = do
inferExpr db place env (QuantCmp operator a sq q) = do
ta <- inferExpr db place env a
cols <- inferSubqueryOutput db env sq
case cols of
[(_, t)]
| compatible ta t -> Right (InferType CBool)
| compatible ta t -> do
let capability = if operator `elem` [CmpEq, CmpNe] then EqCapability else OrdCapability
mapM_ (requireCapability capability place) [ta, t]
Right (InferType CBool)
| otherwise -> Left (place ++ ": " ++ quantLabel q ++ " subquery column has type " ++ renderType t ++ ", expected " ++ renderType ta)
_ -> Left (place ++ ": " ++ quantLabel q ++ " subquery must return exactly one column")
@@ -203,22 +246,20 @@ itemType place want got
-- | 推导子查询的输出列与类型
inferSubqueryOutput :: Database -> Scope -> Subquery -> Either String [(String, InferredType)]
inferSubqueryOutput _ _ BoundSubquery{} = Left "execution subquery cannot be used in semantic input"
inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
q@Select { selectCols = cols } -> do
SelectDistinct q -> do
columns <- inferSubqueryOutput db outerScope sq{subqueryStatement = q}
mapM_ (requireHashing "DISTINCT" . snd) columns
_ <- distinctOrdering q
Right columns
q@Select{selectItems = items} -> do
env <- checkFrom db enclosing (selectFrom q)
checkResolvedWith db enclosing q
mapM (columnTypeOf env) cols
q@SelectExpr { selectItems = items } -> do
env <- checkFrom db enclosing (selectFrom q)
checkResolvedWith db enclosing q
mapM (\(l, e) -> (\t -> (l, t)) <$> inferExpr db "SELECT" (Scope env enclosing) e) items
mapM (\(l, e) -> (l,) <$> inferExpr db "SELECT" (Scope env enclosing) e) items
_ -> Left "subquery must be a SELECT"
where
enclosing = scopeFlat outerScope
-- | 查这一列的推导类型
columnTypeOf env c = do
(_, col) <- scopeAt "SELECT" (Scope env enclosing) c
Right (c, inferredColumnType (columnType col))
enclosing = scopeFrames outerScope
-- | 聚合的参数:列要在,且不能嵌套聚合
aggregateArg :: Database -> String -> Scope -> Expr -> Either String InferredType
@@ -251,7 +292,7 @@ arithmetic db place env a b = do
mapM_ (numericOperand place (InferType want) (InferType want)) [ta, tb]
Right (arithResult ta tb)
where
-- | 是不是浮点类型
-- \| 是不是浮点类型
isFloatSide (InferType x) = numericType x && not (integerType x)
isFloatSide _ = False
@@ -263,12 +304,14 @@ numericOperand place want other t = case t of
_ -> Left (place ++ ": operator needs " ++ renderType want ++ " on both sides, got " ++ renderType other ++ " and " ++ renderType t)
-- | 比较两边的类型检查
comparison :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
comparison db place env a b = do
comparison :: TypeCapability -> Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
comparison capability db place env a b = do
ta <- inferExpr db place env a
tb <- inferExpr db place env b
if compatible ta tb
then Right (InferType CBool)
then do
mapM_ (requireCapability capability place) [ta, tb]
Right (InferType CBool)
else Left (place ++ ": both sides of = must have the same type, got " ++ renderType ta ++ " and " ++ renderType tb)
-- | 两类能不能比,类型族规则来自 Model
@@ -285,7 +328,7 @@ boolean db place env a b = do
mapM_ (boolOperand place ta) [ta, tb]
Right (InferType CBool)
where
-- | 挨个查操作数是不是布尔
-- \| 挨个查操作数是不是布尔
boolOperand _ _ InferNull = Right ()
boolOperand _ _ (InferType ty) | typeClassOf ty == BooleanClass = Right ()
boolOperand p other t = Left (p ++ ": operator needs TBool on both sides, got " ++ renderType other ++ " and " ++ renderType t)
@@ -321,7 +364,7 @@ checkAssign db t = checkTyped db "UPDATE" (Scope (tableCols t) []) t
-- | 按语句类型分派检查
check :: Database -> Statement -> Either String ()
check db q = () <$ prepare db q
check db q = void (prepare db q)
-- | 执行前解析列名并检查类型
prepare :: Database -> Statement -> Either String Statement
@@ -330,7 +373,8 @@ prepare db q = do
let visible = filter (not . isDomainTable . fst) db
resolved <- resolveStatement visible typed
case resolved of
CreateDomain name base -> do
CreateDomain name (DomainDefinition column _) -> do
let base = columnType column
checkDomainName name
checkTypeParameters base
case base of
@@ -341,6 +385,9 @@ prepare db q = do
if any ((== domainTableName name) . fst) db
then Left ("domain already exists: " ++ name)
else Right ()
AlterDomain name _ -> do
_ <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
Right ()
DropDomain name -> do
_ <- maybe (Left ("unknown domain: " ++ name)) Right (lookup (domainTableName name) db)
if any (any (usesDomain name . columnType . snd) . tableCols . snd) db
@@ -386,19 +433,21 @@ ddlTargets statement = case statement of
-- | 从 schema 解析列上的命名类型
resolveDomainTypes :: Database -> Statement -> Either String Statement
resolveDomainTypes db statement = case statement of
CreateDomain name base -> CreateDomain name <$> resolveType base
CreateDomain name (DomainDefinition column checks) -> do
ty <- resolveDomainType (columnType column)
Right (CreateDomain name (DomainDefinition column{columnType = ty} checks))
CreateTable name cols -> CreateTable name <$> mapM resolveColumnType cols
AddColumn name col -> AddColumn name <$> resolveColumnType col
AlterColumnType name col ty -> AlterColumnType name col <$> resolveType ty
AlterColumnType name col ty -> AlterColumnType name col <$> resolveDomainType ty
_ -> Right statement
where
-- | 解析一列的类型
-- \| 解析一列的类型
resolveColumnType (name, col) = do
ty <- resolveType (columnType col)
Right (name, col {columnType = ty})
-- | 从类型目录取基础类型
resolveType = resolveWith []
-- | 递归解析类型并拒绝循环定义
ty <- resolveDomainType (columnType col)
Right (name, col{columnType = ty})
-- \| 从类型目录取基础类型
resolveDomainType = resolveWith []
-- \| 递归解析类型并拒绝循环定义
resolveWith seen (CDomain name _)
| map toLower name `elem` seen = Left ("cyclic domain definition: " ++ name)
| otherwise = do
@@ -413,33 +462,25 @@ checkResolved :: Database -> Statement -> Either String ()
checkResolved db = checkResolvedWith db []
-- | 检查已解析的语句;outer 是相关子查询能看见的外层列
checkResolvedWith :: Database -> [(String, Column)] -> Statement -> Either String ()
checkResolvedWith :: Database -> EnclosingScopes -> Statement -> Either String ()
checkResolvedWith db outer q = case q of
Select
{ selectCols = cols
, selectFrom = fromC
, selectWhere = mWhere
, selectGroupBy = groupBy
, selectOrderBy = orderBy
} -> do
SelectDistinct inner -> void (inferSubqueryOutput db (Scope [] outer) (Subquery (SelectDistinct inner) []))
Select items fromC mWhere groupBy having orderBy _ -> do
env <- checkFrom db outer fromC
let full = Scope env outer
checkColumns "SELECT" full cols
checkGrouping full groupBy (map (\c -> (c, Col c)) cols)
checkColumns "ORDER BY" full (map fst orderBy)
mapM_ (checkNoAggregate "WHERE") mWhere
mapM_ (checkBool db "WHERE" full) mWhere
SelectExpr items fromC mWhere groupBy orderBy _ -> do
env <- checkFrom db outer fromC
let full = Scope env outer
mapM_ (\item -> () <$ inferExpr db "SELECT" full (snd item)) items
checkGrouping full groupBy (items ++ [(c, Col c) | (c, _) <- orderBy, c `notElem` map fst items])
mapM_ (checkOrder full items . fst) orderBy
mapM_ (inferExpr db "SELECT" full . snd) items
ordering <- mapM (orderExpression items . fst) orderBy
mapM_ (checkBool db "HAVING" full) having
checkGrouping full groupBy (items ++ zip (map (show . fst) orderBy) ordering) having
mapM_ (checkOrder db full items . fst) orderBy
mapM_ (checkNoAggregate "WHERE") mWhere
mapM_ (checkBool db "WHERE" full) mWhere
Insert tbl cols rows -> do
t <- lookupTable db tbl
checkColumns "INSERT" (Scope (tableCols t) []) cols
case [name | name <- cols, length (filter (== name) cols) > 1] of
name : _ -> Left ("INSERT: duplicate target column: " ++ name)
[] -> Right ()
if null rows
then Left "INSERT: no values"
else mapM_ (mapM_ (checkValue db t) . zip cols) rows
@@ -460,16 +501,18 @@ checkResolvedWith db outer q = case q of
if length names /= length (nub names)
then Left ("CREATE TABLE: duplicate column names in " ++ name)
else Right ()
checkColumnDefs (map fst cols) cols
checkColumnDefs cols cols
DropTable name ->
if null name
then Left "DROP TABLE: empty table name"
else Right ()
CreateIndex tbl col -> do
t <- lookupTable db tbl
if col `elem` tableCols' t
then Right ()
else Left ("CREATE INDEX: unknown column: " ++ col)
case lookup col (tableCols t) of
Nothing -> Left ("CREATE INDEX: unknown column: " ++ col)
Just column
| typeClassOf (columnType column) == RuntimeClass -> Left "CREATE INDEX: runtime index key encoding is not registered"
| otherwise -> Right ()
DropIndex tbl col -> do
t <- lookupTable db tbl
if col `elem` tableCols' t
@@ -483,12 +526,14 @@ checkResolvedWith db outer q = case q of
if col == idColumn
then Left "DROP COLUMN: the built-in id column cannot be dropped"
else Right ()
let remaining = filter ((/= col) . fst) (tableCols t)
checkChecks remaining remaining
AddColumn tbl def -> do
t <- lookupTable db tbl
if fst def `elem` tableCols' t
then Left ("ADD COLUMN: column already exists: " ++ fst def)
else Right ()
checkColumnDefs (tableCols' t ++ [fst def]) [def]
checkColumnDefs (tableCols t ++ [def]) [def]
RenameColumn tbl old new -> do
t <- lookupTable db tbl
if old `notElem` tableCols' t
@@ -500,6 +545,8 @@ checkResolvedWith db outer q = case q of
if new `elem` tableCols' t
then Left ("RENAME COLUMN: column already exists: " ++ new)
else Right ()
let renamed = [(if name == old then new else name, column) | (name, column) <- tableCols t]
checkChecks renamed renamed
AlterColumnType tbl col ty -> do
t <- lookupTable db tbl
c <- requireColumn "ALTER COLUMN" t col
@@ -507,10 +554,12 @@ checkResolvedWith db outer q = case q of
if columnAutoIncrement c && not (integerType ty)
then Left "ALTER COLUMN: AUTO_INCREMENT column must stay an integer type"
else Right ()
let changed = [(name, if name == col then column{columnType = ty} else column) | (name, column) <- tableCols t]
checkColumnDefs changed changed
AlterColumnDefault tbl col def -> do
t <- lookupTable db tbl
c <- requireColumn "ALTER COLUMN" t col
mapM_ (\v -> checkDefault c v) def
mapM_ (checkDefault c) def
AlterColumnNull tbl col nullable -> do
t <- lookupTable db tbl
c <- requireColumn "ALTER COLUMN" t col
@@ -524,6 +573,7 @@ checkResolvedWith db outer q = case q of
if length (nub (map fst attributes)) == length attributes
then Right ()
else Left "duplicate identity attribute"
ShowGrants -> Right ()
ShowRoles -> Right ()
DropUser name -> checkUserName name
CreateRole name -> checkRoleName name
@@ -532,6 +582,7 @@ checkResolvedWith db outer q = case q of
mapM_ checkPrivilege privs
checkGrantObject obj
checkRoleName role
RevokeGrantOption privs obj role -> checkResolvedWith db outer (RevokePrivileges privs obj role)
RevokePrivileges privs obj role -> do
mapM_ checkPrivilege privs
checkGrantObject obj
@@ -547,13 +598,15 @@ checkResolvedWith db outer q = case q of
UseDatabase name -> checkDatabaseName name
ShowDatabases -> Right ()
CreateDomain{} -> Right ()
AlterDomain{} -> Right ()
DropDomain{} -> Right ()
ShowDomains -> Right ()
-- | 事务控制由会话层执行,语义层不做列检查
-- \| 事务控制由会话层执行,语义层不做列检查
BeginTransaction -> Right ()
BeginSerializableTransaction -> Right ()
CommitTransaction -> Right ()
RollbackTransaction -> Right ()
-- | 保存点名字只是会话层的记号,不做列检查
-- \| 保存点名字只是会话层的记号,不做列检查
Savepoint _ -> Right ()
RollbackToSavepoint _ -> Right ()
ReleaseSavepoint _ -> Right ()
@@ -575,20 +628,29 @@ checkInsertTargets t cols = mapM_ checkTarget (tableCols t)
| Just _ <- columnDefault c = Right ()
| otherwise = Left ("INSERT: column " ++ name ++ " is NOT NULL and has no default")
-- | 检查一列定义是否合法(names 给 CHECK 用)
checkColumnDefs :: [String] -> [(String, Column)] -> Either String ()
checkColumnDefs names cols = do
-- | 依据完整 schema 校验新增列定义
checkColumnDefs :: [(String, Column)] -> [(String, Column)] -> Either String ()
checkColumnDefs schemaColumns cols = do
mapM_ (checkTypeParameters . columnType . snd) cols
mapM_ (\(_, c) -> mapM_ (checkDefault c) (columnDefault c)) cols
mapM_ (\(_, c) -> checkAutoIncrement c) cols
mapM_ checkRuntimeKey cols
if length [() | (_, c) <- cols, columnAutoIncrement c] > 1
then Left "CREATE TABLE: at most one AUTO_INCREMENT column is allowed"
else Right ()
checkChecks names cols
checkChecks schemaColumns cols
where
-- \| 拒绝缺少能力实现的运行时键
checkRuntimeKey (_, column)
| typeClassOf (columnType column) == RuntimeClass
, columnUnique column || columnPrimaryKey column =
Left "runtime type key capability is not registered"
| otherwise = Right ()
-- | 校验列类型的长度和精度参数
checkTypeParameters :: ColumnType -> Either String ()
checkTypeParameters (CDomain _ base) = checkTypeParameters base
checkTypeParameters (CRuntime tid) = void (describeType builtinTypes tid)
checkTypeParameters CNull = Left "NULL is only valid as an inferred query output"
checkTypeParameters (CDecimal p s)
| p <= 0 || p > 308 || s < 0 || s > p = Left "invalid decimal precision or scale"
@@ -606,23 +668,20 @@ checkAutoIncrement c
checkDefault :: Column -> Value -> Either String ()
checkDefault c v
| VNull <- v = Right ()
| valueFits (columnType c) v = () <$ coerceValue (columnType c) v
| valueFits (columnType c) v = void (coerceValue (columnType c) v)
| otherwise = Left ("DEFAULT: value does not fit column type " ++ typeLabel (columnType c))
-- | CHECK 里的列必须存在
checkChecks :: [String] -> [(String, Column)] -> Either String ()
checkChecks names = mapM_ checkOne
-- | 按完整 schema 校验 CHECK 条件
checkChecks :: [(String, Column)] -> [(String, Column)] -> Either String ()
checkChecks columns = mapM_ checkOne
where
-- | 查这一列的 CHECK
-- \| 查这一列的 CHECK
checkOne (_, c) = case columnCheck c of
Nothing -> Right ()
Just text -> case parseExpression text of
Left err -> Left ("CHECK: " ++ firstLine err)
Right e -> mapM_ (known e) (colsInExpr e)
-- | 这个列名在不在定义里
known _ col
| col `elem` names = Right ()
| otherwise = Left ("CHECK: unknown column: " ++ col)
Right e -> void (prepareCheckExpression columns e)
-- \| 只保留解析错误的第一行
firstLine = takeWhile (/= '\n')
-- | 账号名上限
@@ -647,7 +706,7 @@ checkUserName name
| not (all allowed name) = Left "USER: account name may only contain ASCII letters, digits, dot, dash or underscore"
| otherwise = Right ()
where
-- | 账号名字符规则
-- \| 账号名字符规则
allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
-- | 建号 / 改口令:名字合法且口令不空
@@ -670,7 +729,7 @@ checkRoleName name
| map toLower name `elem` privilegeNames = Left "ROLE: role name must not be a privilege keyword"
| otherwise = Right ()
where
-- | 角色名字符规则
-- \| 角色名字符规则
allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
-- | 权限关键字(小写,只用于比较)
@@ -692,21 +751,33 @@ checkGrantObject obj
| not (all allowed obj) = Left "GRANT: object name may only contain ASCII letters, digits, dot, dash or underscore"
| otherwise = Right ()
where
-- | 授权对象字符规则
-- \| 授权对象字符规则
allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
-- | 内置 id 列名
idColumn :: String
idColumn = "id"
-- | 把列引用统一为执行期名字(子查询一起解析)
resolveExpr ::
Database ->
[(String, Column)] ->
[(String, Column)] ->
EnclosingScopes ->
(String -> Either String String) ->
Expr ->
Either String Expr
resolveExpr db env outer f e = case e of
Construct ty arguments -> do
tid <- inferConstruction db "constructor" (Scope env outer) ty arguments
bound <- mapM (resolveExpr db env outer f) arguments
Right (BoundConstruct tid bound)
BoundConstruct tid arguments -> BoundConstruct tid <$> mapM (resolveExpr db env outer f) arguments
FunctionCall name arguments -> do
inferred <- mapM (inferExpr db "function" (Scope env outer)) arguments
sig <- resolveSQLFunction name (map inferredArgument inferred)
bound <- mapM (resolveExpr db env outer f) arguments
Right (BoundFunction (signatureId sig) (signatureResult sig) bound)
BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM (resolveExpr db env outer f) arguments
Col c -> Col <$> f c
Add a b -> binary Add a b
Sub a b -> binary Sub a b
@@ -729,44 +800,109 @@ resolveExpr db env outer f e = case e of
AvgOf a -> AvgOf <$> resolveExpr db env outer f a
MinOf a -> MinOf <$> resolveExpr db env outer f a
MaxOf a -> MaxOf <$> resolveExpr db env outer f a
ScalarSub sq -> ScalarSub <$> resolveSubquery db (env ++ outer) sq
InSub a sq negated -> InSub <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure negated
ScalarSub sq -> ScalarSub <$> resolveSubquery db (env : outer) sq
InSub a sq negated -> InSub <$> resolveExpr db env outer f a <*> resolveSubquery db (env : outer) sq <*> pure negated
InList a es negated -> InList <$> resolveExpr db env outer f a <*> mapM (resolveExpr db env outer f) es <*> pure negated
ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env ++ outer) sq <*> pure negated
QuantCmp op a sq q -> QuantCmp op <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure q
ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env : outer) sq <*> pure negated
QuantCmp op a sq q -> QuantCmp op <$> resolveExpr db env outer f a <*> resolveSubquery db (env : outer) sq <*> pure q
_ -> Right e
where
-- | 递归处理两个子表达式
-- \| 递归处理两个子表达式
binary ctor a b = ctor <$> resolveExpr db env outer f a <*> resolveExpr db env outer f b
-- | 校验具体构造器和参数逻辑类型
inferConstruction :: Database -> String -> Scope -> TypeExpr -> [Expr] -> Either String TypeId
inferConstruction db place env ty@(TypeApply cid parameters) arguments = do
descriptor <- resolveType builtinTypes ty
expected <- case (cid, parameters) of
(TypeConstructorId 5, [child]) -> Right (replicate (length arguments) child)
(TypeConstructorId 6, [child]) | length arguments <= 1 -> Right (replicate (length arguments) child)
(TypeConstructorId 7, fields) | length fields == length arguments -> Right fields
_ -> Left "composite constructor argument count mismatch"
inferred <- mapM (inferExpr db place env) arguments
supplied <- mapM argumentIdentity inferred
required <- mapM (fmap descriptorId . resolveType builtinTypes) expected
if supplied == required then Right (descriptorId descriptor) else Left "composite constructor argument type mismatch"
where
-- \| 解析非空参数的逻辑类型身份
argumentIdentity InferNull = Left "SQL NULL needs Maybe construction inside a runtime value"
argumentIdentity (InferType column) = sqlType column
-- | 使用单行 schema 绑定表达式
prepareRowExpression :: [(String, Column)] -> Expr -> Either String Expr
prepareRowExpression columns expression = do
bound <- resolveExpr [] columns [] (nameIn columns "expression") expression
_ <- inferExpr [] "expression" (Scope columns []) bound
bindSlots (map fst columns) [] bound
-- | 统一绑定 DDL 与写入使用的 CHECK
prepareCheckExpression :: [(String, Column)] -> Expr -> Either String Expr
prepareCheckExpression columns expression = do
checkNoAggregate "CHECK" expression
if hasSubquery expression
then Left "CHECK: subqueries are not allowed here"
else Right ()
resolved <- resolveExpr [] columns [] (nameIn columns "CHECK") expression
checkBool [] "CHECK" (Scope columns []) resolved
bindSlots (map fst columns) [] resolved
-- | 在单值作用域规范化领域 VALUE 的大小写
prepareDomainCheckExpression :: ColumnType -> Expr -> Either String Expr
prepareDomainCheckExpression ty expression = do
checkNoAggregate "CHECK" expression
if hasSubquery expression then Left "CHECK: subqueries are not allowed here" else Right ()
let names = nub ("value" : colsInExpr expression)
columns = [(name, plainColumn ty) | name <- names, map toLower name == "value"]
resolved <- resolveExpr [] columns [] valueName expression
prepareCheckExpression [("value", plainColumn ty)] resolved
where
-- \| 领域条件只允许引用 VALUE
valueName name
| map toLower name == "value" = Right "value"
| otherwise = Left ("unknown column in DOMAIN CHECK: " ++ name)
-- | 将推导类型转换为可空参数类型
inferredArgument :: InferredType -> Maybe ColumnType
inferredArgument InferNull = Nothing
inferredArgument (InferType ty) = Just ty
-- | 解析子查询,并记下它引用的外层列
resolveSubquery :: Database -> [(String, Column)] -> Subquery -> Either String Subquery
resolveSubquery :: Database -> EnclosingScopes -> Subquery -> Either String Subquery
resolveSubquery _ _ BoundSubquery{} = Left "execution subquery cannot be used in semantic input"
resolveSubquery db outer sq = do
stmt <- resolveSubqueryStatement db outer (subqueryStatement sq)
pure (Subquery stmt (outerRefsOf db stmt))
references <- outerRefsOf db outer stmt
pure (Subquery stmt references)
-- | 子查询里指向外层作用域的列(内层查不到的列就是外层引用)
outerRefsOf :: Database -> Statement -> [String]
outerRefsOf db stmt = nub [c | c <- statementColumns stmt, not (inInner c)]
outerRefsOf :: Database -> EnclosingScopes -> Statement -> Either String [String]
outerRefsOf db outer stmt = do
inner <- checkFrom db outer (statementFrom stmt)
columns <- statementColumns stmt
Right (nub [c | c <- columns, not (inInner inner c)])
where
inner = case checkFrom db [] (statementFrom stmt) of
Right env -> env
Left _ -> []
-- | 这一列能不能在内层解析到
inInner c = case resolveColumn c inner of
-- \| 这一列能不能在内层解析到
inInner inner c = case resolveColumn c inner of
Right _ -> True
Left _ -> False
-- | 一条语句里出现的所有列引用
statementColumns :: Statement -> [String]
statementColumns :: Statement -> Either String [String]
statementColumns stmt = case stmt of
Select cols fromC mWhere groupBy orderBy _ ->
cols ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
SelectExpr items fromC mWhere groupBy orderBy _ ->
concatMap (colsInExpr . snd) items ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
_ -> []
SelectDistinct q -> statementColumns q
Select items fromC mWhere groupBy having orderBy _ -> do
ordering <- mapM (orderExpression items . fst) orderBy
Right
( concatMap (colsInExpr . snd) items
++ fromColumns fromC
++ concatMap colsInExpr mWhere
++ groupBy
++ concatMap colsInExpr having
++ concatMap colsInExpr ordering
)
_ -> Right []
where
-- | 取 FROM 里出现的列
-- \| 取 FROM 里出现的列
fromColumns FromUnit = []
fromColumns (FromTable _ _) = []
fromColumns (FromSubquery _ _) = []
@@ -774,26 +910,26 @@ statementColumns stmt = case stmt of
-- | 取语句的 FROM 子句,没有就是 FromUnit
statementFrom :: Statement -> FromClause
statementFrom Select { selectFrom = fromC } = fromC
statementFrom SelectExpr { selectFrom = fromC } = fromC
statementFrom (SelectDistinct q) = statementFrom q
statementFrom Select{selectFrom = fromC} = fromC
statementFrom _ = FromUnit
-- | 解析子查询里的 SELECT
resolveSubqueryStatement :: Database -> [(String, Column)] -> Statement -> Either String Statement
resolveSubqueryStatement db outer q@Select{} = resolveQuery db outer q (map (\c -> (c, Col c)) (selectCols q))
resolveSubqueryStatement db outer q@SelectExpr{} = resolveQuery db outer q (selectItems q)
resolveSubqueryStatement :: Database -> EnclosingScopes -> Statement -> Either String Statement
resolveSubqueryStatement db outer (SelectDistinct q) = SelectDistinct <$> resolveSubqueryStatement db outer q
resolveSubqueryStatement db outer q@Select{} = resolveQuery db outer q (selectItems q)
resolveSubqueryStatement _ _ _ = Left "subquery must be a SELECT"
-- | 列名解析入口:查询走连接解析,改数据的语句按本表列解析
resolveStatement :: Database -> Statement -> Either String Statement
resolveStatement db q = case q of
SelectDistinct inner -> SelectDistinct <$> resolveStatement db inner
Select{} -> resolveSelect db q
SelectExpr{} -> resolveSelect db q
Update tbl assigns mWhere -> do
(key, t) <- resolveTable db tbl
let env = tableCols t
name = nameIn env "UPDATE"
assigns' <- mapM (\(c, e) -> (\e' -> (c, e')) <$> resolveExpr db env [] name e) assigns
assigns' <- mapM (\(c, e) -> (c,) <$> resolveExpr db env [] name e) assigns
w <- mapM (resolveExpr db env [] (nameIn env "WHERE")) mWhere
pure (Update key assigns' w)
Delete tbl mWhere -> do
@@ -811,64 +947,96 @@ resolveStatement db q = case q of
nameIn :: [(String, Column)] -> String -> String -> Either String String
nameIn env place c = fst <$> columnAt place env c
-- | 内层先查,查不到再落到外层;内层同名引起的歧义不往外层让
scopedColumnAt :: String -> [(String, Column)] -> [(String, Column)] -> String -> Either String (String, Column)
scopedColumnAt place inner outer c = scopeAt place (Scope inner outer) c
-- | 解析原始引用,最近来源限定名遮蔽远层
scopedColumnAt :: String -> [(String, Column)] -> EnclosingScopes -> String -> Either String (String, Column)
scopedColumnAt place inner outer c
| length (filter (== '.') c) == 1
, columns : _ <- filter ownsSource (inner : outer) =
columnAt place columns c
| otherwise = scopeAt place (Scope inner outer) c
where
qualifier = takeWhile (/= '.') c ++ "."
-- \| 判断当前层是否声明该来源限定名
ownsSource = any (isPrefixOf qualifier . fst)
-- | 单表保留原表头,连接使用唯一前缀
resolveSelect :: Database -> Statement -> Either String Statement
resolveSelect db q@Select{} = resolveQuery db [] q (map (\c -> (c, Col c)) (selectCols q))
resolveSelect db q@SelectExpr{} = resolveQuery db [] q (selectItems q)
resolveSelect db q@Select{} = resolveQuery db [] q (selectItems q)
resolveSelect _ q = Right q
-- | 检查排序输出别名或来源列
checkOrder :: Scope -> [(String, Expr)] -> String -> Either String ()
checkOrder env items column = case [e | (label, e) <- items, label == column] of
[] -> checkColumns "ORDER BY" env [column]
[_] -> Right ()
_ -> Left ("ORDER BY: ambiguous projection alias: " ++ column)
-- | 检查排序表达式的类型能力
checkOrder :: Database -> Scope -> [(String, Expr)] -> OrderKey -> Either String ()
checkOrder db env items column = do
expression <- orderExpression items column
void (inferExpr db "ORDER BY" env expression >>= requireOrdering "ORDER BY")
-- | 统一检查已注册能力并保留 NULL 传播
requireCapability :: TypeCapability -> String -> InferredType -> Either String InferredType
requireCapability capability place inferred@(InferType ty)
| not (hasTypeCapability capability ty) = Left (place ++ ": type capability is not registered: " ++ show capability)
| otherwise = Right inferred
requireCapability _ _ inferred = Right inferred
-- | 只允许已提供排序能力的类型
requireOrdering :: String -> InferredType -> Either String InferredType
requireOrdering = requireCapability OrdCapability
-- | 分组与去重同时要求相等和哈希能力
requireHashing :: String -> InferredType -> Either String InferredType
requireHashing place inferred =
requireCapability EqCapability place inferred >> requireCapability HashCapability place inferred
-- | 解析投影、条件、排序与连接引用
resolveQuery :: Database -> [(String, Column)] -> Statement -> [(String, Expr)] -> Either String Statement
resolveQuery :: Database -> EnclosingScopes -> Statement -> [(String, Expr)] -> Either String Statement
resolveQuery db outer q items = do
source <- resolveSource db outer (selectFrom q)
env <- checkFrom db outer source
-- | 单表无别名时把裸列名换成物理列名;带别名时表头保留别名限定名
-- \| 单表无别名时把裸列名换成物理列名;带别名时表头保留别名限定名
let physical c = case selectFrom q of
FromTable Nothing tbl -> unqualify (Just (deriveQualifier Nothing tbl)) c
_ -> c
-- | 查一列并换算成物理名
-- \| 查一列并换算成物理名
name place c
| length (filter (== '.') c) == 2, not (qualifiedReference c) = Left (missingColumn place c env)
| otherwise = physical . fst <$> scopedColumnAt place env outer c
-- | 库限定列只引用来源中的真实表名
qualifiedReference c = qualifiedReferenceIn db (selectFrom q) c
|| (any (\(key, _) -> length (filter (== '.') key) == 1 && ("." ++ key) `isSuffixOf` c) outer
&& (not (any (elem '.' . fst) db) || any (\(table, _) -> (table ++ ".") `isPrefixOf` c) db))
-- | 换算一个投影项:带别名时保留别名做输出列名
-- \| 库限定列只引用来源中的真实表名
qualifiedReference c =
qualifiedReferenceIn db (selectFrom q) c
|| ( any
( any
( \(key, _) ->
length (filter (== '.') key) == 1
&& ("." ++ key) `isSuffixOf` c
)
)
outer
&& (not (any (elem '.' . fst) db) || any (\(table, _) -> (table ++ ".") `isPrefixOf` c) db)
)
-- \| 换算一个投影项:带别名时保留别名做输出列名
output (label, Col c) = do
k <- name "SELECT" c
pure (if label == c then (k, Col k) else (label, Col k))
output (label, e) = do
e' <- resolveExpr db env outer (name "SELECT") e
pure (label, e')
projected <- if items == [("*", Col "*")]
then if null env && selectFrom q == FromUnit
projected <-
if items == [("*", Col "*")]
then
if null env && selectFrom q == FromUnit
then Left "SELECT: * requires FROM"
else Right [(physical c, Col (physical c)) | (c, _) <- env]
else mapM output items
condition <- mapM (resolveExpr db env outer (name "WHERE")) (selectWhere q)
grouping <- mapM (name "GROUP BY") (selectGroupBy q)
-- | 优先解析唯一投影别名,再查来源列
let orderName c = case [label | (label, _) <- projected, label == c, qIsExpression] of
[] -> name "ORDER BY" c
[label] -> Right label
_ -> Left ("ORDER BY: ambiguous projection alias: " ++ c)
qIsExpression = case q of SelectExpr{} -> True; _ -> False
ordering <- mapM (\(c, d) -> (\k -> (k, d)) <$> orderName c) (selectOrderBy q)
pure $ case q of
Select{} -> Select (map fst projected) source condition grouping ordering (selectLimit q)
_ -> SelectExpr projected source condition grouping ordering (selectLimit q)
having <- mapM (resolveExpr db env outer (name "HAVING")) (selectHaving q)
-- \| 整项名称可用输出别名,复合表达式只查来源
let orderKey key@(OrderColumn column)
| column `elem` map fst projected = key <$ orderExpression projected key
| otherwise = OrderColumn <$> name "ORDER BY" column
orderKey key@(OrderPosition _) = key <$ orderPosition (length projected) key
orderKey (OrderExpression expression) = OrderExpression <$> resolveExpr db env outer (name "ORDER BY") expression
ordering <- mapM (\(key, direction) -> (,direction) <$> orderKey key) (selectOrderBy q)
pure (Select projected source condition grouping having ordering (selectLimit q))
-- | 收集没有别名遮蔽的来源表名
sourceTableNames :: FromClause -> [String]
@@ -883,7 +1051,7 @@ qualifiedReferenceIn db source c = any (\table -> (table ++ ".") `isPrefixOf` c)
tables = sourceTableNames source ++ [key | table <- sourceTableNames source, Right (key, _) <- [resolveTable db table]]
-- | 单表不加限定名,其余来源交给 resolveFrom
resolveSource :: Database -> [(String, Column)] -> FromClause -> Either String FromClause
resolveSource :: Database -> EnclosingScopes -> FromClause -> Either String FromClause
resolveSource db outer fromC = case fromC of
FromTable mAlias tbl -> do
(key, _) <- resolveTable db tbl
@@ -891,7 +1059,7 @@ resolveSource db outer fromC = case fromC of
other -> resolveFrom db outer other
-- | 连接两侧与派生表都要先解析,再取环境解析 ON
resolveFrom :: Database -> [(String, Column)] -> FromClause -> Either String FromClause
resolveFrom :: Database -> EnclosingScopes -> FromClause -> Either String FromClause
resolveFrom _ _ FromUnit = Right FromUnit
resolveFrom db _ (FromTable alias tbl) = do
(key, _) <- resolveTable db tbl
@@ -904,31 +1072,20 @@ resolveFrom db outer (FromJoin kind left right cond) = do
l <- resolveFrom db outer left
r <- resolveFrom db outer right
env <- checkFrom db outer (FromJoin kind l r cond)
-- | 连接条件也拒绝不存在的库前缀
-- \| 连接条件也拒绝不存在的库前缀
let joinName column
| length (filter (== '.') column) == 2, not (qualifiedReferenceIn db (FromJoin kind left right cond) column) = Left (missingColumn "ON" column env)
| otherwise = fst <$> columnAt "ON" env column
| otherwise = fst <$> scopedColumnAt "ON" env outer column
c <- resolveExpr db env outer joinName cond
pure (FromJoin kind l r c)
-- | 派生表的输出列名:列取裸名,表达式保留原标签
nameDerivedColumns :: Statement -> Either String Statement
nameDerivedColumns q@Select { selectCols = cols, selectFrom = fromC } = do
let names = map lastTablePart cols
checkDerivedNames names
Right
( SelectExpr
[(n, Col c) | (n, c) <- zip names cols]
fromC
(selectWhere q)
(selectGroupBy q)
(selectOrderBy q)
(selectLimit q)
)
nameDerivedColumns q@SelectExpr { selectItems = items } = do
nameDerivedColumns (SelectDistinct q) = SelectDistinct <$> nameDerivedColumns q
nameDerivedColumns q@Select{selectItems = items} = do
let names = map derivedItemName items
checkDerivedNames names
Right q { selectItems = zip names (map snd items) }
Right q{selectItems = zip names (map snd items)}
nameDerivedColumns _ = Left "FROM: subquery must be a SELECT"
-- | 派生表里一个投影项的输出名:没写别名的列取裸名
@@ -942,7 +1099,7 @@ derivedItemName (label, _) = label
checkDerivedNames :: [String] -> Either String ()
checkDerivedNames = go []
where
-- | 逐个查有没有见过
-- \| 逐个查有没有见过
go _ [] = Right ()
go seen (n : ns)
| n `elem` seen = Left ("FROM: duplicate column name in subquery: " ++ n)
@@ -13,15 +13,26 @@ data IndexResult
deriving (Show, Eq)
class (Monad m) => MonadStorage m where
-- \| 在实际读写前验证绑定依赖
withSchemaGuard :: Database -> m (Either String a) -> m (Either String a)
withSchemaGuard _ _ = pure (Left "bound schema guards are unavailable in this storage")
-- | 确认写守卫能力后执行绑定写入
withWriteSchemaGuard :: Database -> m (Either String a) -> m (Either String a)
withWriteSchemaGuard _ _ = pure (Left "bound write schema guards are unavailable in this storage")
-- \| 建一个库
createDatabase :: String -> m (Either String ())
createDatabase _ = pure (Left "database management is unavailable in this storage")
-- \| 删一个库
dropDatabase :: String -> m (Either String ())
dropDatabase _ = pure (Left "database management is unavailable in this storage")
-- \| 切当前库
useDatabase :: String -> m (Either String ())
useDatabase _ = pure (Left "database selection is unavailable in this storage")
-- \| 列出现有库
listDatabases :: m (Either String [String])
listDatabases = pure (Right [])
@@ -41,7 +52,7 @@ class (Monad m) => MonadStorage m where
-- \| 按分片并行扫描并按分片序拼接;默认退回顺序扫描
scanShards :: Int -> String -> Maybe [String] -> m (Either String [Row])
scanShards _ t cols = maybe (scan t) (scanColumns t) cols
scanShards _ t = maybe (scan t) (scanColumns t)
-- \| 追加一行
insert :: String -> Row -> m (Either String ())
@@ -50,7 +61,7 @@ class (Monad m) => MonadStorage m where
insertMany :: String -> [Row] -> m (Either String ())
insertMany t = go
where
-- | 逐行插入,出错就停
-- \| 逐行插入,出错就停
go [] = pure (Right ())
go (r : rs) = do
x <- insert t r
@@ -66,7 +77,7 @@ class (Monad m) => MonadStorage m where
Left e -> pure (Left e)
Right rs -> replaceAll t [r | r <- rs, not (doomed r)]
where
-- | 这一行要不要删
-- \| 这一行要不要删
doomed r = case lookup "id" r of
Just (VInt k) -> k `elem` ks
_ -> False
@@ -107,12 +118,16 @@ class (Monad m) => MonadStorage m where
-- \| ALTER 用:整表换列定义与全部行
replaceSchema :: String -> [(String, Column)] -> [Row] -> m (Either String ())
-- | 校验完整快照后原子修改领域定义
alterDomain :: String -> (Database -> Either String [(String, Column)]) -> m (Either String ())
alterDomain _ _ = pure (Left "atomic domain alteration is unavailable in this storage")
-- \| 取全库快照(表名 + 列 + 全部行)
snapshot :: m Database
snapshot :: m (Either String Database)
-- \| 取全库结构:只要表名和列,不要行
schema :: m Database
schema = fmap (map withoutRows) snapshot
schema :: m (Either String Database)
schema = fmap (fmap (map withoutRows)) snapshot
where
-- | 表定义去掉所有行
withoutRows (name, t) = (name, t {tableRows = []})
-- \| 表定义去掉所有行
withoutRows (name, t) = (name, t{tableRows = []})
@@ -10,7 +10,8 @@ module ChuSQL.Core.Engine.Storage.FFI (
maintainStorage,
) where
import Control.Exception (SomeException, try)
import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread)
import Control.Exception (SomeException, finally, mask_, try)
import Data.ByteString qualified as BS
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
@@ -19,6 +20,7 @@ import Foreign
import Foreign.C
-- Rust 存储库 cdylib 的 C ABI 绑定(ffi.rs),收发单行 JSON。
-- 错误读取绑定同一 OS 线程;响应复制期间屏蔽取消并归还缓冲。
-- | 存储实例句柄(Rust 侧的 *mut Storage)
newtype StorageHandle = StorageHandle (Ptr ())
@@ -46,15 +48,8 @@ foreign import ccall safe "chusql_storage_maintenance"
-- | 离线修复系统目录并返回结果
maintainStorage :: FilePath -> BS.ByteString -> IO (Either String BS.ByteString)
maintainStorage path payload = withCString path $ \config ->
BS.useAsCStringLen payload $ \(input, size) -> alloca $ \outRef -> alloca $ \lenRef -> do
code <- cStorageMaintenance config input (fromIntegral size) outRef lenRef
if code /= 0 then Left <$> lastError else do
output <- peek outRef
len <- peek lenRef
bytes <- BS.packCStringLen (output, fromIntegral len)
cStorageFree output len
pure (Right bytes)
maintainStorage path payload = BS.useAsCString (TE.encodeUtf8 (T.pack path)) $ \config ->
callStorage (cStorageMaintenance config) payload
-- | 库版本(Rust 侧的 CARGO_PKG_VERSION)
storageVersion :: IO String
@@ -62,7 +57,7 @@ storageVersion = cStorageVersion >>= peekCString
-- | 打开存储实例,失败给错误文本
openStorage :: Maybe FilePath -> IO (Either String StorageHandle)
openStorage path = do
openStorage path = onStorageThread $ mask_ $ do
result <- try (withCStringOrNull path cStorageOpen) :: IO (Either SomeException (Ptr ()))
case result of
Left e -> pure (Left ("storage library call failed: " ++ show e))
@@ -70,9 +65,9 @@ openStorage path = do
| ptr == nullPtr -> Left <$> lastError
| otherwise -> pure (Right (StorageHandle ptr))
where
-- | 没有路径就传空指针,否则转成 C 字符串
-- \| 没有路径就传空指针,否则转成 C 字符串
withCStringOrNull Nothing f = f nullPtr
withCStringOrNull (Just s) f = withCString s f
withCStringOrNull (Just s) f = BS.useAsCString (TE.encodeUtf8 (T.pack s)) f
-- | 关掉存储实例
closeStorage :: StorageHandle -> IO ()
@@ -80,20 +75,32 @@ closeStorage (StorageHandle handle) = cStorageClose handle
-- | 一条 JSON 请求换一条 JSON 响应
storageRequest :: StorageHandle -> BS.ByteString -> IO (Either String BS.ByteString)
storageRequest (StorageHandle handle) payload =
BS.useAsCStringLen payload $ \(inPtr, inLen) ->
alloca $ \outPtrRef ->
alloca $ \outLenRef -> do
code <- cStorageRequest handle (castPtr inPtr) (fromIntegral inLen) outPtrRef outLenRef
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
outPtr <- peek outPtrRef
outLen <- peek outLenRef
bytes <- BS.packCStringLen (castPtr outPtr, fromIntegral outLen)
cStorageFree outPtr outLen
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
@@ -1,4 +1,5 @@
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.Core.Engine.Storage.IPC (
@@ -28,26 +29,59 @@ module ChuSQL.Core.Engine.Storage.IPC (
doDescribeTable,
doDropTable,
doListCatalog,
databaseSnapshot,
snapshotDatabase,
) where
import ChuSQL.Core.Model
import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
import ChuSQL.Core.Engine.Parallel (parallelShardLimit, poolRun, workerPool)
import ChuSQL.Core.Engine.Storage
import ChuSQL.Core.Engine.Storage.FFI (closeStorage, openStorage, storageRequest)
import ChuSQL.Core.Model
import ChuSQL.Core.Protocol (Account (..), Request (..), Response (..), SchemaColumn (..), TableInfo (..))
import Control.Concurrent (getNumCapabilities)
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, putMVar, readMVar, takeMVar, withMVar)
import Control.Exception (bracket, mask_)
import Control.Monad (when)
import Data.Aeson (eitherDecodeStrict, encode)
import Data.Aeson qualified as A
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Foldable (for_)
import Data.Maybe (fromMaybe)
import System.IO.Unsafe (unsafePerformIO)
-- IPC 存储实现:把 MonadStorage 的操作变成发给存储库的 JSON 请求。
-- 复用相同提交点的不可变快照版本。
databaseSnapshot :: Maybe (String, Database) -> Env -> IO (Either String (String, Database))
databaseSnapshot previous env = do
response <- ask env "database_snapshot" (ReqDatabaseSnapshot (fst <$> previous)) Just
pure $ case response of
Left err -> Left err
Right (RespSnapshotUnchanged checkpoint) -> case previous of
Just cached | fst cached == checkpoint -> Right cached
_ -> Left "snapshot version does not match cached database"
Right (RespDomainSnapshot infos rows checkpoint) -> do
db <- snapshotDatabase infos rows
Right (checkpoint, db)
Right (RespError err) -> Left err
_ -> Left "unexpected database snapshot response"
-- 从同一版本的结构和行集构建引擎数据库。
snapshotDatabase :: [TableInfo] -> [(String, [Row])] -> Either String Database
snapshotDatabase infos rows = mapM load infos
where
-- 布局、对象身份与数据必须来自同一版本。
load info = do
values <- maybe (Left "incomplete database snapshot") Right (lookup (tiTable info) rows)
let name = tiTable info
Right (name, Table name (schemaToColumns (tiColumns info)) values (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info))
-- | 一条会话的存储环境:当前库名随会话走,不共享
data Env = Env
{ envDatabase :: Maybe String
, envSchemaGuard :: Maybe Database
}
newtype IPCStorage a = IPCStorage
@@ -56,11 +90,11 @@ newtype IPCStorage a = IPCStorage
-- | 按库名造一个会话环境
envForDatabase :: Maybe String -> Env
envForDatabase = Env
envForDatabase name = Env name Nothing
-- | 进程默认环境:读全局库名,给测试与 CLI 用
defaultEnv :: IO Env
defaultEnv = Env <$> readMVar databaseRef
defaultEnv = envForDatabase <$> readMVar databaseRef
-- | 用进程默认环境跑(兼容既有调用点)
runIPCStorage :: IPCStorage a -> IO a
@@ -85,19 +119,45 @@ data StorageLink = StorageLink
}
{-# NOINLINE linkRef #-}
-- | 进程全局的存储链路
linkRef :: MVar (Maybe StorageLink)
linkRef = unsafePerformIO (newMVar Nothing)
{-# NOINLINE linkUsers #-}
-- | 在途请求计数与空闲信号
linkUsers :: (MVar Int, MVar ())
linkUsers = unsafePerformIO $ (,) <$> newMVar 0 <*> newMVar ()
-- | 登记请求并在结束时释放链路占用
withStorageLink :: (Maybe StorageLink -> IO a) -> IO a
withStorageLink = bracket enter leave
where
(users, idle) = linkUsers
-- \| 登记当前链路的在途请求
enter = withMVar linkRef $ \current -> do
case current of
Nothing -> pure ()
Just _ -> modifyMVar_ users $ \count -> do
when (count == 0) $ takeMVar idle
pure (count + 1)
pure current
-- \| 最后一个请求结束后发出空闲信号
leave Nothing = pure ()
leave (Just _) = mask_ $ modifyMVar_ users $ \count -> do
when (count == 1) $ putMVar idle ()
pure (count - 1)
-- | 装入一条链路;一个进程只装一次
setStorageLink :: StorageLink -> IO ()
setStorageLink link = modifyMVar_ linkRef (const (pure (Just link)))
setStorageLink link = modifyMVar_ linkRef $ \_ -> withMVar (snd linkUsers) (const (pure (Just link)))
-- | 打开本地的存储动态库,得到一条链路
localStorageLink :: Maybe FilePath -> IO (Either String StorageLink)
localStorageLink path = fmap (fmap toLink) (openStorage path)
where
-- | 把句柄包成一条链路
-- \| 把句柄包成一条链路
toLink handle =
StorageLink
{ slRequest = storageRequest handle
@@ -106,35 +166,33 @@ localStorageLink path = fmap (fmap toLink) (openStorage path)
-- | 关掉当前链路(进程退出前调用);没有链路就什么都不做
closeConnection :: IO ()
closeConnection = modifyMVar_ linkRef $ \current -> do
case current of
Nothing -> pure ()
Just link -> slClose link
closeConnection = modifyMVar_ linkRef $ \current -> withMVar (snd linkUsers) $ \_ -> do
for_ current slClose
pure Nothing
-- | 发一条请求并解码应答;链路没装就报错,不崩
sendRequest :: Request -> IO Response
sendRequest req = do
current <- readMVar linkRef
case current of
sendRequest req = withStorageLink $ \case
Nothing -> pure (RespError "storage not configured")
Just link -> do
Just link ->
do
raw <- slRequest link (BL.toStrict (encode req))
case raw of
Left e -> pure (RespError ("storage error: " ++ e))
Right bytes -> case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
Right bytes ->
case eitherDecodeStrict (BS.dropWhileEnd (== 13) bytes) of
Left e -> pure (RespError ("decode error: " ++ e))
Right resp -> pure resp
-- | 原样转发一条载荷给存储库
sendRawRequest :: BS.ByteString -> IO (Either String BS.ByteString)
sendRawRequest payload = do
current <- readMVar linkRef
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)
@@ -147,7 +205,6 @@ setDatabaseName name = modifyMVar_ databaseRef (const (pure name))
getDatabaseName :: IO (Maybe String)
getDatabaseName = readMVar databaseRef
-- | 给语句类请求盖上当前库名
stampDatabase :: Maybe String -> Request -> Request
stampDatabase Nothing req = req
@@ -170,13 +227,43 @@ globalRequest _ = False
-- | 发请求并把响应翻成 Either
ask :: Env -> String -> Request -> (Response -> Maybe a) -> IO (Either String a)
ask env what req recognize = do
resp <- sendRequest (stampDatabase (envDatabase env) req)
resp <- case envSchemaGuard env of
Nothing -> sendRequest (stampDatabase (envDatabase env) req)
Just dependencies -> guardedRequest env dependencies req
pure $ case resp of
RespError e -> Left e
other -> case recognize other of
Just a -> Right a
Nothing -> Left ("unexpected response to " ++ what)
-- | 发送依赖守卫并要求存储确认执行
guardedRequest :: Env -> Database -> Request -> IO Response
guardedRequest env dependencies req = do
let payload = case A.toJSON (stampDatabase (envDatabase env) req) of
A.Object fields -> A.Object (KM.insert "schema_guard" (A.toJSON (map guardOf dependencies)) fields)
other -> other
result <- sendRawRequest (BL.toStrict (encode payload))
pure $ case result >>= eitherDecodeStrict of
Left err -> RespError err
Right (A.Object fields)
| KM.lookup "status" fields == Just (A.String "guarded")
, Just response <- KM.lookup "response" fields -> case A.fromJSON response of
A.Success decoded -> decoded
A.Error err -> RespError ("decode error: " ++ err)
Right value -> case A.fromJSON value of
A.Success (RespError err) -> RespError err
_ -> RespError "storage did not confirm bound schema guard"
where
-- \| 编码依赖身份、版本与完整列定义
guardOf (name, table) =
A.object
[ "table" A..= name
, "database_id" A..= fmap (\(TableIdentity database _) -> show database) (tableIdentity table)
, "object_id" A..= fmap (\(TableIdentity _ object) -> show object) (tableIdentity table)
, "schema_version" A..= fmap show (tableSchemaVersion table)
, "columns" A..= map toWire (tableCols table)
]
-- | 只认"成了"(多数写操作都这样)
okOnly :: Response -> Maybe ()
okOnly RespOk = Just ()
@@ -184,19 +271,21 @@ okOnly _ = Nothing
-- | 发 Scan
doScan :: Env -> String -> IO (Either String [Row])
doScan env t = ask env "scan" (ReqScan t) $ \resp -> case resp of
doScan env t = ask env "scan" (ReqScan t) $ \case
RespRows rows -> Just rows
_ -> Nothing
-- | 发带投影的 Scan
doScanColumns :: Env -> String -> [String] -> IO (Either String [Row])
doScanColumns env t cols = ask env "scan" (ReqScanColumns t cols) $ \resp -> case resp of
RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
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) $ \resp -> case resp of
doScanShard env t cols shard shards = ask env "scan_shard" (ReqScanShard t cols shard shards) $ \case
RespRows rows -> Just rows
_ -> Nothing
@@ -212,25 +301,21 @@ doInsertMany env t rs = ask env "insert_batch" (ReqInsertBatch t rs) okOnly
doDeleteKeys :: Env -> String -> [Int] -> IO (Either String ())
doDeleteKeys env t ks = ask env "delete_keys" (ReqDeleteKeys t ks) okOnly
-- | 发 ReplaceAll
doReplaceAll :: Env -> String -> [Row] -> IO (Either String ())
doReplaceAll env t rs = ask env "replace_all" (ReqReplaceAll t rs) okOnly
-- | 发 ListTables
doListTables :: Env -> IO (Either String [String])
doListTables env = ask env "list_tables" ReqListTables $ \resp -> case resp of
doListTables env = ask env "list_tables" ReqListTables $ \case
RespTables ts -> Just ts
_ -> Nothing
-- | 一次拿全库 schema
doListCatalog :: Env -> IO (Either String [TableInfo])
doListCatalog env = ask env "list_catalog" ReqListCatalog $ \resp -> case resp of
doListCatalog env = ask env "list_catalog" ReqListCatalog $ \case
RespCatalog xs -> Just xs
_ -> Nothing
-- | 按某一列的索引取一行(键可以是整数或字符串)
doLookupByColumn :: Env -> String -> String -> Value -> IO (Either String IndexResult)
doLookupByColumn env t c k = ask env "lookup_by_index" (ReqLookupByColumn t c k) $ \resp -> case resp of
doLookupByColumn env t c k = ask env "lookup_by_index" (ReqLookupByColumn t c k) $ \case
RespRows rows -> Just (IndexRows rows)
RespNoIndex -> Just NoIndex
_ -> Nothing
@@ -243,37 +328,17 @@ doScanRange ::
Maybe (Value, Bool) ->
Maybe (Value, Bool) ->
IO (Either String (Maybe [Row]))
doScanRange env t c lo hi = ask env "range_by_index" (ReqRangeByIndex t c lo hi) $ \resp -> case resp of
doScanRange env t c lo hi = ask env "range_by_index" (ReqRangeByIndex t c lo hi) $ \case
RespRows rows -> Just (Just rows)
RespNoIndex -> Just Nothing
_ -> Nothing
-- | 发 DescribeTable
doDescribeTable :: Env -> String -> IO (Either String TableInfo)
doDescribeTable env t = ask env "describe_table" (ReqDescribeTable t) $ \resp -> case resp of
doDescribeTable env t = ask env "describe_table" (ReqDescribeTable t) $ \case
RespSchema info -> Just info
_ -> Nothing
-- | 给某一列建索引
doCreateIndex :: Env -> String -> String -> IO (Either String ())
doCreateIndex env t c = ask env "create_index" (ReqCreateIndex t c) okOnly
-- | 去掉某一列的索引
doDropIndex :: Env -> String -> String -> IO (Either String ())
doDropIndex env t c = ask env "drop_index" (ReqDropIndex t c) okOnly
-- | 删一列(列定义、这一列上的索引、每行里的那一格一起没)
doDropColumn :: Env -> String -> String -> IO (Either String ())
doDropColumn env t c = ask env "drop_column" (ReqDropColumn t c) okOnly
-- | 发 ReplaceSchema(ALTER 用)
doReplaceSchema :: Env -> String -> [SchemaColumn] -> [Row] -> IO (Either String ())
doReplaceSchema env t cols rs = ask env "replace_schema" (ReqReplaceSchema t cols rs) okOnly
-- | 发 CreateTable
doCreateTable :: Env -> String -> [SchemaColumn] -> IO (Either String ())
doCreateTable env t cols = ask env "create_table" (ReqCreateTable t cols) okOnly
-- | 发 DropTable
doDropTable :: Env -> String -> IO (Either String ())
doDropTable env t = ask env "drop_table" (ReqDropTable t) okOnly
@@ -312,25 +377,42 @@ toWire (n, c) =
}
instance MonadStorage IPCStorage where
-- \| 将依赖守卫限定于本次执行环境
withSchemaGuard dependencies action = IPCStorage $ \env ->
runIPCStorageIn action env{envSchemaGuard = Just dependencies}
-- \| 写前握手,旧存储不能先写入后才报错
withWriteSchemaGuard dependencies action = IPCStorage $ \env -> case dependencies of
[] -> pure (Left "bound write requires a target schema guard")
(target, _) : _ -> do
ready <- guardedRequest env dependencies (ReqValidateWrite target)
case ready of
RespOk -> runIPCStorageIn (withSchemaGuard dependencies action) env
RespError err -> pure (Left err)
_ -> pure (Left "unexpected response to validate_write")
-- \| 建一个库
createDatabase name = IPCStorage $ \env -> ask env "create_database" (ReqDatabase "create_database" name) okOnly
-- \| 删一个库
dropDatabase name = IPCStorage $ \env -> ask env "drop_database" (ReqDatabase "drop_database" name) okOnly
-- \| 切当前库
useDatabase name = IPCStorage $ \env -> ask env "use_database" (ReqDatabase "use_database" name) okOnly
-- \| 列出现有库
listDatabases = IPCStorage $ \env -> ask env "list_databases" (ReqDatabase "list_databases" "") $ \resp -> case resp of
listDatabases = IPCStorage $ \env -> ask env "list_databases" (ReqDatabase "list_databases" "") $ \case
RespTables names -> Just names
_ -> Nothing
-- \| 发 Scan
scan t = IPCStorage (\env -> doScan env t)
scan t = IPCStorage (`doScan` t)
-- \| 只取指定列
scanColumns t cols = IPCStorage (\env -> doScanColumns env t cols)
-- \| 并行分片数:按 RTS 能力数,封顶在 parallelShardLimit
parallelShards = IPCStorage $ \_ -> do
caps <- getNumCapabilities
pure (max 1 (min parallelShardLimit caps))
parallelShards = IPCStorage $ \_ -> do max 1 . min parallelShardLimit <$> getNumCapabilities
-- \| 分片并行扫,再按分片序拼接
scanShards width t cols
@@ -350,7 +432,7 @@ instance MonadStorage IPCStorage where
deleteKeys t ks = IPCStorage (\env -> doDeleteKeys env t ks)
-- \| 发 ReplaceAll
replaceAll t rs = IPCStorage (\env -> doReplaceAll env t rs)
replaceAll t rs = IPCStorage $ \env -> ask env "replace_all" (ReqReplaceAll t rs) okOnly
-- \| 按某一列的索引取一行(没有索引就回 NoIndex)
lookupByColumn t c k = IPCStorage (\env -> doLookupByColumn env t c k)
@@ -359,45 +441,49 @@ instance MonadStorage IPCStorage where
scanRange t c lo hi = IPCStorage (\env -> doScanRange env t c lo hi)
-- \| 发 CreateTable
createTable name cols = IPCStorage (\env -> doCreateTable env name (map toWire cols))
createTable name cols = IPCStorage $ \env -> ask env "create_table" (ReqCreateTable name (map toWire cols)) okOnly
-- \| ALTER:整表换列定义与全部行
replaceSchema name cols rows = IPCStorage (\env -> doReplaceSchema env name (map toWire cols) rows)
replaceSchema name cols rows = IPCStorage $ \env -> ask env "replace_schema" (ReqReplaceSchema name (map toWire cols) rows) okOnly
-- \| 发 DropTable
dropTable name = IPCStorage (\env -> doDropTable env name)
dropTable name = IPCStorage (`doDropTable` name)
-- \| 建索引
createIndex t c = IPCStorage (\env -> doCreateIndex env t c)
createIndex t c = IPCStorage $ \env -> ask env "create_index" (ReqCreateIndex t c) okOnly
-- \| 删索引
dropIndex t c = IPCStorage (\env -> doDropIndex env t c)
dropIndex t c = IPCStorage $ \env -> ask env "drop_index" (ReqDropIndex t c) okOnly
-- \| 删一列
dropColumn t c = IPCStorage (\env -> doDropColumn env t c)
dropColumn t c = IPCStorage $ \env -> ask env "drop_column" (ReqDropColumn t c) okOnly
-- \| 列表 + 逐表扫描拼库
snapshot = IPCStorage $ \env -> do
result <- doListCatalog env
case result of
Left _ -> pure []
Right xs -> mapM (loadEntry env) xs
-- \| 校验一致快照并复查提交点后发布领域
alterDomain name validate = IPCStorage $ \env -> do
snapshotResult <- ask env "domain_snapshot" ReqDomainSnapshot $ \case
RespDomainSnapshot infos rows checkpoint -> Just (infos, rows, checkpoint)
_ -> Nothing
case snapshotResult of
Left err -> pure (Left err)
Right (infos, rows, checkpoint) -> case mapM (loadDomainEntry rows) infos >>= validate of
Left err -> pure (Left err)
Right cols -> ask env "alter_domain" (ReqAlterDomain name (map toWire cols) checkpoint) okOnly
where
loadEntry env info = do
rows <- doScan env (tiTable info)
pure
( tiTable info
, Table (tiTable info) (schemaToColumns (tiColumns info)) (either (const []) id rows) (Just (metaOf info))
)
-- \| 保留快照身份并拒绝缺失的表数据
loadDomainEntry rows info = do
values <- maybe (Left "incomplete domain snapshot") Right (lookup (tiTable info) rows)
let key = tiTable info
Right (key, Table key (schemaToColumns (tiColumns info)) values (Just (metaOf info)) (tiIdentity info) (tiSchemaVersion info))
-- 在存储读门内获取同一版本的完整快照。
snapshot = IPCStorage $ \env -> fmap (fmap snd) (databaseSnapshot Nothing env)
-- \| 只问数据字典要结构,设了当前库只留它的表
schema = IPCStorage $ \env -> do
result <- ask env "all_catalogs" ReqAllCatalog $ \resp -> case resp of
result <- ask env "all_catalogs" ReqAllCatalog $ \case
RespCatalog infos -> Just infos
_ -> Nothing
pure $ case result of
Left _ -> []
Right xs -> concatMap (visibleTables (envDatabase env)) xs
pure (fmap (concatMap (visibleTables (envDatabase env))) result)
-- | 线上表信息转引擎侧统计
metaOf :: TableInfo -> TableMeta
@@ -407,11 +493,9 @@ metaOf info = TableMeta (tiRows info) (tiStats info) (tiHistograms info) (tiInde
visibleTables :: Maybe String -> TableInfo -> [(String, Table)]
visibleTables current info
| Just db <- current =
if unqualify (Just db) (tiTable info) /= tiTable info
then [bare named]
else []
[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)))
named = info{tiTable = unqualify current (tiTable info)}
-- \| 组装成不带行的表
bare i = (tiTable i, Table (tiTable i) (schemaToColumns (tiColumns i)) [] (Just (metaOf i)) (tiIdentity i) (tiSchemaVersion i))
@@ -1,8 +1,9 @@
module ChuSQL.Core.Engine.Storage.Memory (MemoryStorage (runMemoryStorage)) where
import ChuSQL.Core.Model
import ChuSQL.Core.Engine.Storage
import qualified Data.HashSet as HS
import ChuSQL.Core.Model
import Data.HashSet qualified as HS
import Data.Word (Word64)
-- 内存实现:Database 上的状态,错误通道是 Either String。
@@ -26,6 +27,12 @@ instance Monad MemoryStorage where
runMemoryStorage (k a) db'
instance MonadStorage MemoryStorage where
-- \| 纯状态视图在求值期间不受外部修改
withSchemaGuard _ action = action
-- \| 纯状态写入不受外部结构变更影响
withWriteSchemaGuard _ action = action
-- \| 全表扫描
scan t = MemoryStorage $ \db -> do
tbl <- lookupTable db t
@@ -45,7 +52,7 @@ instance MonadStorage MemoryStorage where
createTable name cols = MemoryStorage $ \db ->
if any ((== name) . fst) db
then Right (Left ("table already exists: " ++ name), db)
else Right (Right (), db ++ [(name, Table name cols [] Nothing)])
else Right (Right (), db ++ [(name, Table name cols [] Nothing Nothing (Just 1))])
-- \| 删表;不存在报错
dropTable name = MemoryStorage $ \db ->
@@ -60,7 +67,8 @@ instance MonadStorage MemoryStorage where
Just tbl ->
if col `notElem` map fst (tableCols tbl)
then Right (Left ("unknown column: " ++ col), db)
else
else do
version <- nextSchemaVersion tbl
Right
( Right ()
, replaceTable
@@ -68,19 +76,25 @@ instance MonadStorage MemoryStorage where
tbl
{ tableCols = filter ((/= col) . fst) (tableCols tbl)
, tableRows = map (filter ((/= col) . fst)) (tableRows tbl)
, tableSchemaVersion = Just version
}
db
)
-- \| 在同一状态转换内校验并发布领域
alterDomain name validate = MemoryStorage $ \db -> case validate db of
Left err -> Right (Left err, db)
Right cols -> runMemoryStorage (replaceSchema name cols []) db
-- \| 原样返回当前库
snapshot = MemoryStorage $ \db -> Right (db, db)
snapshot = MemoryStorage $ \db -> Right (Right db, db)
-- \| 返回实时行数与去重统计的无数据结构
schema = MemoryStorage $ \db -> Right (map describe db, db)
schema = MemoryStorage $ \db -> Right (Right (map describe db), db)
where
-- | 将存储数据汇总为结构统计
-- \| 将存储数据汇总为结构统计
describe (name, table) =
(name, table {tableRows = [], tableMeta = Just metadata})
(name, table{tableRows = [], tableMeta = Just metadata})
where
metadata = TableMeta (length (tableRows table)) distinct [] []
distinct = [columnStatistics column (tableRows table) | (column, _) <- tableCols table]
@@ -88,13 +102,25 @@ instance MonadStorage MemoryStorage where
-- \| 改表结构:列定义与行一起换
replaceSchema name cols rows = MemoryStorage $ \db -> case lookup name db of
Nothing -> Right (Left ("unknown table: " ++ name), db)
Just tbl -> Right (Right (), replaceTable name tbl{tableCols = cols, tableRows = rows} db)
Just tbl -> do
version <-
if tableCols tbl == cols
then Right (tableSchemaVersion tbl)
else Just <$> nextSchemaVersion tbl
Right (Right (), replaceTable name tbl{tableCols = cols, tableRows = rows, tableSchemaVersion = version} db)
-- | 递增结构版本并拒绝耗尽
nextSchemaVersion :: Table -> Either String Word64
nextSchemaVersion table = case tableSchemaVersion table of
Just version | version == maxBound -> Left "catalog schema version exhausted"
Just version -> Right (version + 1)
Nothing -> Right 1
-- | 对列值去重并限制统计内存
columnStatistics :: String -> [Row] -> (String, Int, Bool)
columnStatistics column rows = go rows HS.empty
where
-- | 累积规范化值,达到上限后停止
-- \| 累积规范化值,达到上限后停止
go remaining values
| HS.size values >= 4096 = (column, 4096, True)
| otherwise = case remaining of
@@ -105,4 +131,3 @@ columnStatistics column rows = go rows HS.empty
replaceTable :: String -> Table -> Database -> Database
replaceTable name table =
map (\(n, t) -> if n == name then (n, table) else (n, t))
@@ -1,31 +1,40 @@
module ChuSQL.Core.Engine.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), makeSelect) where
module ChuSQL.Core.Engine.Syntax.AST (Statement (..), DomainDefinition (..), DomainAlter (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), Quantifier (..), CompareOp (..), SortDir (..), OrderKey (..), makeSelect, distinctOrdering, orderPosition, orderExpression, orderKeyExpression) where
import ChuSQL.Core.Engine.Runtime.Functions (FunctionId)
import ChuSQL.Core.Engine.Runtime.Types (RuntimeValue, TypeExpr, TypeId)
import ChuSQL.Core.Model (Column (..), ColumnType, Value (..))
-- 语法树:语句、数据来源、条件表达式、排序方向。
-- | 领域的基础列属性及具名检查条件
data DomainDefinition = DomainDefinition Column [(String, String)] deriving (Show, Eq)
-- | 领域约束及默认值的结构变更
data DomainAlter
= DomainDefault (Maybe Value)
| DomainNullable Bool
| DomainAddCheck (Maybe String) String
| DomainDropCheck String
deriving (Show, Eq)
data Statement
= Select
{ selectCols :: [String]
, selectFrom :: FromClause
, selectWhere :: Maybe Expr
, selectGroupBy :: [String]
, selectOrderBy :: [(String, SortDir)]
, selectLimit :: Maybe Int
}
| SelectExpr
{ selectItems :: [(String, Expr)]
-- ^ 输出名称与投影表达式,普通列用 Col
, selectFrom :: FromClause
, selectWhere :: Maybe Expr
, selectGroupBy :: [String]
, selectOrderBy :: [(String, SortDir)]
, selectHaving :: Maybe Expr
, selectOrderBy :: [(OrderKey, SortDir)]
, selectLimit :: Maybe Int
}
| SelectDistinct Statement
| Insert String [String] [[Expr]]
| Delete String (Maybe Expr)
| Update String [(String, Expr)] (Maybe Expr)
| CreateTable String [(String, Column)]
| CreateDomain String ColumnType
| CreateDomain String DomainDefinition
| AlterDomain String DomainAlter
| DropDomain String
| ShowDomains
| DropTable String
@@ -40,36 +49,40 @@ data Statement
| 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
-- | GRANT 角色 TO 用户:给用户加角色
| GrantRole String [String]
-- | REVOKE <角色> FROM <用户>[, ...]
| RevokeRole String [String]
| -- | 新角色:权限的载体,用户靠成员资格继承它的权限
CreateRole String
| -- | 删角色:连同它的授权与成员一起删
DropRole String
| -- | GRANT 权限 ON 表 TO 角色,末位表示带 WITH GRANT OPTION
GrantPrivileges [String] String String Bool
| -- | REVOKE 权限 ON 表 FROM 角色
RevokePrivileges [String] String String
| RevokeGrantOption [String] String String
| -- | GRANT 角色 TO 用户:给用户加角色
GrantRole String [String]
| -- | REVOKE <角色> FROM <用户>[, ...]
RevokeRole String [String]
| CreateDatabase String
| DropDatabase String
| UseDatabase String
| ShowDatabases
-- | 开事务:BEGIN / START TRANSACTION
| BeginTransaction
-- | 提交事务
| CommitTransaction
-- | 回滚事务
| RollbackTransaction
-- | 建保存点:SAVEPOINT 名字
| Savepoint String
-- | 回滚到保存点:ROLLBACK TO [SAVEPOINT] 名字
| RollbackToSavepoint String
-- | 释放保存点:RELEASE [SAVEPOINT] 名字
| ReleaseSavepoint String
| -- | 开事务:BEGIN / START TRANSACTION
BeginTransaction
| -- | 串行化快照事务
BeginSerializableTransaction
| -- | 提交事务
CommitTransaction
| -- | 回滚事务
RollbackTransaction
| -- | 建保存点:SAVEPOINT 名字
Savepoint String
| -- | 回滚到保存点:ROLLBACK TO [SAVEPOINT] 名字
RollbackToSavepoint String
| -- | 释放保存点:RELEASE [SAVEPOINT] 名字
ReleaseSavepoint String
deriving (Show, Eq)
-- | 连接类型:内连接与左外连接
@@ -87,10 +100,16 @@ data FromClause
deriving (Show, Eq)
-- | 子查询:语句,加上它对外层列的引用(自由变量,语义检查时填)
data Subquery = Subquery
data Subquery
= Subquery
{ subqueryStatement :: Statement
, subqueryRefs :: [String]
}
| BoundSubquery
{ subqueryStatement :: Statement
, subqueryRefs :: [String]
, subquerySlots :: [(String, Expr)]
}
deriving (Show, Eq)
-- | 量词:ANY 至少一行成立,ALL 每一行都成立
@@ -112,6 +131,13 @@ data CompareOp
-- | 条件表达式:列、字面量、算术、比较、逻辑、聚合与子查询
data Expr
= Col String
| ColumnSlot Int String
| OuterColumnSlot Int Int String
| FunctionCall String [Expr]
| BoundFunction FunctionId TypeId [Expr]
| Construct TypeExpr [Expr]
| BoundConstruct TypeId [Expr]
| RuntimeLiteral TypeId RuntimeValue
| LitNull
| LitInt Int
| LitFloat Double
@@ -154,14 +180,72 @@ data SortDir
| Desc
deriving (Show, Eq)
-- | 区分排序列、输出序号与来源表达式
data OrderKey = OrderColumn String | OrderPosition Int | OrderExpression Expr
deriving (Show, Eq)
-- | 造一个最简单的 SELECT
makeSelect :: [String] -> String -> Maybe Expr -> Statement
makeSelect cols tbl w =
Select
{ selectCols = cols
{ selectItems = [(c, Col c) | c <- cols]
, selectFrom = FromTable Nothing tbl
, selectWhere = w
, selectGroupBy = []
, selectHaving = Nothing
, selectOrderBy = []
, selectLimit = Nothing
}
-- | 将去重排序映射到输出列
distinctOrdering :: Statement -> Either String [(OrderKey, SortDir)]
distinctOrdering q@Select{} = resolveDistinctOrdering q
distinctOrdering _ = Left "DISTINCT requires SELECT"
-- | 校验排序序号并返回从零开始的位置
orderPosition :: Int -> OrderKey -> Either String (Maybe Int)
orderPosition width (OrderPosition position)
| position > 0, position <= width = Right (Just (position - 1))
| otherwise = Left "ORDER BY: position is outside the select list"
orderPosition _ _ = Right Nothing
-- | 按序号、唯一别名或来源列解析排序表达式
orderExpression :: [(String, Expr)] -> OrderKey -> Either String Expr
orderExpression _ (OrderExpression expression) = Right expression
orderExpression items key@(OrderPosition _) = do
position <- orderPosition (length items) key
case position of
Just slot -> Right (snd (items !! slot))
Nothing -> Left "ORDER BY: missing output position"
orderExpression items (OrderColumn column) = case [expression | (label, expression) <- items, label == column] of
[] -> Right (Col column)
[expression] -> Right expression
expressions | all (== Col column) expressions -> Right (Col column)
_ -> Left ("ORDER BY: ambiguous projection alias: " ++ column)
-- | 收集原始排序键中可能含子查询的表达式
orderKeyExpression :: OrderKey -> Maybe Expr
orderKeyExpression (OrderColumn column) = Just (Col column)
orderKeyExpression (OrderExpression expression) = Just expression
orderKeyExpression (OrderPosition _) = Nothing
-- | 解析去重输出的排序列
resolveDistinctOrdering :: Statement -> Either String [(OrderKey, SortDir)]
resolveDistinctOrdering q = mapM resolve (selectOrderBy q)
where
items = case q of
Select{selectItems = projected} -> projected
_ -> []
-- \| 排序键必须出现在去重结果中
resolve (key, direction) = do
position <- orderPosition (length items) key
case position of
Just _ -> Right (key, direction)
Nothing -> case [slot | (slot, (label, expression)) <- zip [1 ..] items, matches key label expression] of
[slot] -> Right (OrderPosition slot, direction)
[] -> Left "DISTINCT: ORDER BY column must appear in the select list"
_ -> Left "DISTINCT: ambiguous ORDER BY column"
-- \| 名称或完整表达式必须对应去重输出项
matches (OrderColumn column) label expression = label == column || expression == Col column
matches (OrderExpression key) _ expression = key == expression
matches (OrderPosition _) _ _ = False
@@ -1,13 +1,16 @@
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TupleSections #-}
module ChuSQL.Core.Engine.Syntax.Parser (parseStatement, parseExpression) where
import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
import ChuSQL.Core.Engine.Builtin (Builtin (..), builtinName, builtinNames, builtinNode, compareNode)
import ChuSQL.Core.Engine.Runtime.Types
import ChuSQL.Core.Engine.Syntax.AST
import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), plainColumn)
import Control.Monad (void)
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
import Data.Char (isAlpha, isAlphaNum, isHexDigit, isSpace, toLower, toUpper)
import Data.Functor (($>))
import Data.List (intercalate, isInfixOf)
import Data.Maybe (fromMaybe)
import Data.Void (Void)
@@ -112,8 +115,9 @@ operatorTable =
[ [Prefix (Neg <$ symbol "-")]
, [InfixL (Mul <$ symbol "*"), InfixL (Div <$ symbol "/")]
, [InfixL (Add <$ symbol "+"), InfixL (Sub <$ symbol "-")]
, [ InfixN comparisonOp ]
, [ Postfix inPredicate
, [InfixN comparisonOp]
,
[ Postfix inPredicate
, Postfix (try quantifiedCmp)
, Postfix (IsNotNull <$ try (keyword "is" *> keyword "not" *> keyword "null"))
, Postfix (IsNull <$ (keyword "is" *> keyword "null"))
@@ -167,6 +171,8 @@ atom =
, LitInt <$> integer
, LitStr <$> stringLit
, try aggregateCall
, try constructorCall
, try scalarFunctionCall
, try existsPredicate
, Col <$> qualifiedName
, try scalarSubquery
@@ -202,15 +208,49 @@ inPredicate = do
subquerySelect :: Parser Subquery
subquerySelect = Subquery <$> queryStatement <*> pure []
-- | 读取带具体类型参数的构造器
constructorCall :: Parser Expr
constructorCall = do
cid <-
(TypeConstructorId 5 <$ keyword "list")
<|> (TypeConstructorId 6 <$ keyword "maybe")
<|> (TypeConstructorId 7 <$ keyword "tuple")
arguments <- between (symbol "<") (symbol ">") (sepBy runtimeTypeP (symbol ","))
values <- between (symbol "(") (symbol ")") (sepBy expr (symbol ","))
pure (Construct (TypeApply cid arguments) values)
-- | 解析运行时逻辑类型语法
runtimeTypeP :: Parser TypeExpr
runtimeTypeP =
choice
[ intType <$ keyword "int"
, doubleType <$ keyword "double"
, boolType <$ keyword "bool"
, stringType <$ keyword "string"
, stringType <$ keyword "str"
, stringType <$ keyword "text"
, listType <$> between (symbol "[") (symbol "]") runtimeTypeP
, listType <$> (keyword "list" *> runtimeTypeP)
, maybeType <$> (keyword "maybe" *> runtimeTypeP)
, tupleType <$> between (symbol "(") (symbol ")") (sepBy runtimeTypeP (symbol ","))
]
-- | 读取待绑定的标量函数调用
scalarFunctionCall :: Parser Expr
scalarFunctionCall = do
name <- identifier
arguments <- between (symbol "(") (symbol ")") (sepBy expr (symbol ","))
pure (FunctionCall name arguments)
-- | 聚合调用:名称与节点都由内置函数表给出
aggregateCall :: Parser Expr
aggregateCall = choice (countAll : map named builtinNames)
where
-- | COUNT(*),没有参数
-- \| COUNT(*),没有参数
countAll = CountAll <$ try (keyword (builtinName BCountAll) *> between (symbol "(") (symbol ")") (symbol "*"))
-- | 表里每一个带参数的内置函数
-- \| 表里每一个带参数的内置函数
named (name, builtin) = builtinNode builtin <$> aggArg name
-- | 读聚合函数的参数
-- \| 读聚合函数的参数
aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr)
-- | 只认字面量,给 DEFAULT 用
@@ -220,24 +260,25 @@ literalValue =
[ VNull <$ keyword "null"
, VBool True <$ keyword "TRUE"
, VBool False <$ keyword "FALSE"
, try (negateLit <$> floatLit)
, try (symbol "-" *> (VFloat . negate <$> try floatLit <|> VInt . negate <$> integer))
, try (VFloat <$> floatLit)
, VInt <$> integer
, VFloat <$> try floatLit
, VStr <$> stringLit
]
where
-- | 负浮点字面量
negateLit d = VFloat (negate d)
-- | 一个排序列
orderItem :: Parser (String, SortDir)
-- | 一个排序键:输出序号、列名或表达式
orderItem :: Parser (OrderKey, SortDir)
orderItem = do
col <- qualifiedName
expression <- expr
dir <- sortDir
return (col, dir)
let key = case expression of
LitInt position -> OrderPosition position
Col column -> OrderColumn column
_ -> OrderExpression expression
return (key, dir)
-- | ORDER BY 的列表
orderByClause :: Parser [(String, SortDir)]
orderByClause :: Parser [(OrderKey, SortDir)]
orderByClause = do
keyword "order"
keyword "by"
@@ -307,6 +348,7 @@ reservedWords =
, "auto_increment"
, "type"
, "group"
, "having"
, "with"
, "any"
, "all"
@@ -328,9 +370,12 @@ tableRef = do
-- | 连接类型:内连接 / 左外连接
joinKind :: Parser JoinKind
joinKind =
try (keyword "left" *> optional (keyword "outer") *> keyword "join" *> return LeftJoin)
<|> try (keyword "inner" *> keyword "join" *> return InnerJoin)
<|> (keyword "join" *> return InnerJoin)
try
( (keyword "left" *> optional (keyword "outer") *> keyword "join")
$> LeftJoin
)
<|> try ((keyword "inner" *> keyword "join") $> InnerJoin)
<|> (keyword "join" $> InnerJoin)
-- | FROM 里的一个来源:表或派生表
fromSource :: Parser FromClause
@@ -395,8 +440,7 @@ dropTableStatement :: Parser Statement
dropTableStatement = do
keyword "drop"
keyword "table"
name <- tableName
return (DropTable name)
DropTable <$> tableName
-- | 读 CREATE INDEX(列名即索引名)
createIndexStatement :: Parser Statement
@@ -459,8 +503,7 @@ createUserStatement = do
keyword "create"
keyword "user"
name <- userName
pw <- identifiedBy
return (CreateUser name pw)
CreateUser name <$> identifiedBy
-- | 读 IDENTIFIED BY '口令'
identifiedBy :: Parser String
@@ -479,12 +522,18 @@ alterUserStatement = do
-- | 读身份属性开关
identityAttribute :: Parser (String, Bool)
identityAttribute = choice
[ ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
identityAttribute =
choice
[ ("allow_sudo_auth", True) <$ keyword "allow_sudo_auth"
, ("allow_sudo_auth", False) <$ keyword "noallow_sudo_auth"
, ("system_catalog_manager", True) <$ keyword "system_catalog_manager"
, ("system_catalog_manager", False) <$ keyword "nosystem_catalog_manager"
, ("login", True) <$ keyword "login", ("login", False) <$ keyword "nologin"
, ("superuser", True) <$ keyword "superuser", ("superuser", False) <$ keyword "nosuperuser"
, ("enabled", True) <$ keyword "enabled", ("enabled", False) <$ keyword "disabled"
, ("login", True) <$ keyword "login"
, ("login", False) <$ keyword "nologin"
, ("superuser", True) <$ keyword "superuser"
, ("superuser", False) <$ keyword "nosuperuser"
, ("enabled", True) <$ keyword "enabled"
, ("enabled", False) <$ keyword "disabled"
]
-- | 读 ALTER ROLE 属性或口令
@@ -500,8 +549,7 @@ dropUserStatement :: Parser Statement
dropUserStatement = do
keyword "drop"
keyword "user"
name <- userName
return (DropUser name)
DropUser <$> userName
-- | 读 CREATE ROLE
createRoleStatement :: Parser Statement
@@ -525,12 +573,18 @@ privilegeName =
, "INSERT" <$ keyword "insert"
, "UPDATE" <$ keyword "update"
, "DELETE" <$ keyword "delete"
, "CONNECT" <$ keyword "connect"
, "CREATE" <$ keyword "create"
, "ALL" <$ keyword "all"
]
-- | ON 后面的授权对象:* 或一张表
grantObject :: Parser String
grantObject = ("*" <$ symbol "*") <|> tableName
grantObject =
try (("database:" ++) <$> (keyword "database" *> identifier))
<|> try ((++ ".*") <$> (identifier <* symbol "." <* symbol "*"))
<|> ("*" <$ symbol "*")
<|> (optional (keyword "table") *> tableName)
-- | 可选的 WITH GRANT OPTION
grantOption :: Parser Bool
@@ -554,16 +608,75 @@ grantStatement = do
revokeStatement :: Parser Statement
revokeStatement = do
keyword "revoke"
optionOnly <- fromMaybe False <$> optional (True <$ (keyword "grant" *> keyword "option" *> keyword "for"))
choice
[ try $ do
privs <- sepBy1 privilegeName (symbol ",")
keyword "on"
obj <- grantObject
keyword "from"
RevokePrivileges privs obj <$> userName
, RevokeRole <$> userName <*> (keyword "from" *> sepBy1 userName (symbol ","))
(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 ","))
]
-- | 读取领域及其独立约束
createDomainStatement :: Parser Statement
createDomainStatement = do
name <- keyword "create" *> keyword "domain" *> identifier
ty <- keyword "as" *> columnTypeP
modifiers <- many domainConstraint
pure (CreateDomain name (foldl (flip ($)) (DomainDefinition (plainColumn ty) []) modifiers))
-- | 读取领域属性或 CHECK 条件
domainConstraint :: Parser (DomainDefinition -> DomainDefinition)
domainConstraint =
choice
[ try (keyword "not" *> keyword "null") $> domainNull False
, keyword "null" $> domainNull True
, keyword "default" *> (domainDefault . Just <$> literalValue)
, do
name <- optional (keyword "constraint" *> identifier)
text <- keyword "check" *> checkText
pure (domainCheck (fromMaybe "" name) text)
]
-- | 设置领域非空声明
domainNull :: Bool -> DomainDefinition -> DomainDefinition
domainNull nullable (DomainDefinition column checks) = DomainDefinition column{columnNullable = nullable} checks
-- | 设置领域默认值
domainDefault :: Maybe Value -> DomainDefinition -> DomainDefinition
domainDefault value (DomainDefinition column checks) = DomainDefinition column{columnDefault = value} checks
-- | 增加领域检查条件
domainCheck :: String -> String -> DomainDefinition -> DomainDefinition
domainCheck name text (DomainDefinition column checks) = DomainDefinition column (checks ++ [(name, text)])
-- | 读取领域约束与默认值变更
alterDomainStatement :: Parser Statement
alterDomainStatement = do
name <- keyword "alter" *> keyword "domain" *> identifier
action <-
choice
[ keyword "set"
*> choice
[ DomainDefault . Just <$> (keyword "default" *> literalValue)
, DomainNullable False <$ (keyword "not" *> keyword "null")
]
, keyword "drop"
*> choice
[ DomainDefault Nothing <$ keyword "default"
, DomainNullable True <$ (keyword "not" *> keyword "null")
, DomainDropCheck <$> (keyword "constraint" *> identifier)
]
, keyword "add"
*> ( DomainAddCheck
<$> optional (keyword "constraint" *> identifier)
<*> (keyword "check" *> checkText)
)
]
pure (AlterDomain name action)
-- | 建表时的一列:类型后面跟若干约束
columnDef :: Parser (String, Column)
columnDef = do
@@ -576,11 +689,24 @@ columnDef = do
columnConstraint :: Parser (Column -> Column)
columnConstraint =
choice
[ try (keyword "not" *> keyword "null" *> pure (\c -> c{columnNullable = False}))
, keyword "null" *> pure (\c -> c{columnNullable = True})
, keyword "auto_increment" *> pure (\c -> c{columnAutoIncrement = True, columnNullable = False})
, try (keyword "primary" *> keyword "key" *> pure (\c -> c{columnPrimaryKey = True, columnUnique = True, columnNullable = False}))
, keyword "unique" *> pure (\c -> c{columnUnique = True})
[ try
( (keyword "not" *> keyword "null")
$> (\c -> c{columnNullable = False})
)
, keyword "null" $> (\c -> c{columnNullable = True})
, keyword "auto_increment"
$> (\c -> c{columnAutoIncrement = True, columnNullable = False})
, try
( (keyword "primary" *> keyword "key")
$> ( \c ->
c
{ columnPrimaryKey = True
, columnUnique = True
, columnNullable = False
}
)
)
, keyword "unique" $> (\c -> c{columnUnique = True})
, keyword "default" *> ((\v c -> c{columnDefault = Just v}) <$> literalValue)
, keyword "check" *> ((\s c -> c{columnCheck = Just s}) <$> checkText)
]
@@ -597,28 +723,44 @@ sizeParen = try (between (symbol "(") (symbol ")") integer)
columnTypeP :: Parser ColumnType
columnTypeP =
choice
[ keyword "integer" >> pure CInt
[ try runtimeColumnType
, keyword "integer" >> pure CInt
, keyword "int" >> pure CInt
, keyword "bigint" >> pure CBigInt
, keyword "smallint" >> pure CSmallInt
, (keyword "varchar" >>) (maybe CStr CVarchar <$> optional sizeParen)
, (keyword "char" >>) (maybe (CChar 1) CChar <$> optional sizeParen)
, 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" *> pure CDouble)
, try ((keyword "double" *> keyword "precision") $> CDouble)
, keyword "double" >> pure CDouble
, (keyword "decimal" >>) decimalType
, (keyword "numeric" >>) decimalType
, 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
@@ -638,15 +780,15 @@ decimalArgs = do
selectStatement :: Parser Statement
selectStatement = do
keyword "select"
distinct <- fromMaybe False <$> optional ((True <$ keyword "distinct") <|> (False <$ keyword "all"))
cols <- selectList
fromC <- fromMaybe FromUnit <$> optional (keyword "from" *> fromClause)
mWhere <- optional (keyword "where" *> expr)
groupBy <- fromMaybe [] <$> optional groupByClause
having <- optional (keyword "having" *> expr)
orderBy <- fromMaybe [] <$> optional orderByClause
mLimit <- optional limitClause
pure $ if all (\(name, e) -> e == Col name) cols
then Select (map fst cols) fromC mWhere groupBy orderBy mLimit
else SelectExpr cols fromC mWhere groupBy orderBy mLimit
pure $ (if distinct then SelectDistinct else id) (Select cols fromC mWhere groupBy having orderBy mLimit)
-- | 读 WITH:展开每个 CTE 再读主查询
withStatement :: Parser Statement
@@ -673,7 +815,7 @@ queryStatement = withStatement <|> selectStatement
expandWith :: [(String, [String], Statement)] -> Statement -> Either String Statement
expandWith defs main = go [] defs
where
-- | 前面的 CTE 已进环境,接着展开本体
-- \| 前面的 CTE 已进环境,接着展开本体
go env [] = expandStatement env main
go env ((name, cols, body) : rest) = do
body' <- expandStatement env body
@@ -687,27 +829,21 @@ cteKey = map toLower
-- | CTE 带列清单时改本体的输出名
renameColumns :: String -> [String] -> Statement -> Either String Statement
renameColumns _ [] q = Right q
renameColumns name cols q@Select { selectCols = names } = do
checkCteArity name cols names
Right
( SelectExpr
[(c, Col n) | (c, n) <- zip cols names]
(selectFrom q)
(selectWhere q)
(selectGroupBy q)
(selectOrderBy q)
(selectLimit q)
)
renameColumns name cols q@SelectExpr { selectItems = items } = do
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 <- mapM renameOrder (selectOrderBy q)
Right q { selectItems = zip cols (map snd items), selectOrderBy = ordering }
ordering <-
if all (\(columnName, expression) -> expression == Col columnName) items
then Right (selectOrderBy q)
else mapM renameOrder (selectOrderBy q)
Right q{selectItems = zip cols (map snd items), selectOrderBy = ordering}
where
-- | 列清单同步改写内层排序输出别名
renameOrder (column, direction) = case [new | ((old, _), new) <- zip items cols, old == column] of
[] -> Right (column, direction)
[new] -> Right (new, direction)
-- \| 列清单同步改写内层排序输出别名
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"
-- | 列清单个数必须和本体输出一致
@@ -719,16 +855,19 @@ checkCteArity name cols out
-- | 把语句里对 CTE 的引用换成派生表
expandStatement :: [(String, Statement)] -> Statement -> Either String Statement
expandStatement env stmt = case stmt of
q@Select { selectFrom = fromC, selectWhere = mWhere } -> do
SelectDistinct q -> SelectDistinct <$> expandStatement env q
q@Select{selectFrom = fromC, selectItems = items, selectWhere = mWhere} -> do
fromC' <- expandClause env fromC
items' <- traverse (\(name, e) -> fmap (name,) (expandExpr env e)) items
w <- traverse (expandExpr env) mWhere
Right q { selectFrom = fromC', selectWhere = w }
q@SelectExpr { selectFrom = fromC, selectItems = items, selectWhere = mWhere } -> do
fromC' <- expandClause env fromC
items' <- traverse (\(name, e) -> fmap ((,) name) (expandExpr env e)) items
w <- traverse (expandExpr env) mWhere
Right q { selectFrom = fromC', selectItems = items', selectWhere = w }
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
@@ -744,6 +883,10 @@ expandClause env fromC = case fromC of
-- | 表达式里的子查询也要展开
expandExpr :: [(String, Statement)] -> Expr -> Either String Expr
expandExpr env e = case e of
Construct tid arguments -> Construct tid <$> mapM go arguments
BoundConstruct tid arguments -> BoundConstruct tid <$> mapM go arguments
FunctionCall name arguments -> FunctionCall name <$> mapM go arguments
BoundFunction fid tid arguments -> BoundFunction fid tid <$> mapM go arguments
Add a b -> Add <$> go a <*> go b
Sub a b -> Sub <$> go a <*> go b
Mul a b -> Mul <$> go a <*> go b
@@ -767,14 +910,14 @@ expandExpr env e = case e of
ScalarSub sq -> ScalarSub <$> goSub sq
InSub x sq neg -> (\x' sq' -> InSub x' sq' neg) <$> go x <*> goSub sq
InList x es neg -> (\x' es' -> InList x' es' neg) <$> go x <*> traverse go es
ExistsSub sq neg -> (\sq' -> ExistsSub sq' neg) <$> goSub sq
ExistsSub sq neg -> (`ExistsSub` neg) <$> goSub sq
QuantCmp op x sq q -> (\x' sq' -> QuantCmp op x' sq' q) <$> go x <*> goSub sq
_ -> Right e
where
-- | 继续看子表达式
-- \| 继续看子表达式
go = expandExpr env
-- | 继续看子查询里的语句
goSub sq = (\stmt -> sq { subqueryStatement = stmt }) <$> expandStatement env (subqueryStatement sq)
-- \| 继续看子查询里的语句
goSub sq = (\stmt -> sq{subqueryStatement = stmt}) <$> expandStatement env (subqueryStatement sq)
-- | 读 INSERT,可一次插多行
insertStatement :: Parser Statement
@@ -817,15 +960,18 @@ updateStatement = do
-- | 事务控制语句
transactionStatement :: Parser Statement
transactionStatement =
try (BeginTransaction <$ (keyword "start" *> keyword "transaction"))
<|> (BeginTransaction <$ (keyword "begin" *> optional (keyword "transaction")))
(beginMode =<< (try (keyword "start" *> keyword "transaction") <|> (keyword "begin" *> void (optional (keyword "transaction")))))
<|> (CommitTransaction <$ (keyword "commit" *> optional (keyword "transaction")))
<|> try (RollbackToSavepoint <$> rollbackToName)
<|> (RollbackTransaction <$ (keyword "rollback" *> optional (keyword "transaction")))
<|> (Savepoint <$> (keyword "savepoint" *> identifier))
<|> (ReleaseSavepoint <$> (keyword "release" *> optional (keyword "savepoint") *> identifier))
where
-- | ROLLBACK TO [SAVEPOINT] 名字
-- 解析可选的串行化隔离级别。
beginMode _ = do
mode <- optional (keyword "isolation" *> keyword "level" *> keyword "serializable")
pure (maybe BeginTransaction (const BeginSerializableTransaction) mode)
-- \| ROLLBACK TO [SAVEPOINT] 名字
rollbackToName =
keyword "rollback" *> keyword "to" *> optional (keyword "savepoint") *> identifier
@@ -836,7 +982,7 @@ parseStatement input =
Left err -> Left (safeParseError input err)
Right q -> Right q
where
-- | 按关键字分派到各语句解析器
-- \| 按关键字分派到各语句解析器
statementP =
withStatement
<|> transactionStatement
@@ -846,7 +992,8 @@ parseStatement input =
<|> (UseDatabase <$> (keyword "use" *> identifier))
<|> try (ShowDatabases <$ (keyword "show" *> keyword "databases"))
<|> try (ShowDomains <$ (keyword "show" *> keyword "domains"))
<|> try (CreateDomain <$> (keyword "create" *> keyword "domain" *> identifier) <*> (keyword "as" *> columnTypeP))
<|> try createDomainStatement
<|> try alterDomainStatement
<|> try (DropDomain <$> (keyword "drop" *> keyword "domain" *> identifier))
<|> insertStatement
<|> deleteStatement
@@ -854,6 +1001,7 @@ parseStatement input =
<|> try createUserStatement
<|> try alterUserStatement
<|> try alterRoleStatement
<|> try (ShowGrants <$ (keyword "show" *> keyword "grants"))
<|> try (ShowRoles <$ (keyword "show" *> keyword "roles"))
<|> try dropUserStatement
<|> try createRoleStatement
@@ -0,0 +1,106 @@
{-# 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)]
File diff suppressed because it is too large. Load diff
File diff suppressed because it is too large. Load diff
@@ -13,10 +13,13 @@ library
hs-source-dirs: src
exposed-modules: ChuSQL.Core.Model
ChuSQL.Core.Protocol
ChuSQL.Core.Runtime
build-depends: base >= 4.14 && < 5
, aeson
, hashable
, scientific
, text
, bytestring
, vector
default-language: Haskell2010
ghc-options: -Wall
+133 -61
View File
@@ -1,53 +1,58 @@
{-# LANGUAGE PatternSynonyms #-}
module ChuSQL.Core.Model
( ColumnType (..)
, Column (..)
, pattern TInt
, pattern TStr
, pattern TBool
, TypeClass (..)
, Value (..)
, Row
, TableMeta (..)
, Histogram (..)
, Table (..)
, Database
, histogramOf
, histogramFor
, colNames
, colType
, lookupTable
, resolveTable
, lastTablePart
, deriveQualifier
, allColumns
, qualify
, unqualify
, resolveColumn
, plainColumn
, typeLabel
, typeName
, parseColumnType
, domainTableName
, isDomainTable
, typeClassOf
, assignable
, comparableTypes
, integerType
, numericType
, valueFits
, coerceValue
, canonicalValue
, compareValue
, valuesEqual
, hashValue
) where
module ChuSQL.Core.Model (
ColumnType (..),
Column (..),
pattern TInt,
pattern TStr,
pattern TBool,
TypeClass (..),
Value (..),
Row,
TableMeta (..),
Histogram (..),
Table (..),
TableIdentity (..),
Database,
histogramOf,
histogramFor,
colNames,
colType,
lookupTable,
resolveTable,
lastTablePart,
deriveQualifier,
allColumns,
qualify,
unqualify,
resolveColumn,
plainColumn,
typeLabel,
typeName,
parseColumnType,
domainTableName,
isDomainTable,
typeClassOf,
assignable,
comparableTypes,
hasTypeCapability,
integerType,
numericType,
valueFits,
coerceValue,
canonicalValue,
compareValue,
valuesEqual,
hashValue,
) where
import ChuSQL.Core.Runtime
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Char (isDigit, isSpace, toLower)
import Data.Hashable (Hashable (..))
import Data.List (isPrefixOf, isSuffixOf, stripPrefix)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Word (Word64)
-- 数据模型:列类型、列约束、值、行、表、数据库,外加查表小工具。
@@ -68,6 +73,7 @@ data ColumnType
| CBlob
| CNull
| CDomain String ColumnType
| CRuntime TypeId
deriving (Show, Eq)
-- | 列定义:类型 + 约束;约束全部取默认值就是普通可空列。
@@ -121,6 +127,7 @@ typeLabel CTimestamp = "TTimestamp"
typeLabel CBlob = "TBlob"
typeLabel CNull = "NULL"
typeLabel (CDomain name _) = name
typeLabel (CRuntime tid) = renderTypeExpr (typeExpression tid)
-- | 线上/磁盘上的类型名
typeName :: ColumnType -> String
@@ -139,6 +146,7 @@ typeName CTimestamp = "timestamp"
typeName CBlob = "blob"
typeName CNull = "null"
typeName (CDomain name base) = "domain(" ++ name ++ "," ++ typeName base ++ ")"
typeName (CRuntime tid) = "runtime(" ++ BS.unpack (encodeType tid) ++ ")"
-- | 生成类型定义的目录键
domainTableName :: String -> String
@@ -151,6 +159,9 @@ isDomainTable name = "__system_domain_" `isPrefixOf` map toLower name
-- | 解析类型名,可带长度/精度参数;不认识的给 Nothing
parseColumnType :: String -> Maybe ColumnType
parseColumnType raw
| Just inner <- stripPrefix "runtime(" raw
, Just body <- stripSuffixMaybe ")" inner =
either (const Nothing) (Just . CRuntime) (decodeType builtinTypes (BS.pack body))
| Just inner <- stripPrefix "domain(" raw
, Just body <- stripSuffixMaybe ")" inner
, (name, ',' : definition) <- break (== ',') body =
@@ -180,13 +191,13 @@ parseColumnType raw
("date", []) -> Just CDate
("timestamp", []) -> Just CTimestamp
("blob", []) -> Just CBlob
_ -> Nothing
_ -> either (const Nothing) (Just . CRuntime . descriptorId) (parseTypeExpr raw >>= resolveType builtinTypes)
where
-- | 去掉空白的类型名
-- \| 去掉空白的类型名
cleaned = map toLower (filter (not . isSpace) raw)
-- | 基础名与参数段
-- \| 基础名与参数段
(base, rest) = span (/= '(') cleaned
-- | 括号里的参数表
-- \| 括号里的参数表
args = case stripSuffixMaybe ")" (drop 1 rest) of
Nothing -> []
Just inner -> map (filter (not . isSpace)) (splitOn ',' inner)
@@ -231,6 +242,7 @@ data TypeClass
| TemporalClass
| BooleanClass
| NullClass
| RuntimeClass
deriving (Show, Eq)
-- | 整型大类判断
@@ -250,12 +262,17 @@ typeClassOf CTimestamp = TemporalClass
typeClassOf CBool = BooleanClass
typeClassOf CNull = NullClass
typeClassOf (CDomain _ base) = typeClassOf base
typeClassOf CRuntime{} = RuntimeClass
-- | 同大类可赋值;日期/时间列接受字符串字面量
assignable :: ColumnType -> ColumnType -> Bool
assignable (CDomain _ base) source = assignable base source
assignable target (CDomain _ base) = assignable target base
assignable target source
| source == CNull = True
| target == source = True
| CRuntime tid <- target = Just (typeExpression tid) == scalarTypeExpression source
| typeClassOf target == RuntimeClass || typeClassOf source == RuntimeClass = False
| typeClassOf target == typeClassOf source = True
| typeClassOf target == TemporalClass && typeClassOf source == TextClass = True
| otherwise = False
@@ -270,17 +287,29 @@ integerType _ = False
-- | 比较用的类型族:同大类可比,日期时间与文本互比
comparableTypes :: ColumnType -> ColumnType -> Bool
comparableTypes a b = a == CNull || b == CNull || sameClass || crossTemporal
comparableTypes (CDomain _ base) other = comparableTypes base other
comparableTypes other (CDomain _ base) = comparableTypes other base
comparableTypes a b
| a == CNull || b == CNull = True
| typeClassOf a == RuntimeClass || typeClassOf b == RuntimeClass = a == b && hasTypeCapability EqCapability a
| otherwise = a == CNull || b == CNull || sameClass || crossTemporal
where
-- | 两个类型同属一个大类
-- \| 两个类型同属一个大类
sameClass = typeClassOf a == typeClassOf b
-- | 时间与文本放在一起比
-- \| 时间与文本放在一起比
crossTemporal = (temporal a && textual b) || (textual a && temporal b)
-- | 是不是时间类型
-- \| 是不是时间类型
temporal t = typeClassOf t == TemporalClass
-- | 是不是文本类型
-- \| 是不是文本类型
textual t = typeClassOf t == TextClass
-- | 领域沿用基础类型的已注册值运算能力
hasTypeCapability :: TypeCapability -> ColumnType -> Bool
hasTypeCapability capability (CDomain _ base) = hasTypeCapability capability base
hasTypeCapability capability (CRuntime tid) =
either (const False) (elem capability . descriptorCapabilities) (describeType builtinTypes tid)
hasTypeCapability _ _ = True
-- | 是不是数值类型
numericType :: ColumnType -> Bool
numericType t = typeClassOf t == NumericClass
@@ -288,6 +317,10 @@ numericType t = typeClassOf t == NumericClass
-- | 值能不能放进这一列(先不看可空)
valueFits :: ColumnType -> Value -> Bool
valueFits (CDomain _ base) value = valueFits base value
valueFits (CRuntime expected) (VRuntime supplied value) = expected == supplied && validateValue builtinTypes expected value == Right ()
valueFits (CRuntime expected) value = case scalarRuntimeValue value of
Just runtime -> validateValue builtinTypes expected runtime == Right ()
Nothing -> value == VNull
valueFits _ VNull = True
valueFits CInt (VInt _) = True
valueFits CBigInt (VInt _) = True
@@ -326,6 +359,15 @@ coerceValue t v = case t of
CBlob -> toText t v
CNull -> Left "a NULL output cannot contain a non-NULL value"
CDomain _ base -> coerceValue base v
CRuntime expected -> case v of
VRuntime supplied value | supplied == expected -> do
validateValue builtinTypes expected value
Right v
_ -> case scalarRuntimeValue v of
Just value -> do
validateValue builtinTypes expected value
Right (VRuntime expected value)
Nothing -> Left "runtime value type identity mismatch"
-- | 整数收进整型列
toInt :: ColumnType -> Value -> Either String Value
@@ -351,9 +393,9 @@ toDecimal p s v
VFloat d -> rounded d
_ -> Left ("cannot put this value into " ++ typeLabel (CDecimal p s))
where
-- | 缩放因子
-- \| 缩放因子
scale = (10 :: Double) ^ s
-- | 按比例四舍五入
-- \| 按比例四舍五入
rounded d
| isNaN d || isInfinite d || isInfinite (d * scale) = Left "decimal value is not finite or exceeds precision"
| abs result >= (10 :: Double) ^ (p - s) = Left "decimal value exceeds precision"
@@ -414,7 +456,6 @@ validTimeText t = case splitOn ':' t of
allOf :: Int -> String -> Bool
allOf n s = length s == n && all isDigit s
-- | 引擎里的一行值
data Value
= VNull
@@ -422,6 +463,7 @@ data Value
| VFloat Double
| VStr String
| VBool Bool
| VRuntime TypeId RuntimeValue
deriving (Show, Eq)
-- | 值的比较关键字:整值浮点折成整数
@@ -450,6 +492,7 @@ compareValue a b = case (canonicalValue a, canonicalValue b) of
(VFloat x, VFloat y) -> compare x y
(VStr x, VStr y) -> compare x y
(VBool x, VBool y) -> compare x y
(VRuntime tx x, VRuntime ty y) -> compare (tx, x) (ty, y)
(x, y) -> compare (valueRank x) (valueRank y)
-- | 族的先后,只用来给异族值定序
@@ -459,6 +502,7 @@ valueRank (VInt _) = 1
valueRank (VFloat _) = 1
valueRank (VStr _) = 2
valueRank (VBool _) = 3
valueRank VRuntime{} = 4
-- | 相等语义:比较关键字相同即相等,与 hashValue 配套
valuesEqual :: Value -> Value -> Bool
@@ -472,6 +516,27 @@ hashValue v = case canonicalValue v of
VFloat d -> hashWithSalt 1 d
VStr t -> hashWithSalt 2 t
VBool b -> hashWithSalt 3 b
VRuntime tid value -> hashWithSalt 4 (BS.unpack (encodeType tid), 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
-- | 值按类型打散搅拌
instance Hashable Value where
@@ -497,12 +562,17 @@ data TableMeta = TableMeta
}
deriving (Show)
-- | 一张表:名字、列定义与全部行;meta 为存储层统计,拿不到是 Nothing
-- | 保存持久化数据库与表编号
data TableIdentity = TableIdentity Word64 Word64 deriving (Show, Eq)
-- | 一张表:列、行、统计与独立对象身份
data Table = Table
{ tableName :: String
, tableCols :: [(String, Column)]
, tableRows :: [Row]
, tableMeta :: Maybe TableMeta
, tableIdentity :: Maybe TableIdentity
, tableSchemaVersion :: Maybe Word64
}
deriving (Show)
@@ -569,11 +639,11 @@ resolveTable db name = case lookup name db of
| [(key, table)] <- suffixed -> Right (key, table)
| otherwise -> Left (miss suffixed)
where
-- | 引用里去掉库前缀的那一段
-- \| 引用里去掉库前缀的那一段
bare = lastTablePart name
-- | schema 里以这个表名收尾的键:`sales.users` 能推出裸表名引用
-- \| schema 里以这个表名收尾的键:`sales.users` 能推出裸表名引用
suffixed = [(key, table) | (key, table) <- db, ('.' : name) `isSuffixOf` key]
-- | 一个候选都没有就是查无此表,多于一个就是有歧义
-- \| 一个候选都没有就是查无此表,多于一个就是有歧义
miss [] = "unknown table: " ++ name
miss _ = "ambiguous table: " ++ name
@@ -598,6 +668,8 @@ resolveColumn name env = case [(k, v) | (k, v) <- env, matches k] of
[] -> Left ("unknown column: " ++ name)
_ -> Left ("ambiguous column: " ++ name)
where
-- | 裸名匹配末段,库限定名只补一层前缀
matches k = k == name || ('.' : name) `isSuffixOf` k
-- \| 裸名匹配末段,库限定名只补一层前缀
matches k =
k == name
|| ('.' : name) `isSuffixOf` k
|| (length (filter (== '.') name) == 2 && length (filter (== '.') k) == 1 && ('.' : k) `isSuffixOf` name)
+127 -20
View File
@@ -15,15 +15,19 @@ module ChuSQL.Core.Protocol (
queryResultJson,
) where
import ChuSQL.Core.Model (Histogram (..), Row, Value (..))
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.!=), (.=))
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.Scientific (floatingOrInteger, fromFloatDigits)
import qualified Data.Text as T
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)
-- 线上协议类型:存储层请求/响应与查询结果集。
@@ -78,7 +82,7 @@ data Request
| ReqIdentityInitialize T.Text
| ReqRoleCreate T.Text
| ReqCatalogManage Request
| ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
| ReqIdentityAlter T.Text (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
| ReqAccountCreate T.Text T.Text
| ReqAccountReset T.Text T.Text
| ReqAccountLogin T.Text (Maybe T.Text)
@@ -94,12 +98,21 @@ data Request
| ReqLookupByColumn String String Value
| ReqRangeByIndex String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
| ReqDescribeTable String
| ReqValidateWrite String
| ReqCreateTable String [SchemaColumn]
| ReqDropTable String
| ReqCreateIndex String String
| ReqDropIndex String String
| ReqDropColumn String String
| ReqReplaceSchema String [SchemaColumn] [Row]
| ReqDomainSnapshot
| ReqDatabaseSnapshot (Maybe String)
| ReqMvccBegin Bool
| ReqMvccLock String [TxnOp] [String]
| ReqMvccPreview String
| ReqMvccCommit String String
| ReqMvccRollback String
| ReqAlterDomain String [SchemaColumn] String
| ReqListCatalog
| ReqApplyTransaction [TxnOp]
@@ -133,6 +146,7 @@ instance ToJSON TxnOp where
-- | 请求编码成 JSON
instance ToJSON Request where
toJSON (ReqValidateWrite t) = object ["method" .= ("validate_write" :: T.Text), "table" .= t]
toJSON (ReqDatabase method name) = object ["method" .= method, "database" .= name]
toJSON ReqAllCatalog = object ["method" .= ("all_catalogs" :: T.Text)]
toJSON (ReqInDatabase name req) = case toJSON req of
@@ -142,8 +156,16 @@ instance ToJSON Request where
toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
toJSON (ReqIdentityInitialize u) = object ["method" .= ("identity_initialize" :: T.Text), "administrator" .= u]
toJSON (ReqRoleCreate u) = object ["method" .= ("role_create" :: T.Text), "user" .= u]
toJSON (ReqIdentityAlter u login super enabled manager) = object ["method" .= ("identity_alter" :: T.Text), "user" .= u,
"can_login" .= login, "is_superuser" .= super, "enabled" .= enabled, "system_catalog_manager" .= manager]
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]
@@ -239,6 +261,14 @@ instance ToJSON Request where
, "columns" .= cols
, "rows" .= map rowToJSON rs
]
toJSON (ReqMvccBegin serializable) = object ["method" .= ("mvcc_begin" :: T.Text), "serializable" .= serializable]
toJSON (ReqMvccLock token ops dependencies) = object ["method" .= ("mvcc_lock" :: T.Text), "transaction" .= token, "ops" .= ops, "reads" .= dependencies]
toJSON (ReqMvccPreview token) = object ["method" .= ("mvcc_preview" :: T.Text), "transaction" .= token]
toJSON (ReqMvccCommit token checkpoint) = object ["method" .= ("mvcc_commit" :: T.Text), "transaction" .= token, "checkpoint" .= checkpoint, "ops" .= ([] :: [TxnOp])]
toJSON (ReqMvccRollback token) = object ["method" .= ("mvcc_rollback" :: T.Text), "transaction" .= token]
toJSON ReqDomainSnapshot = object ["method" .= ("domain_snapshot" :: T.Text)]
toJSON (ReqDatabaseSnapshot checkpoint) = object ["method" .= ("database_snapshot" :: T.Text), "checkpoint" .= checkpoint]
toJSON (ReqAlterDomain name columns checkpoint) = object ["method" .= ("alter_domain" :: T.Text), "table" .= name, "columns" .= columns, "checkpoint" .= checkpoint]
toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
toJSON (ReqApplyTransaction ops) =
object
@@ -254,6 +284,8 @@ data TableInfo = TableInfo
, tiIndexes :: [String]
, tiStats :: [(String, Int, Bool)]
, tiHistograms :: [(String, Histogram)]
, tiIdentity :: Maybe TableIdentity
, tiSchemaVersion :: Maybe Word64
}
deriving (Show, Eq)
@@ -266,6 +298,9 @@ instance ToJSON TableInfo where
, "row_count" .= tiRows info
, "indexes" .= map (\name -> object ["column" .= name]) (tiIndexes info)
, "stats" .= map (statJson (tiHistograms info)) (tiStats info)
, "database_id" .= fmap (\(TableIdentity database _) -> show database) (tiIdentity info)
, "object_id" .= fmap (\(TableIdentity _ table) -> show table) (tiIdentity info)
, "schema_version" .= fmap show (tiSchemaVersion info)
]
where
statJson hists (name, distinct, capped) =
@@ -275,6 +310,19 @@ instance ToJSON TableInfo where
histFields Nothing = []
histFields (Just h) = ["lo" .= histLow h, "hi" .= histHigh h, "hist" .= histBuckets h]
-- | 解码精确且有界的对象编号
parseObjectNumber :: A.Value -> Parser Word64
parseObjectNumber (A.String value)
| not (T.null value)
, T.length value <= 20
, T.all isDigit value
, Just number <- readMaybe (T.unpack value) :: Maybe Integer
, number <= toInteger (maxBound :: Word64) =
pure (fromInteger number)
parseObjectNumber value@(A.Number number)
| base10Exponent number >= -20, base10Exponent number <= 20 = A.parseJSON value
parseObjectNumber _ = fail "invalid table object identity"
-- | 线上直方图还原;区间或桶缺了就当作没有
histogramFromWire :: Maybe Double -> Maybe Double -> [Int] -> Maybe Histogram
histogramFromWire (Just low) (Just high) counts
@@ -289,11 +337,29 @@ instance FromJSON TableInfo where
count <- o .: "row_count"
indexes <- o .:? "indexes" .!= []
stats <- o .:? "stats" .!= []
indexColumns <- mapM (\v -> withObject "IndexWire" (.: "column") v) (indexes :: [A.Value])
indexColumns <- mapM (withObject "IndexWire" (.: "column")) (indexes :: [A.Value])
parsed <- mapM parseStat (stats :: [A.Value])
database <- o .:? "database_id" >>= traverse parseObjectNumber
tableId <- o .:? "object_id" >>= traverse parseObjectNumber
version <- o .:? "schema_version" >>= traverse parseObjectNumber
identity <- case (database, tableId) of
(Nothing, Nothing) -> pure Nothing
(Just _, Just 0) -> pure Nothing
(Just databaseId, Just objectId) | objectId > 0 -> pure (Just (TableIdentity databaseId objectId))
_ -> fail ("incomplete table object identity: " ++ show (database, tableId))
let parsedStats = [(name, distinct, capped) | (name, distinct, capped, _) <- parsed]
parsedHistograms = [(name, h) | (name, _, _, Just h) <- parsed]
pure (TableInfo table columns count indexColumns parsedStats parsedHistograms)
pure
( TableInfo
table
columns
count
indexColumns
parsedStats
parsedHistograms
identity
(version >>= \v -> if v == 0 then Nothing else Just v)
)
where
parseStat = withObject "ColumnStat" $ \o -> do
name <- o .: "name"
@@ -316,7 +382,9 @@ data Account = Account
, accountIsSuperuser :: Bool
, accountEnabled :: Bool
, accountSystemCatalogManager :: Bool
} deriving (Eq)
, accountAllowSudoAuth :: Bool
}
deriving (Eq)
-- | 账号的展示:只露账号名与版本号
instance Show Account where
@@ -324,17 +392,36 @@ instance Show Account where
-- | 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
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]
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
@@ -347,6 +434,9 @@ data Response
| RespOk
| RespError String
| RespCatalog [TableInfo]
| RespDomainSnapshot [TableInfo] [(String, [Row])] String
| RespSnapshotUnchanged String
| RespMvccSnapshot String [TableInfo] [(String, [Row])] String
-- | JSON 解回响应
instance FromJSON Response where
@@ -361,6 +451,17 @@ instance FromJSON Response where
"tables" -> RespTables <$> o .: "tables"
"error" -> RespError <$> o .: "message"
"schema" -> RespSchema <$> parseJSON (A.Object o)
"snapshot_unchanged" -> RespSnapshotUnchanged <$> o .: "checkpoint"
"mvcc_snapshot" -> do
schemas <- o .: "schemas"
tables <- o .: "rows" :: Parser [(String, [A.Value])]
rows <- mapM (\(name, values) -> (,) name <$> mapM rowFromJSON values) tables
RespMvccSnapshot <$> o .: "transaction" <*> pure schemas <*> pure rows <*> o .: "checkpoint"
"domain_snapshot" -> do
schemas <- o .: "schemas"
tables <- o .: "rows" :: Parser [(String, [A.Value])]
rows <- mapM (\(name, values) -> (,) name <$> mapM rowFromJSON values) tables
RespDomainSnapshot schemas rows <$> o .: "checkpoint"
"catalog" -> do
xs <- o .: "schemas" :: Parser [A.Value]
RespCatalog <$> mapM parseJSON xs
@@ -373,6 +474,7 @@ valueToJSON (VInt n) = A.Number (fromIntegral n)
valueToJSON (VFloat d) = A.Number (fromFloatDigits d)
valueToJSON (VStr s) = A.String (T.pack s)
valueToJSON (VBool b) = A.Bool b
valueToJSON (VRuntime tid value) = object ["__chusql_runtime_v1" .= runtimeToJSON tid value]
-- | JSON 解回值
valueFromJSON :: A.Value -> Parser Value
@@ -383,6 +485,10 @@ valueFromJSON (A.Number n) =
Left d -> pure (VFloat d)
valueFromJSON (A.String s) = pure (VStr (T.unpack s))
valueFromJSON (A.Bool b) = pure (VBool b)
valueFromJSON (A.Object fields)
| KM.size fields == 1
, Just payload <- KM.lookup "__chusql_runtime_v1" fields =
either fail (pure . uncurry VRuntime) (runtimeFromJSON builtinTypes payload)
valueFromJSON _ = fail "unsupported value type"
-- | 一行编码成 JSON
@@ -394,7 +500,7 @@ rowToJSON r =
rowFromJSON :: A.Value -> Parser Row
rowFromJSON (A.Object o) = mapM toPair (KM.toList o)
where
-- | 键值对解成一个字段
-- \| 键值对解成一个字段
toPair (k, v) = do
val <- valueFromJSON v
pure (K.toString k, val)
@@ -415,7 +521,8 @@ instance FromJSON QueryResult where
parseJSON = withObject "QueryResult" $ \o -> do
cols <- o .: "columns"
rows <- o .: "rows"
QueryResult cols <$> mapM (mapM valueFromJSON) rows
QueryResult cols
<$> mapM (mapM valueFromJSON) rows
<*> o .:? "rowCount" .!= 0
<*> o .:? "truncated" .!= False
<*> o .:? "database"
@@ -0,0 +1,366 @@
module ChuSQL.Core.Runtime (
TypeConstructorId (..),
TypeId,
TypeExpr (..),
Kind (..),
TypeRegistry,
TypeDescriptor (..),
TypeCapability (..),
PhysicalType (..),
RuntimeValue (..),
builtinTypes,
resolveType,
describeType,
typeExpression,
intType,
doubleType,
boolType,
stringType,
listType,
maybeType,
tupleType,
renderTypeExpr,
parseTypeExpr,
renderRuntimeValue,
validateValue,
encodeValue,
decodeValue,
encodeType,
decodeType,
runtimeToJSON,
runtimeFromJSON,
) where
import Control.Monad (zipWithM, zipWithM_)
import Data.Aeson (Value (..), eitherDecode, encode)
import Data.Aeson.Types (Parser, parseEither)
import qualified Data.ByteString.Lazy as BS
import Data.Char (isAlphaNum, toLower)
import Data.Hashable (Hashable (..))
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Vector as V
import 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 TypeCapability = EqCapability | OrdCapability | HashCapability deriving (Show, Eq)
-- | 保存类型实例描述
data TypeDescriptor = TypeDescriptor
{ descriptorId :: TypeId
, descriptorName :: String
, descriptorPhysical :: PhysicalType
, descriptorCapabilities :: [TypeCapability]
}
deriving (Show, Eq)
-- | 保存构造器元数据
newtype TypeRegistry = TypeRegistry [(TypeConstructorId, String, Kind)] deriving (Show, Eq)
-- | 表达运行时值
data RuntimeValue
= RInt Int
| RDouble Double
| RBool Bool
| RString String
| RList [RuntimeValue]
| RMaybe (Maybe RuntimeValue)
| RTuple [RuntimeValue]
deriving (Show, Eq, Ord)
-- | 递归哈希结构并统一浮点正负零
instance Hashable RuntimeValue where
-- \| 根据构造器和子值混合哈希
hashWithSalt salt value = case value of
RInt n -> hashWithSalt (hashWithSalt salt (1 :: Int)) n
RDouble n -> hashWithSalt (hashWithSalt salt (2 :: Int)) (if n == 0 then 0 else n)
RBool flag -> hashWithSalt (hashWithSalt salt (3 :: Int)) flag
RString text -> hashWithSalt (hashWithSalt salt (4 :: Int)) text
RList values -> hashWithSalt (hashWithSalt salt (5 :: Int)) values
RMaybe optional -> hashWithSalt (hashWithSalt salt (6 :: Int)) optional
RTuple values -> hashWithSalt (hashWithSalt salt (7 :: Int)) values
-- | 恢复固定编号的内建构造器
builtinTypes :: TypeRegistry
builtinTypes =
TypeRegistry
[ (TypeConstructorId 1, "Int", TypeKind)
, (TypeConstructorId 2, "Double", TypeKind)
, (TypeConstructorId 3, "Bool", TypeKind)
, (TypeConstructorId 4, "String", TypeKind)
, (TypeConstructorId 5, "List", TypeArrow TypeKind TypeKind)
, (TypeConstructorId 6, "Maybe", TypeArrow TypeKind TypeKind)
, (TypeConstructorId 7, "Tuple", ProductKind)
]
-- | 构造整数类型表达式
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)
let capabilities =
[ capability
| capability <- [EqCapability, OrdCapability, HashCapability]
, all (elem capability . descriptorCapabilities) children
]
Right (TypeDescriptor (TypeId expression) name physical capabilities)
-- | 按身份查询类型描述
describeType :: TypeRegistry -> TypeId -> Either String TypeDescriptor
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"
+135 -37
View File
@@ -22,7 +22,8 @@ const SLOT: usize = 2;
const CELL_FIXED: usize = 2 + 8;
/// 键长上限:节点里的格子必须放得进一页
pub const MAX_KEY_BYTES: usize = 64;
pub const MAX_KEY_BYTES: usize = 128;
const LEGACY_KEY_BYTES: usize = 64;
/// 一个节点最多几个键
fn max_keys(order: usize) -> usize {
@@ -31,7 +32,7 @@ fn max_keys(order: usize) -> usize {
/// 一个格子最多占多少字节
fn max_cell_bytes() -> usize {
CELL_FIXED + MAX_KEY_BYTES
CELL_FIXED + LEGACY_KEY_BYTES
}
/// 这个 order 放得进一页吗
@@ -44,6 +45,16 @@ pub fn max_order(page_size: usize) -> usize {
page_size.saturating_sub(HEADER) / (SLOT + max_cell_bytes()) + 1
}
/// 按页容量和分支数计算有效键长
pub fn key_limit(page_size: usize, order: usize) -> usize {
if order < 2 {
return 0;
}
(page_size.saturating_sub(HEADER) / (order - 1))
.saturating_sub(SLOT + CELL_FIXED)
.min(MAX_KEY_BYTES)
}
/// 读一个 u8
fn read_u8(p: &Page, off: usize) -> u8 {
p.data[off]
@@ -66,7 +77,12 @@ fn write_u16(p: &mut Page, off: usize, v: u16) {
/// 读一个小端 u32
fn read_u32(p: &Page, off: usize) -> u32 {
u32::from_le_bytes([p.data[off], p.data[off + 1], p.data[off + 2], p.data[off + 3]])
u32::from_le_bytes([
p.data[off],
p.data[off + 1],
p.data[off + 2],
p.data[off + 3],
])
}
/// 写一个小端 u32
@@ -91,7 +107,7 @@ fn write_meta(page: &mut Page, page_size: usize, order: usize, root: PageId) {
page.zero();
page.data[0..4].copy_from_slice(META_MAGIC);
write_u32(page, OFF_PAGE_SIZE, page_size as u32);
write_u16(page, OFF_MAX_KEY, MAX_KEY_BYTES as u16);
write_u16(page, OFF_MAX_KEY, key_limit(page_size, order) as u16);
write_u64(page, OFF_ROOT, root);
write_u16(page, OFF_ORDER, order as u16);
}
@@ -115,6 +131,13 @@ fn check_meta(page: &Page, page_size: usize, order: usize) -> io::Result<()> {
),
));
}
let stored_key = read_u16(page, OFF_MAX_KEY) as usize;
if stored_key < LEGACY_KEY_BYTES || stored_key > key_limit(page_size, order) {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"unsupported index key limit",
));
}
Ok(())
}
@@ -167,23 +190,78 @@ fn put_node(p: &mut Page, node: &Node) -> io::Result<()> {
}
/// 从一页读出节点
fn get_node(p: &Page) -> Node {
fn get_node(p: &Page) -> io::Result<Node> {
if p.data.len() < HEADER {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"truncated index node header",
));
}
let kind = read_u8(p, OFF_KIND);
let count = read_u16(p, OFF_COUNT) as usize;
let slots_end = HEADER + count * SLOT;
if !matches!(kind, NODE_LEAF | NODE_INTERNAL) || slots_end > p.data.len() {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"invalid index node kind or slot count",
));
}
let trailer = read_u64(p, OFF_NEXT);
let mut keys = Vec::with_capacity(count);
let mut values = Vec::with_capacity(count + 1);
let mut cell_end = p.data.len();
for i in 0..count {
let off = read_u16(p, HEADER + i * SLOT) as usize;
if off < slots_end || off + CELL_FIXED > p.data.len() {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"invalid index cell offset",
));
}
let klen = read_u16(p, off) as usize;
if klen > MAX_KEY_BYTES || off + CELL_FIXED + klen > p.data.len() {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"invalid index key length",
));
}
if off + CELL_FIXED + klen > cell_end {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"overlapping index cells",
));
}
cell_end = off;
keys.push(p.data[off + 2..off + 2 + klen].to_vec());
values.push(read_u64(p, off + 2 + klen));
}
if keys.windows(2).any(|pair| pair[0] > pair[1]) {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"index keys are not sorted",
));
}
if kind == NODE_INTERNAL {
values.push(trailer);
Node { kind, next: 0, keys, values }
if values.contains(&META_PAGE) {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"invalid index child page",
));
}
Ok(Node {
kind,
next: 0,
keys,
values,
})
} else {
Node { kind, next: trailer, keys, values }
Ok(Node {
kind,
next: trailer,
keys,
values,
})
}
}
@@ -220,7 +298,12 @@ fn split_node(node: &mut Node) -> (Vec<u8>, Node) {
node.keys.pop();
(
sep,
Node { kind: NODE_INTERNAL, next: 0, keys: right_keys, values: right_values },
Node {
kind: NODE_INTERNAL,
next: 0,
keys: right_keys,
values: right_values,
},
)
}
}
@@ -263,20 +346,26 @@ impl DiskBTree {
}
/// 键太长直接报错,避免写坏节点
fn check_key(&self, key: &[u8]) -> io::Result<()> {
if key.len() > MAX_KEY_BYTES {
pub(crate) fn check_key(key: &[u8], page_size: usize, order: usize) -> io::Result<()> {
let limit = key_limit(page_size, order);
if key.len() > limit {
return Err(io::Error::new(
io::ErrorKind::InvalidInput,
format!(
"index key is {} bytes, at most {} are supported",
key.len(),
MAX_KEY_BYTES
limit
),
));
}
Ok(())
}
/// 按当前索引配置预检键长
pub(crate) fn validate_key(&self, key: &[u8]) -> io::Result<()> {
Self::check_key(key, self.file.page_size(), self.order)
}
/// 读根页页号;空树是 None
fn root(&mut self) -> io::Result<Option<PageId>> {
let r = self.file.with_page(META_PAGE, |p| read_u64(p, OFF_ROOT))?;
@@ -299,7 +388,7 @@ impl DiskBTree {
/// 按页号读节点
fn load(&mut self, id: PageId) -> io::Result<Node> {
self.file.with_page(id, get_node)
self.file.with_page(id, get_node)?
}
/// 按页号写节点
@@ -307,6 +396,11 @@ impl DiskBTree {
self.file.update_page(id, |p| put_node(p, node))?
}
/// 设置后续索引页的提交点
pub(crate) fn set_lsn(&mut self, lsn: u64) {
self.file.set_lsn(lsn);
}
/// 清空整棵树
pub fn clear(&mut self) -> io::Result<()> {
let page_size = self.file.page_size();
@@ -338,29 +432,26 @@ impl DiskBTree {
/// 按 key 取全部位置(重复键按值升序)
pub fn get_all(&mut self, key: &[u8]) -> io::Result<Vec<u64>> {
let Some(mut id) = self.root()? else {
return Ok(Vec::new());
};
loop {
let node = self.load(id)?;
if node.kind == NODE_LEAF {
let start = node.keys.partition_point(|k| k.as_slice() < key);
let mut out = Vec::new();
for i in start..node.keys.len() {
if node.keys[i].as_slice() != key {
break;
}
out.push(node.values[i]);
}
return Ok(out);
}
id = node.values[child_slot(&node.keys, key)];
}
let mut values: Vec<_> = self
.scan(Some(key), Some(key))?
.into_iter()
.map(|(_, value)| value)
.collect();
values.sort_unstable();
Ok(values)
}
/// 插入一个键值对(键可重复)
pub fn insert(&mut self, key: &[u8], value: u64) -> io::Result<()> {
self.check_key(key)?;
self.validate_key(key)?;
if key.len() > LEGACY_KEY_BYTES {
let limit = key_limit(self.file.page_size(), self.order);
let mut meta = self.file.read_page(META_PAGE)?;
if read_u16(&meta, OFF_MAX_KEY) as usize != limit {
write_u16(&mut meta, OFF_MAX_KEY, limit as u16);
self.file.write_page(&meta)?;
}
}
match self.root()? {
None => {
let node = Node {
@@ -403,7 +494,9 @@ impl DiskBTree {
} else {
let child = node.values[child_slot(&node.keys, key)];
if let Some((sep, right_id)) = self.insert_rec(child, key, value)? {
let at = node.keys.partition_point(|k| k.as_slice() <= sep.as_slice());
let at = node
.keys
.partition_point(|k| k.as_slice() <= sep.as_slice());
node.keys.insert(at, sep);
node.values.insert(at + 1, right_id);
}
@@ -412,10 +505,9 @@ impl DiskBTree {
self.store(id, &node)?;
return Ok(None);
}
let (sep, mut right) = split_node(&mut node);
let (sep, right) = split_node(&mut node);
let right_id = self.alloc(&right)?;
if node.kind == NODE_LEAF {
right.next = node.next;
node.next = right_id;
}
self.store(id, &node)?;
@@ -443,8 +535,14 @@ impl DiskBTree {
}
return Ok(false);
}
let child = node.values[child_slot(&node.keys, key)];
self.delete_rec(child, key, value)
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)
}
/// 叶子链上按顺序取全部 (键, 值)
@@ -475,7 +573,7 @@ impl DiskBTree {
}
id = match lo {
None => node.values[0],
Some(start) => node.values[child_slot(&node.keys, start)],
Some(start) => node.values[node.keys.partition_point(|k| k.as_slice() < start)],
};
}
let mut out = Vec::new();
+239 -52
View File
@@ -34,6 +34,13 @@ pub struct ColumnStat {
#[derive(Debug, Clone, Default, Serialize, Deserialize)]
pub struct TableSchema {
#[serde(default)]
pub object_id: u64,
#[serde(default)]
pub file_generation: String,
#[serde(default)]
// 0 表示旧目录尚无可验证的结构版本。
pub schema_version: u64,
#[serde(default)]
pub system: bool,
pub columns: Vec<SchemaColumn>,
@@ -49,8 +56,12 @@ pub struct TableSchema {
pub stats: BTreeMap<String, ColumnStat>,
}
#[derive(Debug, Default, Serialize, Deserialize)]
#[derive(Debug, Clone, Default, Serialize, Deserialize)]
pub struct Catalog {
#[serde(default)]
pub database_id: u64,
#[serde(default)]
pub object_high_water: u64,
#[serde(default)]
pub identity_high_water: i64,
tables: BTreeMap<String, TableSchema>,
@@ -68,7 +79,73 @@ impl Catalog {
if bytes.is_empty() {
return Ok(Catalog::default());
}
serde_json::from_slice(&bytes).map_err(io::Error::other)
let mut catalog: Self = serde_json::from_slice(&bytes).map_err(io::Error::other)?;
if catalog
.tables
.values()
.any(|schema| !valid_generation(&schema.file_generation))
{
return Err(io::Error::other("invalid physical file generation"));
}
catalog.upgrade_object_ids()?;
Ok(catalog)
}
/// 补齐旧目录对象编号并校验唯一性
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(crate) fn set_generation(
&mut self,
table: &str,
object: u64,
source: &str,
target: &str,
) -> io::Result<()> {
if !valid_generation(target) {
return Err(io::Error::other("invalid physical file generation"));
}
let schema = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::other("migration table missing"))?;
if schema.object_id != object
|| (schema.file_generation != source && schema.file_generation != target)
{
return Err(io::Error::other(
"serialization_failure: migration object changed",
));
}
schema.file_generation = target.to_owned();
Ok(())
}
/// 分配不复用的对象编号
pub fn reserve_object_id(&mut self) -> io::Result<u64> {
self.object_high_water = self
.object_high_water
.checked_add(1)
.ok_or_else(|| io::Error::other("catalog object id exhausted"))?;
Ok(self.object_high_water)
}
/// 返回所有表的 (表名, schema)。
@@ -85,7 +162,11 @@ impl Catalog {
file.sync_all()?;
drop(file);
std::fs::rename(pending, &path)?;
std::fs::OpenOptions::new().read(true).write(true).open(path)?.sync_all()
std::fs::OpenOptions::new()
.read(true)
.write(true)
.open(path)?
.sync_all()
}
/// 一张表的 schema
@@ -99,22 +180,46 @@ impl Catalog {
}
/// 按一行数据补列
pub fn ensure_columns(&mut self, table: &str, row: &Row) {
pub fn ensure_columns(&mut self, table: &str, row: &Row) -> io::Result<()> {
let entry = self.tables.entry(table.to_string()).or_default();
add_missing_columns(entry, row);
add_missing_columns(entry, row)?;
Ok(())
}
/// 建表;已存在报错
pub fn create_table(&mut self, table: &str, columns: Vec<SchemaColumn>) -> io::Result<()> {
self.create_table_with_id(table, columns, None)
}
/// 按日志中的编号建立表
pub fn create_table_with_id(
&mut self,
table: &str,
columns: Vec<SchemaColumn>,
object_id: Option<u64>,
) -> io::Result<()> {
if self.tables.contains_key(table) {
return Err(io::Error::new(
io::ErrorKind::AlreadyExists,
format!("table already exists: {}", table),
));
}
let object_id = match object_id {
Some(id) if id == 0 || self.tables.values().any(|schema| schema.object_id == id) => {
return Err(io::Error::other("invalid catalog object id"));
}
Some(id) => {
self.object_high_water = self.object_high_water.max(id);
id
}
None => self.reserve_object_id()?,
};
self.tables.insert(
table.to_string(),
TableSchema {
object_id,
file_generation: String::new(),
schema_version: 1,
system: false,
columns,
dropped_columns: BTreeSet::new(),
@@ -129,22 +234,24 @@ impl Catalog {
/// 标记内部账号表
pub fn mark_system(&mut self, table: &str) -> io::Result<()> {
let entry = self.tables.get_mut(table)
let entry = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::other("missing system table"))?;
entry.system = true;
Ok(())
}
/// 记一次插入,返回列有没有变化
pub fn record_insert(&mut self, table: &str, row: &Row) -> bool {
pub fn record_insert(&mut self, table: &str, row: &Row) -> io::Result<bool> {
let changed = {
let entry = self.tables.entry(table.to_string()).or_default();
let changed = add_missing_columns(entry, row);
let changed = add_missing_columns(entry, row)?;
entry.row_count += 1;
changed
};
self.count_values(table, row);
changed
Ok(changed)
}
/// 记一次删除:行数减少 + 更新列统计
@@ -182,18 +289,30 @@ impl Catalog {
}
/// 重数一遍统计与行数
pub fn rebuild_stats(&mut self, table: &str, rows: &[Row]) -> bool {
pub fn rebuild_stats(&mut self, table: &str, rows: &[Row]) -> io::Result<bool> {
self.seen.remove(table);
{
let entry = self.tables.entry(table.to_string()).or_default();
entry.stats.clear();
entry.row_count = 0;
for row in rows {
for (name, value) in row {
if let Some(x) = value.as_f64() {
let stat = entry.stats.entry(name.clone()).or_default();
stat.lo = Some(stat.lo.map_or(x, |lo| lo.min(x)));
stat.hi = Some(stat.hi.map_or(x, |hi| hi.max(x)));
if stat.hist.is_empty() {
stat.hist = vec![0; HIST_BUCKETS];
}
}
}
}
}
let mut changed = false;
for row in rows {
changed = self.record_insert(table, row) || changed;
changed = self.record_insert(table, row)? || changed;
}
changed
Ok(changed)
}
/// 这一列第一次见到这个值就加一
@@ -231,16 +350,21 @@ impl Catalog {
/// 表改名到指定名字
pub fn rename_table(&mut self, from: &str, to: &str) -> io::Result<bool> {
let Some(entry) = self.tables.remove(from) else {
let Some(entry) = self.tables.get(from) else {
return Ok(false);
};
if self.tables.contains_key(to) {
self.tables.insert(from.to_string(), entry);
return Err(io::Error::new(
io::ErrorKind::AlreadyExists,
format!("table already exists: {}", to),
));
}
let version = next_schema_version(entry)?;
let mut entry = self
.tables
.remove(from)
.ok_or_else(|| io::Error::other("missing rename source"))?;
entry.schema_version = version;
self.seen.remove(from);
self.tables.insert(to.to_string(), entry);
Ok(true)
@@ -248,10 +372,27 @@ impl Catalog {
/// ALTER:整列定义换成新的,并清掉二级索引与统计
pub fn set_columns(&mut self, table: &str, columns: Vec<SchemaColumn>) -> io::Result<()> {
let entry = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
self.set_columns_version(table, columns, None)
}
/// 用日志中的目标版本替换列定义
pub fn set_columns_version(
&mut self,
table: &str,
columns: Vec<SchemaColumn>,
version: Option<u64>,
) -> io::Result<()> {
let entry = self.tables.get_mut(table).ok_or_else(|| {
io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
})?;
if let Some(version) = version {
if version == 0 {
return Err(io::Error::other("invalid WAL schema version"));
}
entry.schema_version = version;
} else if entry.columns != columns {
entry.schema_version = next_schema_version(entry)?;
}
entry.columns = columns;
entry.dropped_columns.clear();
entry.indexes.clear();
@@ -261,9 +402,16 @@ impl Catalog {
}
/// 老数据的列类型名规范化;返回有没有改动
pub fn normalize_types(&mut self) -> bool {
pub fn normalize_types(&mut self) -> io::Result<bool> {
let mut changed = false;
for entry in self.tables.values_mut() {
if entry
.columns
.iter()
.any(|column| normalize_type(&column.ty) != column.ty)
{
entry.schema_version = next_schema_version(entry)?;
}
for column in entry.columns.iter_mut() {
let fixed = normalize_type(&column.ty);
if fixed != column.ty {
@@ -272,15 +420,32 @@ impl Catalog {
}
}
}
changed
Ok(changed)
}
/// 删一列;之前没有也返回成功(重放幂等)
pub fn remove_column(&mut self, table: &str, column: &str) -> io::Result<bool> {
let entry = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
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);
@@ -296,10 +461,9 @@ impl Catalog {
/// 记住这一版已整理过(隐藏列名要留住)
pub fn mark_compacted(&mut self, table: &str) -> io::Result<()> {
let entry = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
let entry = self.tables.get_mut(table).ok_or_else(|| {
io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
})?;
entry.compacted = true;
self.seen.remove(table);
Ok(())
@@ -307,7 +471,9 @@ impl Catalog {
/// 这张表还有隐藏列字节吗
pub fn has_dropped_columns(&self, table: &str) -> bool {
self.tables.get(table).is_some_and(|e| !e.dropped_columns.is_empty())
self.tables
.get(table)
.is_some_and(|e| !e.dropped_columns.is_empty())
}
/// 还有隐藏列字节待整理的表
@@ -321,10 +487,9 @@ impl Catalog {
/// 记下一条索引定义
pub fn add_index(&mut self, table: &str, column: &str) -> io::Result<()> {
let entry = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
let entry = self.tables.get_mut(table).ok_or_else(|| {
io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
})?;
if entry.indexes.iter().any(|i| i.column == column) {
return Err(io::Error::new(
io::ErrorKind::AlreadyExists,
@@ -339,10 +504,9 @@ impl Catalog {
/// 去掉一条索引定义
pub fn remove_index(&mut self, table: &str, column: &str) -> io::Result<()> {
let entry = self
.tables
.get_mut(table)
.ok_or_else(|| io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table)))?;
let entry = self.tables.get_mut(table).ok_or_else(|| {
io::Error::new(io::ErrorKind::NotFound, format!("unknown table: {}", table))
})?;
match entry.indexes.iter().position(|i| i.column == column) {
None => Err(io::Error::new(
io::ErrorKind::NotFound,
@@ -357,22 +521,35 @@ impl Catalog {
}
/// 把行里"字典还不知道的列"补进来;返回有没有变化
fn add_missing_columns(entry: &mut TableSchema, row: &Row) -> bool {
let mut changed = false;
for (k, v) in row {
if entry.dropped_columns.contains(k) || entry.columns.iter().any(|c| &c.name == k) {
continue;
}
if let Some(ty) = infer_type(v) {
entry.columns.push(SchemaColumn {
name: k.clone(),
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()
});
changed = true;
})
})
.collect();
if additions.is_empty() {
return Ok(false);
}
}
changed
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 值猜列类型
@@ -482,12 +659,22 @@ fn hist_add(stat: &mut ColumnStat, v: &serde_json::Value) {
/// 从直方图里减掉一个值;值在区间外就不动
fn hist_remove(stat: &mut ColumnStat, v: &serde_json::Value) {
let Some(x) = v.as_f64() else { return };
let (Some(lo), Some(hi)) = (stat.lo, stat.hi) else { return };
let (Some(lo), Some(hi)) = (stat.lo, stat.hi) else {
return;
};
if x < lo || x > hi || stat.hist.len() != HIST_BUCKETS {
return;
}
let index = hist_index(lo, hi, x);
if let Some(bucket) = (0..stat.hist.len()).filter(|&i| stat.hist[i] > 0).min_by_key(|&i| i.abs_diff(index)) {
if let Some(bucket) = (0..stat.hist.len())
.filter(|&i| stat.hist[i] > 0)
.min_by_key(|&i| i.abs_diff(index))
{
stat.hist[bucket] -= 1;
}
}
/// 文件代次仅允许空值或固定长度十六进制
pub(crate) fn valid_generation(value: &str) -> bool {
value.is_empty() || (value.len() == 32 && value.bytes().all(|byte| byte.is_ascii_hexdigit()))
}
+17 -46
View File
@@ -33,7 +33,9 @@ pub fn default_config_path() -> PathBuf {
{
let appdata = std::env::var_os("APPDATA").filter(|v| !v.is_empty());
if let Some(appdata) = appdata {
return PathBuf::from(appdata).join(APP_DIR_NAME).join(CONFIG_FILE_NAME);
return PathBuf::from(appdata)
.join(APP_DIR_NAME)
.join(CONFIG_FILE_NAME);
}
}
#[cfg(not(windows))]
@@ -62,7 +64,9 @@ pub fn default_data_dir() -> PathBuf {
}
let roaming = std::env::var_os("APPDATA").filter(|v| !v.is_empty());
if let Some(roaming) = roaming {
return PathBuf::from(roaming).join(APP_DIR_NAME).join(DATA_DIR_NAME);
return PathBuf::from(roaming)
.join(APP_DIR_NAME)
.join(DATA_DIR_NAME);
}
PathBuf::from(APP_DIR_NAME).join(DATA_DIR_NAME)
}
@@ -210,9 +214,7 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
})?,
};
let file_origin = Origin::File(
path.clone().unwrap_or_else(default_config_path),
);
let file_origin = Origin::File(path.clone().unwrap_or_else(default_config_path));
let (page_size, page_origin) = pick(
file.page.and_then(|p| p.size),
@@ -229,17 +231,17 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
DEFAULT_POOL_SIZE,
&file_origin,
);
let storage = file.storage.unwrap_or_default();
let (data_dir, dir_origin) = pick(
file.storage.as_ref().and_then(|s| s.data_dir.clone()),
storage.data_dir,
default_data_dir().to_string_lossy().into_owned(),
&file_origin,
);
let (log_files, log_files_origin) = pick(
file.storage.as_ref().and_then(|s| s.log_files.clone()),
storage.log_files,
DEFAULT_LOG_FILES.to_string(),
&file_origin,
);
// 管名已经没有了:存储不再是独立进程,管道/套接字那一层随 FFI 一起删掉
let (log_level, log_origin) = pick(
file.log.and_then(|l| l.level),
DEFAULT_LOG_LEVEL.to_string(),
@@ -248,10 +250,14 @@ pub fn resolve(text: Option<&str>, path: Option<PathBuf>) -> Result<Loaded, Stri
let data_dir = data_dir.trim().to_string();
let log_files = log_files.trim().to_string();
let log_level = log_level.trim().to_string();
let log_level = log_level.trim();
let log_level = Level::parse(&log_level)
.ok_or_else(|| format!("log.level is not one of off/error/warn/info/debug: {}", log_level))?;
let log_level = Level::parse(log_level).ok_or_else(|| {
format!(
"log.level is not one of off/error/warn/info/debug: {}",
log_level
)
})?;
if data_dir.is_empty() {
return Err("storage.data_dir must not be empty".to_string());
@@ -318,38 +324,3 @@ fn validate_layout(page_size: usize, btree_order: usize) -> Result<(), String> {
}
Ok(())
}
#[cfg(test)]
mod tests {
use super::*;
/// 别的层的分区不能被当成错误
#[test]
fn ignores_sections_owned_by_other_layers() {
let text = r#"
[page]
size = 8192
[storage]
data_dir = "../data"
[server]
listen_host = "127.0.0.1"
port = 7777
max_message = 1048576
[web]
port = 7778
"#;
let loaded = resolve(Some(text), Some(PathBuf::from("settings.toml"))).unwrap();
assert_eq!(loaded.config.page_size, 8192);
assert_eq!(loaded.config.data_dir, PathBuf::from("../data"));
}
/// 自己分区里的拼写错误仍然要报错
#[test]
fn still_rejects_typos_inside_its_own_sections() {
let text = "[page]\npage_size = 8192\n";
assert!(resolve(Some(text), None).is_err());
}
}
+71 -26
View File
@@ -1,6 +1,6 @@
use std::cell::RefCell;
use std::ffi::{c_char, CStr};
use std::panic::{catch_unwind, AssertUnwindSafe};
use std::ffi::{CStr, c_char};
use std::panic::{AssertUnwindSafe, catch_unwind};
use std::ptr;
use std::slice;
@@ -42,7 +42,11 @@ pub unsafe extern "C" fn chusql_storage_open(config_path: *const c_char) -> *mut
let text = unsafe { CStr::from_ptr(config_path) }
.to_str()
.map_err(|_| "config path is not valid UTF-8".to_string())?;
if text.is_empty() { None } else { Some(text.to_string()) }
if text.is_empty() {
None
} else {
Some(text.to_string())
}
};
Storage::open(path.as_deref()).map(Box::new)
}));
@@ -74,34 +78,69 @@ pub unsafe extern "C" fn chusql_storage_close(handle: *mut Storage) {
/// 离线维护系统目录并返回 JSON
///
/// # Safety
/// 输入为有效字符串;输出指针可写,响应使用 free 释放。
/// `config_path` 为 NULL 或有效 NUL 结尾字符串;请求字节在调用期间有效。
/// 输出指针可写且不与输入重叠;响应使用 free 释放。
#[unsafe(no_mangle)]
pub unsafe extern "C" fn chusql_storage_maintenance(
config_path: *const c_char, request: *const u8, request_len: usize,
out: *mut *mut u8, out_len: *mut usize,
config_path: *const c_char,
request: *const u8,
request_len: usize,
out: *mut *mut u8,
out_len: *mut usize,
) -> i32 {
if request.is_null() || out.is_null() || out_len.is_null() { set_error("invalid maintenance argument"); return ERR; }
unsafe { *out = ptr::null_mut(); *out_len = 0; }
if !out.is_null() {
unsafe {
*out = ptr::null_mut();
}
}
if !out_len.is_null() {
unsafe {
*out_len = 0;
}
}
if request.is_null() || out.is_null() || out_len.is_null() || request_len > isize::MAX as usize
{
set_error("invalid maintenance argument");
return ERR;
}
let result = catch_unwind(AssertUnwindSafe(|| {
let path = if config_path.is_null() { None } else { Some(unsafe { CStr::from_ptr(config_path) }.to_str().map_err(|e| e.to_string())?) };
let text = std::str::from_utf8(unsafe { slice::from_raw_parts(request, request_len) }).map_err(|e| e.to_string())?;
let path = if config_path.is_null() {
None
} else {
Some(
unsafe { CStr::from_ptr(config_path) }
.to_str()
.map_err(|e| e.to_string())?,
)
};
let text = std::str::from_utf8(unsafe { slice::from_raw_parts(request, request_len) })
.map_err(|e| e.to_string())?;
Storage::maintenance(path, text)
}));
let response = match result {
Ok(Ok(response)) => response,
Ok(Err(err)) => { set_error(err); return ERR; }
Err(_) => { set_error("panic in system maintenance"); return ERR; }
Ok(Err(err)) => {
set_error(err);
return ERR;
}
Err(_) => {
set_error("panic in system maintenance");
return ERR;
}
};
let mut buffer = response.into_bytes().into_boxed_slice();
unsafe { *out = buffer.as_mut_ptr(); *out_len = buffer.len(); }
std::mem::forget(buffer);
let buffer = response.into_bytes().into_boxed_slice();
unsafe {
*out_len = buffer.len();
*out = Box::into_raw(buffer) as *mut u8;
}
OK
}
/// 处理一条请求,响应缓冲须归还
///
/// # Safety
/// `handle` 必须是有效句柄;`request` 指向 `request_len` 个字节;`out`/`out_len` 可写。
/// `handle` 在调用期间有效且不能并发关闭;请求字节在调用期间有效。
/// `out`/`out_len` 可写且不与输入重叠;响应使用 free 释放。
#[unsafe(no_mangle)]
pub unsafe extern "C" fn chusql_storage_request(
handle: *const Storage,
@@ -116,7 +155,12 @@ pub unsafe extern "C" fn chusql_storage_request(
if !out_len.is_null() {
unsafe { *out_len = 0 };
}
if handle.is_null() || request.is_null() || out.is_null() || out_len.is_null() {
if handle.is_null()
|| request.is_null()
|| out.is_null()
|| out_len.is_null()
|| request_len > isize::MAX as usize
{
set_error("invalid argument");
return ERR;
}
@@ -139,13 +183,10 @@ pub unsafe extern "C" fn chusql_storage_request(
}
};
let mut buffer = response.into_bytes().into_boxed_slice();
let ptr = buffer.as_mut_ptr();
let len = buffer.len();
std::mem::forget(buffer);
let buffer = response.into_bytes().into_boxed_slice();
unsafe {
*out = ptr;
*out_len = len;
*out_len = buffer.len();
*out = Box::into_raw(buffer) as *mut u8;
}
OK
}
@@ -153,7 +194,7 @@ pub unsafe extern "C" fn chusql_storage_request(
/// 归还响应缓冲
///
/// # Safety
/// `data`/`len` 必须是 chusql_storage_request 原样返回且未被释放过的一对值。
/// `data`/`len` 为 request 或 maintenance 原样返回且未释放的一对值。
#[unsafe(no_mangle)]
pub unsafe extern "C" fn chusql_storage_free(data: *mut u8, len: usize) {
if data.is_null() {
@@ -168,7 +209,7 @@ pub unsafe extern "C" fn chusql_storage_free(data: *mut u8, len: usize) {
/// 取本线程最近的失败信息
///
/// # Safety
/// `out_len` 可写,或为 NULL。
/// `out_len` 可写,或为 NULL;返回字节仅在本线程下次设置错误前有效,不能释放。
#[unsafe(no_mangle)]
pub unsafe extern "C" fn chusql_storage_last_error(out_len: *mut usize) -> *const u8 {
LAST_ERROR.with(|slot| {
@@ -176,6 +217,10 @@ pub unsafe extern "C" fn chusql_storage_last_error(out_len: *mut usize) -> *cons
if !out_len.is_null() {
unsafe { *out_len = bytes.len() };
}
if bytes.is_empty() { ptr::null() } else { bytes.as_ptr() }
if bytes.is_empty() {
ptr::null()
} else {
bytes.as_ptr()
}
})
}
+83 -15
View File
@@ -1,8 +1,8 @@
use serde::Deserializer;
use serde::de::{IgnoredAny, MapAccess, Visitor};
use std::collections::HashSet;
use std::io;
use std::path::Path;
use serde::de::{IgnoredAny, MapAccess, Visitor};
use serde::Deserializer;
use crate::btree::DiskBTree;
use crate::page::PageId;
@@ -11,12 +11,18 @@ use crate::protocol::Row;
// 堆表:行按插入顺序进页,支持全表扫描、按索引取行、行级删除。
pub(crate) const DUPLICATE_ID: &str = "duplicate value on the id index";
const HEADER_SIZE: usize = 2;
const SLOT_SIZE: usize = 8;
const SLOT_DIR_START: usize = HEADER_SIZE;
/// 未选字段只校验并跳过,不分配值。
fn decode_row(bytes: &[u8], columns: Option<&[String]>, hidden: &HashSet<String>) -> io::Result<Row> {
fn decode_row(
bytes: &[u8],
columns: Option<&[String]>,
hidden: &HashSet<String>,
) -> io::Result<Row> {
struct RowVisitor<'a>(Option<&'a [String]>, &'a HashSet<String>);
impl<'de> Visitor<'de> for RowVisitor<'_> {
type Value = Row;
@@ -38,7 +44,9 @@ fn decode_row(bytes: &[u8], columns: Option<&[String]>, hidden: &HashSet<String>
}
}
let mut decoder = serde_json::Deserializer::from_slice(bytes);
let row = decoder.deserialize_map(RowVisitor(columns, hidden)).map_err(io::Error::other)?;
let row = decoder
.deserialize_map(RowVisitor(columns, hidden))
.map_err(io::Error::other)?;
decoder.end().map_err(io::Error::other)?;
Ok(row)
}
@@ -93,7 +101,7 @@ fn row_int(row: &Row, column: &str) -> Option<i64> {
}
/// i64 键 → 8 字节大端(保序,负数也在前)
fn key_of(value: i64) -> [u8; 8] {
pub(crate) fn key_of(value: i64) -> [u8; 8] {
(value as u64 ^ (1u64 << 63)).to_be_bytes()
}
@@ -108,10 +116,23 @@ fn value_key(v: &serde_json::Value) -> Option<Vec<u8>> {
}
/// 取行里某一列的索引键;NULL 与缺列不入索引
fn row_key(row: &Row, column: &str) -> Option<Vec<u8>> {
pub(crate) fn row_key(row: &Row, column: &str) -> Option<Vec<u8>> {
row.get(column).and_then(value_key)
}
/// 按实际键编码校验一列的索引容量
pub(crate) fn check_index_key(
row: &Row,
column: &str,
page_size: usize,
order: usize,
) -> io::Result<()> {
if let Some(key) = row_key(row, column) {
DiskBTree::check_key(&key, page_size, order)?;
}
Ok(())
}
pub struct HeapPage;
impl HeapPage {
@@ -312,7 +333,7 @@ impl HeapTable {
Ok(()) => {}
Err(err) if err.kind() == io::ErrorKind::InvalidData => {
// 格式不兼容(例如上一版落的索引文件):删掉重开
let _ = std::fs::remove_file(p);
crate::page_wal::remove(p)?;
t.attach_index(col, p, page_size, btree_order, pool_size)?;
}
Err(err) => return Err(err),
@@ -373,6 +394,7 @@ impl HeapTable {
let Some(k) = row_key(&r, column) else {
continue;
};
DiskBTree::check_key(&k, page_size, btree_order)?;
// 行身份索引仍然唯一;其余列允许重复值
if column == "id" && !seen.insert(k.clone()) {
return Err(io::Error::new(
@@ -450,10 +472,11 @@ impl HeapTable {
let Some(k) = row_key(row, &idx.column) else {
continue;
};
idx.tree.validate_key(&k)?;
if idx.column == "id" && idx.tree.get(&k)?.is_some() {
return Err(io::Error::new(
io::ErrorKind::InvalidInput,
"duplicate value on the id index".to_string(),
DUPLICATE_ID.to_string(),
));
}
pending.push((i, k));
@@ -511,6 +534,16 @@ impl HeapTable {
Ok((page_id, slot))
}
/// 读取身份索引中同键行数供提交预检
pub(crate) fn id_key_count(&mut self, key: &[u8]) -> io::Result<usize> {
let index = self
.indexes
.iter_mut()
.find(|index| index.column == "id")
.ok_or_else(|| io::Error::other("missing id index"))?;
Ok(index.tree.get_all(key)?.len())
}
/// 按 `id` 取一行
pub fn get_by_key(&mut self, key: i64) -> io::Result<Option<Row>> {
self.get_by_column_key("id", key)
@@ -577,13 +610,21 @@ impl HeapTable {
let mut rows = Vec::new();
for (key, pos) in pairs {
if let Some((bound, inclusive)) = &lo_bound {
let outside = if *inclusive { &key < bound } else { &key <= bound };
let outside = if *inclusive {
&key < bound
} else {
&key <= bound
};
if outside {
continue;
}
}
if let Some((bound, inclusive)) = &hi_bound {
let outside = if *inclusive { &key > bound } else { &key >= bound };
let outside = if *inclusive {
&key > bound
} else {
&key >= bound
};
if outside {
continue;
}
@@ -699,7 +740,10 @@ impl HeapTable {
}
/// 全表扫描,带位置与列投影
fn scan_projected_with_positions(&mut self, columns: Option<&[String]>) -> io::Result<Vec<(PageId, u16, Row)>> {
fn scan_projected_with_positions(
&mut self,
columns: Option<&[String]>,
) -> io::Result<Vec<(PageId, u16, Row)>> {
let n = self.file.num_pages()?;
self.scan_pages_with_positions(columns, 0, n)
}
@@ -729,6 +773,14 @@ impl HeapTable {
/// 整表改写并重建所有索引
pub fn replace_all(&mut self, rows: &[Row]) -> io::Result<()> {
for row in rows {
Self::encode_row(row, self.file.page_size())?;
for index in &self.indexes {
if let Some(key) = row_key(row, &index.column) {
index.tree.validate_key(&key)?;
}
}
}
self.file.truncate()?;
for idx in &mut self.indexes {
idx.tree.clear()?;
@@ -745,6 +797,14 @@ impl HeapTable {
Ok(())
}
/// 同时标记堆页与索引页的提交点
pub(crate) fn set_lsn(&mut self, lsn: u64) {
self.file.set_lsn(lsn);
for index in &mut self.indexes {
index.tree.set_lsn(lsn);
}
}
/// 把脏页写回(索引也一起)
pub fn flush(&mut self) -> io::Result<()> {
for idx in &mut self.indexes {
@@ -767,11 +827,19 @@ impl HeapTable {
}
/// 当前缓存页数
pub fn cached_pages(&self) -> usize { self.file.cached_pages() }
pub fn cached_pages(&self) -> usize {
self.file.cached_pages()
}
/// 命中次数
pub fn hits(&self) -> u64 { self.file.hits() }
pub fn hits(&self) -> u64 {
self.file.hits()
}
/// 未命中次数
pub fn misses(&self) -> u64 { self.file.misses() }
pub fn misses(&self) -> u64 {
self.file.misses()
}
/// 命中率
pub fn hit_rate(&self) -> f64 { self.file.hit_rate() }
pub fn hit_rate(&self) -> f64 {
self.file.hit_rate()
}
}
+2
View File
@@ -6,7 +6,9 @@ pub mod config;
pub mod ffi;
pub mod heap;
pub mod log;
mod mvcc;
pub mod page;
mod page_wal;
pub mod protocol;
pub mod runtime;
pub mod wal;
+13 -3
View File
@@ -1,7 +1,7 @@
use std::fmt;
use std::io::{IsTerminal, Write};
use std::sync::atomic::{AtomicU8, Ordering};
use std::sync::OnceLock;
use std::sync::atomic::{AtomicU8, Ordering};
// 极简日志:等级用原子变量,关掉的等级只花一次原子读。
@@ -123,8 +123,18 @@ fn streams_to_stderr(level: Level) -> bool {
/// 按目标流是否终端决定是否着色
fn color_enabled(to_stderr: bool) -> bool {
let cached = if to_stderr { &COLOR_STDERR } else { &COLOR_STDOUT };
*cached.get_or_init(|| if to_stderr { std::io::stderr().is_terminal() } else { std::io::stdout().is_terminal() })
let cached = if to_stderr {
&COLOR_STDERR
} else {
&COLOR_STDOUT
};
*cached.get_or_init(|| {
if to_stderr {
std::io::stderr().is_terminal()
} else {
std::io::stdout().is_terminal()
}
})
}
/// 拼一行(纯函数,可测)
File diff suppressed because it is too large. Load diff
+50 -33
View File
@@ -3,6 +3,8 @@ use std::fs::{File, OpenOptions};
use std::io::{self, Read, Seek, SeekFrom, Write};
use std::path::Path;
use crate::page_wal::PageWal;
// 页管理:定长页的读写,外加一层页缓冲池。
pub type PageId = u64;
@@ -33,6 +35,7 @@ impl Page {
#[derive(Debug)]
pub struct PageFile {
file: File,
journal: PageWal,
page_size: usize,
capacity: usize,
cache: HashMap<PageId, Page>,
@@ -55,14 +58,16 @@ impl PageFile {
page_size: usize,
capacity: usize,
) -> io::Result<Self> {
let file = OpenOptions::new()
let mut file = OpenOptions::new()
.read(true)
.write(true)
.create(true)
.truncate(false)
.open(path)?;
.open(path.as_ref())?;
let journal = PageWal::open(path.as_ref(), page_size, &mut file)?;
Ok(PageFile {
file,
journal,
page_size,
capacity,
cache: HashMap::new(),
@@ -74,6 +79,16 @@ impl PageFile {
})
}
/// 标记后续页修改所属的提交点
pub fn set_lsn(&mut self, lsn: u64) {
self.journal.set_lsn(lsn);
}
/// 读取已记录的页提交 LSN
pub fn page_lsn(&self, id: PageId) -> Option<u64> {
self.journal.page_lsn(id)
}
/// 页大小
pub fn page_size(&self) -> usize {
self.page_size
@@ -109,7 +124,6 @@ impl PageFile {
}
}
/// 标记为最近使用
fn touch(&mut self, id: PageId) {
self.clock += 1;
@@ -127,27 +141,28 @@ impl PageFile {
return Ok(false);
};
if self.dirty.contains(&victim) {
let p = self.cache[&victim].clone();
self.write_raw(&p)?;
self.dirty.remove(&victim);
let pages: Vec<_> = self
.dirty
.iter()
.filter_map(|id| self.cache.get(id).cloned())
.collect();
let images: Vec<_> = pages
.iter()
.map(|page| (page.id, page.data.as_slice()))
.collect();
self.journal.prepare(&images)?;
for page in &pages {
self.write_image(page)?;
}
self.dirty.clear();
}
self.cache.remove(&victim);
self.last_used.remove(&victim);
Ok(true)
}
/// 直接写文件
fn write_raw(&mut self, page: &Page) -> io::Result<()> {
if page.data.len() != self.page_size {
return Err(io::Error::new(
io::ErrorKind::InvalidInput,
format!(
"page has {} bytes, this file uses {}",
page.data.len(),
self.page_size
),
));
}
/// 将已记录镜像的页写入数据文件
fn write_image(&mut self, page: &Page) -> io::Result<()> {
self.file
.seek(SeekFrom::Start(page.id * self.page_size as u64))?;
self.file.write_all(&page.data)
@@ -156,12 +171,12 @@ impl PageFile {
/// 直接从文件读
fn read_raw(&mut self, id: PageId) -> io::Result<Page> {
let mut data = vec![0u8; self.page_size];
self.file.seek(SeekFrom::Start(id * self.page_size as u64))?;
self.file
.seek(SeekFrom::Start(id * self.page_size as u64))?;
self.file.read_exact(&mut data)?;
Ok(Page { id, data })
}
/// 读一页(走缓存)
pub fn read_page(&mut self, id: PageId) -> io::Result<Page> {
self.note_access(id)?;
@@ -241,26 +256,27 @@ impl PageFile {
));
}
let on_disk = len / size;
let cached_max = self
.cache
.keys()
.copied()
.max()
.map(|m| m + 1)
.unwrap_or(0);
let cached_max = self.cache.keys().copied().max().map(|m| m + 1).unwrap_or(0);
Ok(on_disk.max(cached_max))
}
/// 把脏页写回磁盘
pub fn flush(&mut self) -> io::Result<()> {
let dirty: Vec<PageId> = self.dirty.iter().copied().collect();
for id in dirty {
if let Some(p) = self.cache.get(&id) {
let p = p.clone();
self.write_raw(&p)?;
}
let pages: Vec<Page> = self
.dirty
.iter()
.filter_map(|id| self.cache.get(id).cloned())
.collect();
let images: Vec<_> = pages
.iter()
.map(|page| (page.id, page.data.as_slice()))
.collect();
self.journal.prepare(&images)?;
for page in &pages {
self.write_image(page)?;
}
self.file.sync_all()?;
self.journal.checkpoint()?;
self.dirty.clear();
Ok(())
}
@@ -272,6 +288,7 @@ impl PageFile {
/// 清空文件
pub fn truncate(&mut self) -> io::Result<()> {
self.journal.reset()?;
self.cache.clear();
self.last_used.clear();
self.dirty.clear();
+294
View File
@@ -0,0 +1,294 @@
use std::collections::BTreeMap;
use std::fs::{File, OpenOptions};
use std::io::{self, Read, Seek, SeekFrom, Write};
use std::path::{Path, PathBuf};
use serde::{Deserialize, Serialize};
// 全页预写镜像修复撕裂写,页 LSN 在数据同步后原子发布。
const HEADER: usize = 40;
const RESET: u64 = u64::MAX;
#[derive(Debug, Serialize, Deserialize)]
struct State {
version: u32,
page_size: usize,
sequence: u64,
pages: BTreeMap<u64, u64>,
}
#[derive(Debug)]
pub(crate) struct PageWal {
path: PathBuf,
state: State,
lsn: u64,
pending: bool,
failed: bool,
file: Option<File>,
}
/// 为页文件生成独立的元数据路径
fn sidecar(path: &Path, suffix: &str) -> PathBuf {
let mut name = path.as_os_str().to_os_string();
name.push(suffix);
PathBuf::from(name)
}
/// 计算帧校验和以拒绝损坏的完整镜像
fn checksum(bytes: &[u8]) -> u64 {
bytes.iter().fold(0xcbf29ce484222325, |hash, byte| {
(hash ^ u64::from(*byte)).wrapping_mul(0x100000001b3)
})
}
/// 同步目录中的创建、替换与删除
fn sync_parent(path: &Path) -> io::Result<()> {
#[cfg(unix)]
File::open(
path.parent()
.filter(|p| !p.as_os_str().is_empty())
.unwrap_or(Path::new(".")),
)?
.sync_all()?;
Ok(())
}
impl PageWal {
/// 加载页版本并先恢复未完成的全页写入
pub(crate) fn open(path: &Path, page_size: usize, data: &mut File) -> io::Result<Self> {
let metadata = sidecar(path, ".pages");
let state = match std::fs::read(&metadata) {
Ok(bytes) => serde_json::from_slice::<State>(&bytes).map_err(io::Error::other)?,
Err(error) if error.kind() == io::ErrorKind::NotFound => State {
version: 1,
page_size,
sequence: 0,
pages: BTreeMap::new(),
},
Err(error) => return Err(error),
};
if state.version != 1 || state.page_size != page_size {
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"unsupported page LSN metadata",
));
}
let mut journal = Self {
path: path.to_path_buf(),
state,
lsn: 0,
pending: false,
failed: false,
file: None,
};
journal.recover(data)?;
Ok(journal)
}
/// 设置后续脏页所属的逻辑 WAL 提交点
pub(crate) fn set_lsn(&mut self, lsn: u64) {
self.lsn = lsn;
}
/// 读取已写镜像记录的页 LSN
pub(crate) fn page_lsn(&self, page: u64) -> Option<u64> {
self.state.pages.get(&page).copied()
}
/// 延迟创建日志并同步目录项
fn handle(&mut self) -> io::Result<&mut File> {
if self.file.is_none() {
let path = sidecar(&self.path, ".page-wal");
let file = OpenOptions::new()
.read(true)
.write(true)
.create(true)
.truncate(false)
.open(&path)?;
sync_parent(&path)?;
self.file = Some(file);
}
Ok(self.file.as_mut().expect("opened above"))
}
/// 持久化一批镜像后才允许修改数据页
pub(crate) fn prepare(&mut self, pages: &[(u64, &[u8])]) -> io::Result<()> {
if self.failed {
return Err(io::Error::other("page journal requires recovery"));
}
if pages.iter().any(|(page, bytes)| {
(*page == RESET && !bytes.is_empty())
|| (*page != RESET
&& (bytes.len() != self.state.page_size
|| page.checked_mul(self.state.page_size as u64).is_none()))
}) {
return Err(io::Error::new(
io::ErrorKind::InvalidInput,
"invalid page image size or offset",
));
}
if pages.is_empty() {
return Ok(());
}
self.failed = true;
for (page, bytes) in pages {
let sequence = self
.state
.sequence
.checked_add(1)
.ok_or_else(|| io::Error::other("page write sequence exhausted"))?;
let lsn = self
.lsn
.max(self.state.pages.get(page).copied().unwrap_or(0));
let mut frame = Vec::with_capacity(HEADER + bytes.len());
frame.extend_from_slice(b"CPW1");
frame.extend_from_slice(&sequence.to_le_bytes());
frame.extend_from_slice(&lsn.to_le_bytes());
frame.extend_from_slice(&page.to_le_bytes());
frame.extend_from_slice(&(bytes.len() as u32).to_le_bytes());
let mut checked = frame.clone();
checked.extend_from_slice(bytes);
frame.extend_from_slice(&checksum(&checked).to_le_bytes());
frame.extend_from_slice(bytes);
let file = self.handle()?;
file.seek(SeekFrom::End(0))?;
file.write_all(&frame)?;
self.state.sequence = sequence;
if *page == RESET {
self.state.pages.clear();
} else {
self.state.pages.insert(*page, lsn);
}
self.pending = true;
}
self.handle()?.sync_all()?;
self.failed = false;
Ok(())
}
/// 先记录截断以免重放旧页复活已删除数据
pub(crate) fn reset(&mut self) -> io::Result<()> {
self.prepare(&[(RESET, &[])])
}
/// 数据同步后发布页版本并清理镜像日志
pub(crate) fn checkpoint(&mut self) -> io::Result<()> {
if self.failed {
return Err(io::Error::other("page journal requires recovery"));
}
if !self.pending {
return Ok(());
}
self.failed = true;
let temporary = sidecar(&self.path, ".pages.pending");
let metadata = sidecar(&self.path, ".pages");
let mut file = File::create(&temporary)?;
serde_json::to_writer(&mut file, &self.state).map_err(io::Error::other)?;
file.sync_all()?;
drop(file);
std::fs::rename(&temporary, &metadata)?;
sync_parent(&metadata)?;
self.handle()?.set_len(0)?;
self.handle()?.sync_all()?;
self.pending = false;
self.failed = false;
Ok(())
}
/// 验证日志帧后重放比页检查点更新的镜像
fn recover(&mut self, data: &mut File) -> io::Result<()> {
let path = sidecar(&self.path, ".page-wal");
let mut file = match File::open(path) {
Ok(file) => file,
Err(error) if error.kind() == io::ErrorKind::NotFound => return Ok(()),
Err(error) => return Err(error),
};
if file.metadata()?.len() == 0 {
return Ok(());
}
let checkpoint = self.state.sequence;
let mut previous = 0;
loop {
let mut header = [0; HEADER];
match file.read_exact(&mut header) {
Ok(()) => (),
Err(error) if error.kind() == io::ErrorKind::UnexpectedEof => break,
Err(error) => return Err(error),
}
let sequence = u64::from_le_bytes(header[4..12].try_into().expect("fixed header"));
let lsn = u64::from_le_bytes(header[12..20].try_into().expect("fixed header"));
let page = u64::from_le_bytes(header[20..28].try_into().expect("fixed header"));
let len = u32::from_le_bytes(header[28..32].try_into().expect("fixed header")) as usize;
if &header[..4] != b"CPW1"
|| sequence <= previous
|| (page == RESET && len != 0)
|| (page != RESET && len != self.state.page_size)
{
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"invalid page image header",
));
}
let mut bytes = vec![0; len];
match file.read_exact(&mut bytes) {
Ok(()) => (),
Err(error) if error.kind() == io::ErrorKind::UnexpectedEof => break,
Err(error) => return Err(error),
}
let mut checked = header[..32].to_vec();
checked.extend_from_slice(&bytes);
if checksum(&checked)
!= u64::from_le_bytes(header[32..40].try_into().expect("fixed header"))
{
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"page image checksum mismatch",
));
}
previous = sequence;
if sequence <= checkpoint {
continue;
}
if page == RESET {
data.set_len(0)?;
self.state.pages.clear();
} else {
let offset = page
.checked_mul(self.state.page_size as u64)
.ok_or_else(|| io::Error::other("page offset overflow"))?;
data.seek(SeekFrom::Start(offset))?;
data.write_all(&bytes)?;
self.state.pages.insert(page, lsn);
}
self.state.sequence = sequence;
}
data.sync_all()?;
self.pending = true;
self.checkpoint()
}
}
/// 删除页文件及其版本与镜像文件
pub(crate) fn remove(path: &Path) -> io::Result<()> {
for suffix in [".page-wal", ".pages", ".pages.pending", ""] {
match std::fs::remove_file(sidecar(path, suffix)) {
Ok(()) => (),
Err(error) if error.kind() == io::ErrorKind::NotFound => (),
Err(error) => return Err(error),
}
}
sync_parent(path)
}
/// 改名时保留对应页版本与恢复材料
pub(crate) fn rename(from: &Path, to: &Path) -> io::Result<()> {
for suffix in [".page-wal", ".pages", ".pages.pending", ""] {
match std::fs::rename(sidecar(from, suffix), sidecar(to, suffix)) {
Ok(()) => (),
Err(error) if error.kind() == io::ErrorKind::NotFound => (),
Err(error) => return Err(error),
}
}
sync_parent(to)
}
+224 -33
View File
@@ -25,6 +25,8 @@ pub struct Account {
pub is_superuser: bool,
#[serde(default)]
pub system_catalog_manager: bool,
#[serde(default)]
pub allow_sudo_auth: bool,
#[serde(default = "default_true")]
pub enabled: bool,
#[serde(default)]
@@ -92,19 +94,40 @@ pub struct IndexWire {
#[derive(Debug, Serialize, Deserialize)]
#[serde(tag = "method", rename_all = "snake_case")]
pub enum Request {
CatalogManage { command: Box<Request> },
CatalogManage {
command: Box<Request>,
},
AccountsList,
IdentityInitialize { administrator: String },
RoleCreate { user: String },
IdentityAlter { user: String, can_login: Option<bool>, is_superuser: Option<bool>, enabled: Option<bool>, system_catalog_manager: Option<bool> },
AccountCreate { user: String, password_hash: String },
AccountReset { user: String, password_hash: String },
IdentityInitialize {
administrator: String,
},
RoleCreate {
user: String,
},
IdentityAlter {
user: String,
can_login: Option<bool>,
is_superuser: Option<bool>,
enabled: Option<bool>,
system_catalog_manager: Option<bool>,
allow_sudo_auth: Option<bool>,
},
AccountCreate {
user: String,
password_hash: String,
},
AccountReset {
user: String,
password_hash: String,
},
AccountLogin {
user: String,
#[serde(default)]
at: Option<String>,
},
AccountDrop { user: String },
AccountDrop {
user: String,
},
/// 引导系统目录:建系统表,给了 user 就同时补首个管理员
BootstrapSystem {
#[serde(default)]
@@ -113,13 +136,18 @@ pub enum Request {
password_hash: Option<String>,
},
SystemStatus,
BootstrapTypes { types: Vec<Row> },
BootstrapTypes {
types: Vec<Row>,
},
Ping,
Scan {
table: String,
#[serde(default)]
columns: Option<Vec<String>>,
},
ValidateWrite {
table: String,
},
/// 分片扫描:第 shard 片只读总页数按 shards 均分后的那一段
ScanShard {
table: String,
@@ -174,6 +202,37 @@ pub enum Request {
table: String,
},
ListCatalog,
DomainSnapshot,
MvccBegin {
#[serde(default)]
serializable: bool,
},
MvccLock {
transaction: String,
ops: Vec<StorageOp>,
#[serde(default)]
reads: Vec<String>,
},
MvccPreview {
transaction: String,
},
MvccCommit {
transaction: String,
checkpoint: String,
ops: Vec<StorageOp>,
},
MvccRollback {
transaction: String,
},
DatabaseSnapshot {
#[serde(default)]
checkpoint: Option<String>,
},
AlterDomain {
table: String,
columns: Vec<SchemaColumn>,
checkpoint: String,
},
CreateIndex {
table: String,
column: String,
@@ -201,7 +260,7 @@ pub enum Request {
}
/// 事务提交里的一条写操作
#[derive(Debug, Serialize, Deserialize)]
#[derive(Debug, Clone, Serialize, Deserialize)]
#[serde(tag = "op", rename_all = "snake_case")]
pub enum StorageOp {
/// 追加写入的行(提交端已先删掉要覆盖的行)
@@ -212,37 +271,89 @@ pub enum StorageOp {
Replace { table: String, rows: Vec<Row> },
}
/// 检查存储表名和列名的字符集
pub(crate) fn valid_storage_name(name: &str) -> bool {
!name.is_empty() && name.chars().all(|c| c.is_ascii_alphanumeric() || c == '_')
}
/// 检查一行顶层字段名
fn valid_row_columns(row: &Row) -> bool {
row.keys().all(|name| valid_storage_name(name))
}
impl Request {
/// 拒绝可能影响文件路径的列名
/// 校验列定义与写入载荷的顶层字段名
pub fn valid_columns(&self) -> bool {
let valid = |name: &str| !name.is_empty()
&& name.chars().all(|c| c.is_ascii_alphanumeric() || c == '_');
match self {
Self::CreateIndex { column, .. } | Self::DropIndex { column, .. }
| Self::DropColumn { column, .. } | Self::LookupByIndex { column, .. }
| Self::RangeByIndex { column, .. } => valid(column),
Self::CreateTable { columns, .. } => columns.iter().all(|c| valid(&c.name)),
Self::ReplaceSchema { columns, .. } => columns.iter().all(|c| valid(&c.name)),
Self::CreateIndex { column, .. }
| Self::DropIndex { column, .. }
| Self::DropColumn { column, .. }
| Self::LookupByIndex { column, .. }
| Self::RangeByIndex { column, .. } => valid_storage_name(column),
Self::CreateTable { columns, .. } | Self::AlterDomain { columns, .. } => {
columns.iter().all(|c| valid_storage_name(&c.name))
}
Self::ReplaceSchema { columns, rows, .. } => {
columns.iter().all(|c| valid_storage_name(&c.name))
&& rows.iter().all(valid_row_columns)
}
Self::Insert { row, .. } => valid_row_columns(row),
Self::InsertBatch { rows, .. } | Self::ReplaceAll { rows, .. } => {
rows.iter().all(valid_row_columns)
}
Self::ApplyTransaction { ops }
| Self::MvccLock { ops, .. }
| Self::MvccCommit { ops, .. } => ops.iter().all(|op| match op {
StorageOp::Upsert { rows, .. } | StorageOp::Replace { rows, .. } => {
rows.iter().all(valid_row_columns)
}
StorageOp::Delete { .. } => true,
}),
_ => true,
}
}
/// 普通表操作的统一访问边界
pub fn table(&self) -> Option<&str> {
match self {
Self::Scan { table, .. } | Self::ScanShard { table, .. }
Self::Scan { table, .. }
| Self::ScanShard { table, .. }
| Self::ValidateWrite { table }
| Self::Insert { table, .. }
| Self::InsertBatch { table, .. } | Self::DeleteKeys { table, .. }
| Self::LookupByIndex { table, .. } | Self::ReplaceAll { table, .. }
| Self::InsertBatch { table, .. }
| Self::DeleteKeys { table, .. }
| Self::LookupByIndex { table, .. }
| Self::ReplaceAll { table, .. }
| Self::RangeByIndex { table, .. }
| Self::DescribeTable { table } | Self::CreateTable { table, .. }
| Self::DropTable { table } | Self::CreateIndex { table, .. }
| Self::DropIndex { table, .. } | Self::DropColumn { table, .. }
| Self::DescribeTable { table }
| Self::CreateTable { table, .. }
| Self::DropTable { table }
| Self::CreateIndex { table, .. }
| Self::DropIndex { table, .. }
| Self::DropColumn { table, .. }
| Self::Compact { table }
| Self::ReplaceSchema { table, .. } => Some(table),
Self::Ping | Self::ListTables | Self::ListCatalog | Self::AccountsList | Self::CatalogManage { .. }
| Self::IdentityInitialize { .. } | Self::RoleCreate { .. } | Self::IdentityAlter { .. }
| Self::AccountCreate { .. } | Self::AccountReset { .. } | Self::AccountLogin { .. }
| Self::AccountDrop { .. } | Self::BootstrapSystem { .. } | Self::SystemStatus
| Self::ReplaceSchema { table, .. }
| Self::AlterDomain { table, .. } => Some(table),
Self::Ping
| Self::ListTables
| Self::ListCatalog
| Self::DomainSnapshot
| Self::MvccPreview { .. }
| Self::MvccBegin { .. }
| Self::MvccLock { .. }
| Self::MvccCommit { .. }
| Self::MvccRollback { .. }
| Self::DatabaseSnapshot { .. }
| Self::AccountsList
| Self::CatalogManage { .. }
| Self::IdentityInitialize { .. }
| Self::RoleCreate { .. }
| Self::IdentityAlter { .. }
| Self::AccountCreate { .. }
| Self::AccountReset { .. }
| Self::AccountLogin { .. }
| Self::AccountDrop { .. }
| Self::BootstrapSystem { .. }
| Self::SystemStatus
| Self::BootstrapTypes { .. }
| Self::ApplyTransaction { .. } => None,
}
@@ -281,12 +392,27 @@ fn default_id_column() -> String {
#[derive(Debug, Serialize, Deserialize)]
#[serde(tag = "status", rename_all = "snake_case")]
pub enum Response {
Accounts { accounts: Vec<Account> },
Guarded {
response: Box<Response>,
},
Accounts {
accounts: Vec<Account>,
},
Pong,
Rows { rows: Vec<Row> },
Tables { tables: Vec<String> },
Rows {
rows: Vec<Row>,
},
Tables {
tables: Vec<String>,
},
Schema {
table: String,
#[serde(
default,
serialize_with = "serialize_version",
deserialize_with = "deserialize_version"
)]
schema_version: u64,
columns: Vec<SchemaColumn>,
#[serde(default)]
row_count: u64,
@@ -303,13 +429,54 @@ pub enum Response {
#[serde(default)]
last_lsn: u64,
},
Error { message: String },
Catalog { schemas: Vec<TableSchemaWire> },
Error {
message: String,
},
Catalog {
schemas: Vec<TableSchemaWire>,
},
DomainSnapshot {
schemas: Vec<TableSchemaWire>,
rows: Vec<(String, Vec<Row>)>,
checkpoint: String,
},
MvccSnapshot {
transaction: String,
schemas: Vec<TableSchemaWire>,
rows: Vec<(String, Vec<Row>)>,
checkpoint: String,
},
SnapshotUnchanged {
checkpoint: String,
},
Object {
database_id: u64,
object_id: Option<u64>,
},
}
#[derive(Debug, Deserialize)]
pub struct BoundSchema {
pub table: String,
pub database_id: Option<String>,
pub object_id: Option<String>,
pub schema_version: Option<String>,
pub columns: Vec<SchemaColumn>,
}
#[derive(Debug, Clone, Serialize, Deserialize)]
pub struct TableSchemaWire {
pub table: String,
#[serde(default)]
pub database_id: u64,
#[serde(default)]
pub object_id: u64,
#[serde(
default,
serialize_with = "serialize_version",
deserialize_with = "deserialize_version"
)]
pub schema_version: u64,
pub columns: Vec<SchemaColumn>,
#[serde(default)]
pub row_count: u64,
@@ -318,3 +485,27 @@ pub struct TableSchemaWire {
#[serde(default)]
pub stats: Vec<ColumnStatWire>,
}
/// 将结构版本编码成精确十进制字符串
fn serialize_version<S: serde::Serializer>(
version: &u64,
serializer: S,
) -> Result<S::Ok, S::Error> {
serializer.serialize_str(&version.to_string())
}
/// 读取精确版本并兼容旧数值载荷
fn deserialize_version<'de, D: serde::Deserializer<'de>>(deserializer: D) -> Result<u64, D::Error> {
let value = serde_json::Value::deserialize(deserializer)?;
match value {
serde_json::Value::String(s)
if !s.is_empty() && s.len() <= 20 && s.bytes().all(|c| c.is_ascii_digit()) =>
{
s.parse().map_err(serde::de::Error::custom)
}
serde_json::Value::Number(n) => n
.as_u64()
.ok_or_else(|| serde::de::Error::custom("invalid schema version")),
_ => Err(serde::de::Error::custom("invalid schema version")),
}
}
File diff suppressed because it is too large. Load diff
+164 -35
View File
@@ -26,12 +26,30 @@ const OP_CREATE_TABLE: u8 = 11;
const OP_DROP_TABLE: u8 = 12;
const OP_CREATE_INDEX: u8 = 13;
const OP_DROP_INDEX: u8 = 14;
const OP_MIGRATE: u8 = 15;
#[derive(Debug, Clone, Serialize, Deserialize, PartialEq)]
pub enum WalOp {
HideColumn { table: String, column: String },
Compact { table: String, rows: Vec<Row> },
Accounts { accounts: Vec<Account>, removed: Vec<String>, migrate_roles: bool },
Migrate {
table: String,
object_id: u64,
source: String,
target: String,
},
HideColumn {
table: String,
column: String,
schema_version: Option<u64>,
},
Compact {
table: String,
rows: Vec<Row>,
},
Accounts {
accounts: Vec<Account>,
removed: Vec<String>,
migrate_roles: bool,
},
Insert {
table: String,
row: Row,
@@ -51,16 +69,19 @@ pub enum WalOp {
DropColumn {
table: String,
column: String,
schema_version: Option<u64>,
rows: Vec<Row>,
},
ReplaceSchema {
table: String,
columns: Vec<SchemaColumn>,
schema_version: Option<u64>,
rows: Vec<Row>,
},
CreateTable {
table: String,
columns: Vec<SchemaColumn>,
object_id: Option<u64>,
},
DropTable {
table: String,
@@ -77,21 +98,56 @@ pub enum WalOp {
Commit,
}
impl WalOp {
/// 返回单表操作的目标,账号组另行展开
pub(crate) fn table(&self) -> Option<&str> {
match self {
Self::Migrate { table, .. }
| Self::HideColumn { table, .. }
| Self::Compact { table, .. }
| Self::Insert { table, .. }
| Self::InsertBatch { table, .. }
| Self::DeleteKeys { table, .. }
| Self::ReplaceAll { table, .. }
| Self::DropColumn { table, .. }
| Self::ReplaceSchema { table, .. }
| Self::CreateTable { table, .. }
| Self::DropTable { table }
| Self::CreateIndex { table, .. }
| Self::DropIndex { table, .. } => Some(table),
Self::Accounts { .. } | Self::Commit => None,
}
}
}
#[derive(Debug, Serialize, Deserialize)]
struct HideColumnPayload {
column: String,
#[serde(default)]
schema_version: Option<u64>,
}
#[derive(Debug, Serialize, Deserialize)]
struct DropColumnPayload {
column: String,
#[serde(default)]
schema_version: Option<u64>,
rows: Vec<Row>,
}
#[derive(Debug, Serialize, Deserialize)]
struct ReplaceSchemaPayload {
columns: Vec<SchemaColumn>,
#[serde(default)]
schema_version: Option<u64>,
rows: Vec<Row>,
}
#[derive(Debug, Serialize, Deserialize)]
struct CreateTablePayload {
columns: Vec<SchemaColumn>,
#[serde(default)]
object_id: Option<u64>,
}
pub struct Wal {
@@ -239,13 +295,11 @@ impl Wal {
/// 读当前 WAL 的第一条操作;空则 None
pub fn read(&self) -> io::Result<Option<WalOp>> {
let scan = self.read_all()?;
Ok(scan.records.into_iter().find_map(|(_, op)| {
if op == WalOp::Commit {
None
} else {
Some(op)
}
}))
Ok(scan.records.into_iter().find_map(
|(_, op)| {
if op == WalOp::Commit { None } else { Some(op) }
},
))
}
/// 读全部记录,撕裂或损坏的尾巴按长度截断
@@ -271,9 +325,12 @@ impl Wal {
let mut frames = Vec::new();
let mut offset = 0usize;
while offset + 4 <= buf.len() {
let body_len =
u32::from_le_bytes([buf[offset], buf[offset + 1], buf[offset + 2], buf[offset + 3]])
as usize;
let body_len = u32::from_le_bytes([
buf[offset],
buf[offset + 1],
buf[offset + 2],
buf[offset + 3],
]) as usize;
let end = offset + 4 + body_len;
if end > buf.len() {
break;
@@ -308,7 +365,10 @@ impl Wal {
}
let bytes = std::fs::read(&path)?;
if bytes.len() != 8 {
return Err(io::Error::new(io::ErrorKind::InvalidData, "invalid WAL checkpoint length"));
return Err(io::Error::new(
io::ErrorKind::InvalidData,
"invalid WAL checkpoint length",
));
}
let mut raw = [0u8; 8];
raw.copy_from_slice(&bytes[..8]);
@@ -326,10 +386,14 @@ impl Wal {
if let Some((lsn, _, _, _)) = frames.last() {
base = base.max(*lsn);
}
*slot = base.checked_add(1).ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
*slot = base
.checked_add(1)
.ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
}
let lsn = *slot;
*slot = slot.checked_add(1).ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
*slot = slot
.checked_add(1)
.ok_or_else(|| io::Error::other("WAL LSN exhausted"))?;
Ok(lsn)
}
@@ -376,8 +440,9 @@ fn truncate(f: &mut File) -> io::Result<()> {
/// 把操作编成字节
fn encode(op: &WalOp, lsn: u64) -> io::Result<Vec<u8>> {
let (op_type, table, payload) = match op {
WalOp::HideColumn { table, column } => (OP_HIDE_COLUMN, table.clone(),
serde_json::to_vec(column).map_err(io::Error::other)?),
WalOp::Migrate { table, .. } => (OP_MIGRATE, table.clone(), serde_json::to_vec(op).map_err(io::Error::other)?),
WalOp::HideColumn { table, column, schema_version } => (OP_HIDE_COLUMN, table.clone(),
serde_json::to_vec(&serde_json::json!({"column":column,"schema_version":schema_version})).map_err(io::Error::other)?),
WalOp::Compact { table, rows } => {
let p = serde_json::to_vec(rows).map_err(io::Error::other)?;
(OP_COMPACT, table.clone(), p)
@@ -400,26 +465,28 @@ fn encode(op: &WalOp, lsn: u64) -> io::Result<Vec<u8>> {
let p = serde_json::to_vec(rows).map_err(io::Error::other)?;
(OP_REPLACE_ALL, table.clone(), p)
}
WalOp::DropColumn { table, column, rows } => {
WalOp::DropColumn { table, column, rows, schema_version } => {
let p = serde_json::to_vec(&DropColumnPayload {
column: column.clone(),
schema_version: *schema_version,
rows: rows.clone(),
})
.map_err(io::Error::other)?;
(OP_DROP_COLUMN, table.clone(), p)
}
WalOp::ReplaceSchema { table, columns, rows } => {
WalOp::ReplaceSchema { table, columns, rows, schema_version } => {
let p = serde_json::to_vec(&ReplaceSchemaPayload {
columns: columns.clone(),
schema_version: *schema_version,
rows: rows.clone(),
})
.map_err(io::Error::other)?;
(OP_REPLACE_SCHEMA, table.clone(), p)
}
WalOp::CreateTable { table, columns } => (
WalOp::CreateTable { table, columns, object_id } => (
OP_CREATE_TABLE,
table.clone(),
serde_json::to_vec(&CreateTablePayload { columns: columns.clone() })
serde_json::to_vec(&CreateTablePayload { columns: columns.clone(), object_id: *object_id })
.map_err(io::Error::other)?,
),
WalOp::DropTable { table } => (OP_DROP_TABLE, table.clone(), Vec::new()),
@@ -469,32 +536,91 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
let payload = &body[11 + table_len..];
let op = match op_type {
OP_MIGRATE => {
let op: WalOp = serde_json::from_slice(payload)
.map_err(|e| format!("bad migration payload: {e}"))?;
match &op {
WalOp::Migrate {
table: name,
source,
target,
..
} if name == &table
&& crate::catalog::valid_generation(source)
&& !target.is_empty()
&& crate::catalog::valid_generation(target) =>
{
op
}
_ => return Err("invalid migration WAL".into()),
}
}
OP_COMMIT => WalOp::Commit,
OP_HIDE_COLUMN => {
let column = serde_json::from_slice(payload)
let value: serde_json::Value = serde_json::from_slice(payload)
.map_err(|e| format!("bad hide_column payload: {e}"))?;
WalOp::HideColumn { table, column }
let (column, schema_version) = if let Some(column) = value.as_str() {
(column.to_string(), None)
} else {
let p: HideColumnPayload = serde_json::from_value(value)
.map_err(|e| format!("bad hide_column payload: {e}"))?;
(p.column, p.schema_version)
};
WalOp::HideColumn {
table,
column,
schema_version,
}
}
OP_COMPACT => {
let rows: Vec<Row> = serde_json::from_slice(payload)
.map_err(|e| format!("bad compact payload: {e}"))?;
let rows: Vec<Row> =
serde_json::from_slice(payload).map_err(|e| format!("bad compact payload: {e}"))?;
WalOp::Compact { table, rows }
}
OP_ACCOUNTS => {
if table != USERS_TABLE { return Err("invalid account WAL table".into()); }
let value: serde_json::Value = serde_json::from_slice(payload).map_err(|e| format!("bad account payload: {e}"))?;
if table != USERS_TABLE {
return Err("invalid account WAL table".into());
}
let value: serde_json::Value =
serde_json::from_slice(payload).map_err(|e| format!("bad account payload: {e}"))?;
let (accounts, removed, migrate_roles) = if value.is_array() {
(serde_json::from_value(value).map_err(|e| format!("bad account payload: {e}"))?, Vec::new(), false)
(
serde_json::from_value(value)
.map_err(|e| format!("bad account payload: {e}"))?,
Vec::new(),
false,
)
} else {
(serde_json::from_value(value.get("accounts").cloned().ok_or("missing account payload")?).map_err(|e| format!("bad account payload: {e}"))?,
serde_json::from_value(value.get("removed").cloned().ok_or("missing identity cleanup")?).map_err(|e| format!("bad account cleanup: {e}"))?,
value.get("migrate_roles").and_then(serde_json::Value::as_bool).ok_or("missing role migration flag")?)
(
serde_json::from_value(
value
.get("accounts")
.cloned()
.ok_or("missing account payload")?,
)
.map_err(|e| format!("bad account payload: {e}"))?,
serde_json::from_value(
value
.get("removed")
.cloned()
.ok_or("missing identity cleanup")?,
)
.map_err(|e| format!("bad account cleanup: {e}"))?,
value
.get("migrate_roles")
.and_then(serde_json::Value::as_bool)
.ok_or("missing role migration flag")?,
)
};
WalOp::Accounts { accounts, removed, migrate_roles }
WalOp::Accounts {
accounts,
removed,
migrate_roles,
}
}
OP_INSERT => {
let row: Row =
serde_json::from_slice(payload).map_err(|e| format!("bad insert payload: {}", e))?;
let row: Row = serde_json::from_slice(payload)
.map_err(|e| format!("bad insert payload: {}", e))?;
WalOp::Insert { table, row }
}
OP_INSERT_BATCH => {
@@ -518,6 +644,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
WalOp::DropColumn {
table,
column: p.column,
schema_version: p.schema_version,
rows: p.rows,
}
}
@@ -527,6 +654,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
WalOp::ReplaceSchema {
table,
columns: p.columns,
schema_version: p.schema_version,
rows: p.rows,
}
}
@@ -536,6 +664,7 @@ fn decode_body(body: &[u8]) -> Result<(u64, WalOp), String> {
WalOp::CreateTable {
table,
columns: p.columns,
object_id: p.object_id,
}
}
OP_DROP_TABLE => WalOp::DropTable { table },
+181 -9
View File
@@ -1,12 +1,62 @@
use chusql_core_storage::btree::{fits_in_page, DiskBTree, MAX_KEY_BYTES};
use chusql_core_storage::btree::{DiskBTree, MAX_KEY_BYTES, fits_in_page};
use chusql_core_storage::config::{DEFAULT_BTREE_ORDER, DEFAULT_PAGE_SIZE};
use chusql_core_storage::page::DEFAULT_POOL_SIZE;
use std::io::{ErrorKind, Seek, SeekFrom, Write};
// B+ 树测试:字节键、重复键、范围扫描、重开与配置校验。
/// 损坏节点返回数据错误且重复读取不 panic
#[test]
fn malformed_node_fields_return_invalid_data() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("corrupt.idx");
{
let mut tree = open(dir.path(), "corrupt.idx");
tree.insert(b"x", 1).unwrap();
tree.insert(b"y", 2).unwrap();
}
let original = std::fs::read(&path).unwrap();
let cell = u16::from_le_bytes([
original[DEFAULT_PAGE_SIZE + 11],
original[DEFAULT_PAGE_SIZE + 12],
]) as usize;
for (name, offset, bytes) in [
("slot count", 1, vec![255, 255]),
("node kind", 0, vec![2]),
("cell overlaps slots", 11, vec![0, 0]),
("cell beyond page", 11, vec![255, 15]),
(
"overlapping cells",
13,
(cell as u16).to_le_bytes().to_vec(),
),
("key length", cell, vec![255, 255]),
("key order", cell + 2, vec![b'z']),
("zero child", 0, vec![1]),
] {
std::fs::write(&path, &original).unwrap();
let mut file = std::fs::OpenOptions::new().write(true).open(&path).unwrap();
file.seek(SeekFrom::Start((DEFAULT_PAGE_SIZE + offset) as u64))
.unwrap();
file.write_all(&bytes).unwrap();
drop(file);
let mut tree = open(dir.path(), "corrupt.idx");
for _ in 0..2 {
let error = tree.get(b"x").unwrap_err();
assert_eq!(error.kind(), ErrorKind::InvalidData, "{name}: {error}");
}
}
}
/// 按默认参数打开指定索引文件
fn open(dir: &std::path::Path, name: &str) -> DiskBTree {
DiskBTree::open(dir.join(name), DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap()
DiskBTree::open(
dir.join(name),
DEFAULT_PAGE_SIZE,
DEFAULT_BTREE_ORDER,
DEFAULT_POOL_SIZE,
)
.unwrap()
}
/// 整数键编码成保序的 8 字节(与堆表一致)
@@ -14,6 +64,29 @@ fn key(n: i64) -> [u8; 8] {
(n as u64 ^ (1u64 << 63)).to_be_bytes()
}
/// 重复键跨页后仍能完整查找和删除
#[test]
fn duplicate_keys_across_splits() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("split-duplicates.idx");
let mut tree = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
for value in (0..100).rev() {
tree.insert(b"same", value).unwrap();
}
drop(tree);
let mut tree = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
assert_eq!(tree.get(b"same").unwrap(), Some(0));
assert_eq!(tree.get_all(b"same").unwrap(), (0..100).collect::<Vec<_>>());
assert_eq!(tree.scan(Some(b"same"), Some(b"same")).unwrap().len(), 100);
for value in 0..100 {
assert!(tree.delete(b"same", value).unwrap());
}
assert!(!tree.delete(b"same", 0).unwrap());
drop(tree);
let mut tree = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
assert!(tree.get_all(b"same").unwrap().is_empty());
}
/// 空树查不到,遍历为空
#[test]
fn empty_tree_get() {
@@ -42,12 +115,24 @@ fn reopen_persists() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("t.idx");
{
let mut t = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap();
let mut t = DiskBTree::open(
&path,
DEFAULT_PAGE_SIZE,
DEFAULT_BTREE_ORDER,
DEFAULT_POOL_SIZE,
)
.unwrap();
for i in 0..50 {
t.insert(&key(i), i as u64).unwrap();
}
}
let mut t = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap();
let mut t = DiskBTree::open(
&path,
DEFAULT_PAGE_SIZE,
DEFAULT_BTREE_ORDER,
DEFAULT_POOL_SIZE,
)
.unwrap();
for i in 0..50 {
assert_eq!(t.get(&key(i)).unwrap(), Some(i as u64));
}
@@ -89,12 +174,26 @@ fn config_mismatch_errors() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("t.idx");
{
let mut t = DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).unwrap();
let mut t = DiskBTree::open(
&path,
DEFAULT_PAGE_SIZE,
DEFAULT_BTREE_ORDER,
DEFAULT_POOL_SIZE,
)
.unwrap();
t.insert(&key(1), 1).unwrap();
}
assert!(DiskBTree::open(&path, DEFAULT_PAGE_SIZE, 8, DEFAULT_POOL_SIZE).is_err());
assert!(DiskBTree::open(&path, 8192, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).is_err());
assert!(DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).is_ok());
assert!(
DiskBTree::open(
&path,
DEFAULT_PAGE_SIZE,
DEFAULT_BTREE_ORDER,
DEFAULT_POOL_SIZE
)
.is_ok()
);
}
/// 不是索引文件要报错
@@ -103,7 +202,15 @@ fn not_an_index_file_errors() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("junk.idx");
std::fs::write(&path, vec![7u8; DEFAULT_PAGE_SIZE]).unwrap();
assert!(DiskBTree::open(&path, DEFAULT_PAGE_SIZE, DEFAULT_BTREE_ORDER, DEFAULT_POOL_SIZE).is_err());
assert!(
DiskBTree::open(
&path,
DEFAULT_PAGE_SIZE,
DEFAULT_BTREE_ORDER,
DEFAULT_POOL_SIZE
)
.is_err()
);
}
/// order 放不进一页要报错
@@ -123,7 +230,10 @@ fn delete_removes_only_that_key() {
t.insert(&key(i), i as u64 + 1).unwrap();
}
assert!(t.delete(&key(50), 51).unwrap(), "deleting an existing entry should return true");
assert!(
t.delete(&key(50), 51).unwrap(),
"deleting an existing entry should return true"
);
assert_eq!(t.get(&key(50)).unwrap(), None);
assert_eq!(t.get(&key(49)).unwrap(), Some(50));
assert_eq!(t.get(&key(51)).unwrap(), Some(52));
@@ -203,7 +313,11 @@ fn splits_keep_keys_sorted() {
let all: Vec<Vec<u8>> = t.iter_all().unwrap().into_iter().map(|(k, _)| k).collect();
assert_eq!(all, expected);
for k in &expected {
assert!(t.get(k).unwrap().is_some(), "missing {:?}", String::from_utf8_lossy(k));
assert!(
t.get(k).unwrap().is_some(),
"missing {:?}",
String::from_utf8_lossy(k)
);
}
}
@@ -255,3 +369,61 @@ fn clear_resets_the_tree() {
t.insert(b"c", 3).unwrap();
assert_eq!(t.get(b"c").unwrap(), Some(3));
}
/// 长键跨页后可重启查询并保留旧配置
#[test]
fn long_keys_split_reopen_and_preserve_dense_configuration() {
use chusql_core_storage::btree::key_limit;
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("long.idx");
let mut tree = DiskBTree::open(&path, 512, 4, DEFAULT_POOL_SIZE).unwrap();
for n in 0..80_u64 {
let key = format!("{n:03}{}", "a".repeat(125));
tree.insert(key.as_bytes(), n).unwrap();
}
drop(tree);
let mut tree = DiskBTree::open(&path, 512, 4, DEFAULT_POOL_SIZE).unwrap();
assert_eq!(tree.scan(None, None).unwrap().len(), 80);
for n in 0..80_u64 {
let key = format!("{n:03}{}", "a".repeat(125));
assert_eq!(tree.get(key.as_bytes()).unwrap(), Some(n));
}
let dense_path = dir.path().join("dense.idx");
let mut dense = DiskBTree::open(&dense_path, 512, 7, DEFAULT_POOL_SIZE).unwrap();
let limit = key_limit(512, 7);
assert!((64..MAX_KEY_BYTES).contains(&limit));
dense.insert(&vec![b'a'; limit], 1).unwrap();
assert_eq!(
dense.insert(&vec![b'b'; limit + 1], 2).unwrap_err().kind(),
ErrorKind::InvalidInput
);
assert_eq!(dense.get(&vec![b'a'; limit]).unwrap(), Some(1));
}
/// 旧文件头可无损打开并首次写入长键
#[test]
fn legacy_key_header_upgrades_only_when_long_keys_are_written() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("legacy.idx");
let mut tree = open(dir.path(), "legacy.idx");
tree.insert(b"old", 1).unwrap();
drop(tree);
let mut bytes = std::fs::read(&path).unwrap();
bytes[8..10].copy_from_slice(&64_u16.to_le_bytes());
std::fs::write(&path, &bytes).unwrap();
let mut tree = open(dir.path(), "legacy.idx");
assert_eq!(tree.get(b"old").unwrap(), Some(1));
drop(tree);
assert_eq!(std::fs::read(&path).unwrap(), bytes);
let mut tree = open(dir.path(), "legacy.idx");
let key = "author/".to_string() + &"p".repeat(80);
tree.insert(key.as_bytes(), 2).unwrap();
drop(tree);
let mut tree = open(dir.path(), "legacy.idx");
assert_eq!(tree.get(key.as_bytes()).unwrap(), Some(2));
assert_eq!(tree.get(b"old").unwrap(), Some(1));
assert_eq!(
&std::fs::read(&path).unwrap()[8..10],
&128_u16.to_le_bytes()
);
}
+201 -16
View File
@@ -4,7 +4,148 @@ use serde_json::json;
// 数据字典测试:补列、去重、未知表。
/// 结构变化递增版本,数据及重复应用不变
#[test]
fn schema_versions_track_structure_and_survive_reload() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("catalog.json");
let mut c = Catalog::default();
c.create_table("t", vec![]).unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 1);
let values = row(&[("id", json!(1)), ("name", json!("a"))]);
c.record_insert("t", &values).unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 2);
c.rebuild_stats("t", &[values]).unwrap();
let columns = c.describe("t").unwrap().columns.clone();
c.set_columns("t", columns).unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 2);
c.remove_column("t", "name").unwrap();
c.remove_column("t", "name").unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 3);
c.rename_table("t", "renamed").unwrap();
c.save(&path).unwrap();
let c = Catalog::load(&path).unwrap();
assert_eq!(c.describe("renamed").unwrap().schema_version, 4);
}
/// 旧目录版本未知,首个结构变更才递增
#[test]
fn legacy_schema_version_remains_unknown_until_change() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("catalog.json");
std::fs::write(
&path,
json!({"tables": {
"t": {"object_id": 42, "columns": []}
}})
.to_string(),
)
.unwrap();
let mut c = Catalog::load(&path).unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 0);
c.save(&path).unwrap();
c = Catalog::load(&path).unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 0);
c.ensure_columns("t", &row(&[("id", json!(1))])).unwrap();
assert_eq!(c.describe("t").unwrap().schema_version, 1);
assert_eq!(c.describe("t").unwrap().object_id, 42);
}
/// 版本耗尽拒绝结构变更并保留原定义
#[test]
fn exhausted_schema_version_preserves_structure() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("catalog.json");
std::fs::write(
&path,
json!({"tables": {
"t": {"object_id": 42, "schema_version": u64::MAX,
"columns": [{"name": "id", "ty": "int"}]}
}})
.to_string(),
)
.unwrap();
let mut c = Catalog::load(&path).unwrap();
assert!(c.remove_column("t", "id").is_err());
assert!(c.set_columns("t", vec![]).is_err());
assert!(c.rename_table("t", "other").is_err());
assert!(c.ensure_columns("t", &row(&[("new", json!(1))])).is_err());
assert_eq!(c.describe("t").unwrap().columns.len(), 1);
assert_eq!(c.describe("t").unwrap().schema_version, u64::MAX);
assert!(c.describe("other").is_none());
c.record_insert("t", &row(&[("id", json!(1))])).unwrap();
}
/// 表删除重建和重载均保留编号规则
#[test]
fn object_ids_survive_reload_and_are_not_reused() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("catalog.json");
let mut catalog = Catalog::default();
catalog.create_table("t", vec![]).unwrap();
let old = catalog.describe("t").unwrap().object_id;
assert_ne!(old, 0);
catalog.save(&path).unwrap();
let mut catalog = Catalog::load(&path).unwrap();
assert_eq!(catalog.describe("t").unwrap().object_id, old);
catalog.drop_table("t").unwrap();
catalog.save(&path).unwrap();
let mut catalog = Catalog::load(&path).unwrap();
catalog.create_table("t", vec![]).unwrap();
assert!(catalog.describe("t").unwrap().object_id > old);
}
/// 旧目录迁移保留已有编号并拒绝重复
#[test]
fn legacy_object_ids_upgrade_without_collisions() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("catalog.json");
std::fs::write(
&path,
json!({"tables": {
"a": {"columns": [], "object_id": 42},
"b": {"columns": []}
}})
.to_string(),
)
.unwrap();
let catalog = Catalog::load(&path).unwrap();
assert_eq!(catalog.describe("a").unwrap().object_id, 42);
assert_eq!(catalog.describe("b").unwrap().object_id, 43);
catalog.save(&path).unwrap();
assert_eq!(
Catalog::load(&path)
.unwrap()
.describe("b")
.unwrap()
.object_id,
43
);
std::fs::write(
&path,
json!({"tables": {
"a": {"columns": [], "object_id": 42},
"b": {"columns": [], "object_id": 42}
}})
.to_string(),
)
.unwrap();
assert!(
Catalog::load(&path)
.unwrap_err()
.to_string()
.contains("duplicate")
);
}
/// 编号耗尽明确失败且不建立对象
#[test]
fn exhausted_object_ids_fail_without_creating_table() {
let mut catalog = Catalog::default();
catalog.object_high_water = u64::MAX;
assert!(catalog.create_table("t", vec![]).is_err());
assert!(catalog.describe("t").is_none());
}
/// 用键值对构造一行
fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
@@ -17,7 +158,8 @@ fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
/// 空文件得到空字典,未知表返回 None
#[test]
fn empty_file_gives_empty_catalog_and_unknown_table_returns_none() { let dir = tempfile::tempdir().unwrap();
fn empty_file_gives_empty_catalog_and_unknown_table_returns_none() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("catalog.json");
let c = Catalog::load(&path).unwrap();
assert_eq!(c.table_names().len(), 0);
@@ -31,7 +173,8 @@ fn ensure_then_describe() {
let path = dir.path().join("catalog.json");
let mut c = Catalog::load(&path).unwrap();
c.ensure_columns("users", &row(&[("id", json!(1)), ("name", json!("Alice"))]));
c.ensure_columns("users", &row(&[("id", json!(1)), ("name", json!("Alice"))]))
.unwrap();
c.save(&path).unwrap();
let c2 = Catalog::load(&path).unwrap();
@@ -53,8 +196,10 @@ fn second_insert_does_not_duplicate_columns() {
let path = dir.path().join("catalog.json");
let mut c = Catalog::load(&path).unwrap();
c.ensure_columns("users", &row(&[("id", json!(1))]));
c.ensure_columns("users", &row(&[("id", json!(2))]));
c.ensure_columns("users", &row(&[("id", json!(1))]))
.unwrap();
c.ensure_columns("users", &row(&[("id", json!(2))]))
.unwrap();
assert_eq!(c.describe("users").unwrap().columns.len(), 1);
}
@@ -65,9 +210,11 @@ fn remove_column_drops_definition_stats_and_index() {
let path = dir.path().join("catalog.json");
let mut c = Catalog::load(&path).unwrap();
c.ensure_columns("t", &row(&[("id", json!(1)), ("code", json!(5))]));
c.ensure_columns("t", &row(&[("id", json!(1)), ("code", json!(5))]))
.unwrap();
c.add_index("t", "code").unwrap();
c.rebuild_stats("t", &[row(&[("id", json!(1)), ("code", json!(5))])]);
c.rebuild_stats("t", &[row(&[("id", json!(1)), ("code", json!(5))])])
.unwrap();
let removed = c.remove_column("t", "code").unwrap();
assert!(removed, "first remove should hit the column");
@@ -75,7 +222,10 @@ fn remove_column_drops_definition_stats_and_index() {
assert_eq!(s.columns.len(), 1);
assert_eq!(s.columns[0].name, "id");
assert!(s.indexes.is_empty(), "index on code should be gone");
assert!(!s.stats.contains_key("code"), "stats for code should be gone");
assert!(
!s.stats.contains_key("code"),
"stats for code should be gone"
);
let again = c.remove_column("t", "code").unwrap();
assert!(!again);
@@ -93,7 +243,7 @@ fn stats_track_a_histogram_for_numeric_columns() {
let rows: Vec<Row> = (0..100)
.map(|n| row(&[("id", json!(n)), ("name", json!(format!("u{}", n)))]))
.collect();
c.rebuild_stats("t", &rows);
c.rebuild_stats("t", &rows).unwrap();
let s = c.describe("t").unwrap();
let id = s.stats.get("id").unwrap();
@@ -106,7 +256,8 @@ fn stats_track_a_histogram_for_numeric_columns() {
assert!(name.hist.is_empty(), "字符串列不进直方图");
assert_eq!(name.lo, None);
c.record_insert("t", &row(&[("id", json!(1000)), ("name", json!("x"))]));
c.record_insert("t", &row(&[("id", json!(1000)), ("name", json!("x"))]))
.unwrap();
let s = c.describe("t").unwrap();
let id = s.stats.get("id").unwrap();
assert_eq!(id.lo, Some(0.0));
@@ -129,7 +280,9 @@ fn stats_track_a_histogram_for_numeric_columns() {
fn duplicate_deletion_keeps_distinct_until_last_occurrence() {
let mut catalog = Catalog::default();
let duplicate = row(&[("id", json!(1)), ("v", json!(7))]);
catalog.rebuild_stats("t", &[duplicate.clone(), duplicate.clone()]);
catalog
.rebuild_stats("t", &[duplicate.clone(), duplicate.clone()])
.unwrap();
catalog.record_delete("t", std::slice::from_ref(&duplicate));
assert_eq!(catalog.describe("t").unwrap().stats["v"].distinct, 1);
catalog.record_delete("t", &[duplicate]);
@@ -140,8 +293,10 @@ fn duplicate_deletion_keeps_distinct_until_last_occurrence() {
#[test]
fn capped_distinct_keeps_histogram_and_other_columns_accurate() {
let mut catalog = Catalog::default();
let rows: Vec<Row> = (0..5000).map(|n| row(&[("id", json!(n)), ("v", json!(n % 2))])).collect();
catalog.rebuild_stats("t", &rows);
let rows: Vec<Row> = (0..5000)
.map(|n| row(&[("id", json!(n)), ("v", json!(n % 2))]))
.collect();
catalog.rebuild_stats("t", &rows).unwrap();
let schema = catalog.describe("t").unwrap();
assert!(schema.stats["id"].capped);
assert_eq!(schema.stats["id"].hist.iter().sum::<u64>(), 5000);
@@ -150,10 +305,34 @@ fn capped_distinct_keeps_histogram_and_other_columns_accurate() {
let schema = catalog.describe("t").unwrap();
assert_eq!(schema.stats["id"].hist.iter().sum::<u64>(), 4000);
assert_eq!(schema.stats["v"].distinct, 2);
catalog.rebuild_stats("t", &rows[1000..]);
catalog.rebuild_stats("t", &rows[1000..]).unwrap();
assert_eq!(catalog.describe("t").unwrap().stats["id"].distinct, 4000);
}
/// 重建直方图不受行顺序影响
#[test]
fn rebuilt_histogram_has_exact_buckets_in_any_order() {
let rows: Vec<Row> = (0..160).map(|n| row(&[("v", json!(n))])).collect();
let mut forward = Catalog::default();
forward.rebuild_stats("t", &rows).unwrap();
let mut reverse = Catalog::default();
let reversed: Vec<Row> = rows.iter().rev().cloned().collect();
reverse.rebuild_stats("t", &reversed).unwrap();
let stat = &forward.describe("t").unwrap().stats["v"];
assert_eq!(stat.hist, vec![10; 16]);
assert_eq!(stat.hist, reverse.describe("t").unwrap().stats["v"].hist);
forward
.record_insert("t", &row(&[("v", json!(10000))]))
.unwrap();
forward.record_delete("t", &[row(&[("v", json!(10000))])]);
forward.rebuild_stats("t", &rows[80..]).unwrap();
let repaired = &forward.describe("t").unwrap().stats["v"];
assert_eq!(repaired.lo, Some(80.0));
assert_eq!(repaired.hi, Some(159.0));
assert_eq!(repaired.hist, vec![5; 16]);
assert_eq!(forward.describe("t").unwrap().row_count, 80);
}
/// 老类型名并到新写法,参数保留,未知类型原样
#[test]
fn normalize_type_maps_legacy_names() {
@@ -182,8 +361,14 @@ fn legacy_catalog_loads_and_normalizes() {
let s = c.describe("legacy").unwrap();
assert_eq!(s.columns.len(), 2);
assert!(s.columns[0].nullable, "老列默认可空");
assert!(c.normalize_types());
let types: Vec<&str> = c.describe("legacy").unwrap().columns.iter().map(|col| col.ty.as_str()).collect();
assert!(c.normalize_types().unwrap());
let types: Vec<&str> = c
.describe("legacy")
.unwrap()
.columns
.iter()
.map(|col| col.ty.as_str())
.collect();
assert_eq!(types, vec!["int", "str"]);
assert!(!c.normalize_types(), "第二次没有可改的");
assert!(!c.normalize_types().unwrap(), "第二次没有可改的");
}
+25 -9
View File
@@ -36,8 +36,7 @@ fn defaults_without_file() {
fn file_overrides_only_written_keys() {
let _guard = env_guard();
let path = PathBuf::from("t.toml");
let loaded = config::resolve(Some("[page]\nsize = 8192\n"), Some(path.clone()))
.unwrap();
let loaded = config::resolve(Some("[page]\nsize = 8192\n"), Some(path.clone())).unwrap();
assert_eq!(loaded.config.page_size, 8192);
assert_eq!(loaded.config.btree_order, DEFAULT_BTREE_ORDER);
@@ -45,9 +44,17 @@ fn file_overrides_only_written_keys() {
assert_eq!(loaded.config.log_files, PathBuf::from(DEFAULT_LOG_FILES));
assert_eq!(loaded.config_path, Some(path.clone()));
let page = loaded.origins.iter().find(|(n, _, _)| *n == "page.size").unwrap();
let page = loaded
.origins
.iter()
.find(|(n, _, _)| *n == "page.size")
.unwrap();
assert_eq!(page.2, Origin::File(path));
let order = loaded.origins.iter().find(|(n, _, _)| *n == "btree.order").unwrap();
let order = loaded
.origins
.iter()
.find(|(n, _, _)| *n == "btree.order")
.unwrap();
assert_eq!(order.2, Origin::Default);
}
@@ -110,7 +117,11 @@ fn default_config_path_follows_system_convention() {
let path = config::default_config_path();
assert_eq!(path.file_name().unwrap(), "settings.toml");
assert_eq!(path.parent().unwrap().file_name().unwrap(), "ChuSQL");
assert!(path.ends_with(format!("ChuSQL{}settings.toml", std::path::MAIN_SEPARATOR)), "got {}", path.display());
assert!(
path.ends_with(format!("ChuSQL{}settings.toml", std::path::MAIN_SEPARATOR)),
"got {}",
path.display()
);
// 本机 APPDATA 存在时必须是 %APPDATA%\ChuSQL\settings.toml
#[cfg(windows)]
@@ -168,7 +179,11 @@ fn explicit_missing_path_is_an_error() {
"got {}",
err
);
assert!(err.contains("chusql-no-such-config-9f21.toml"), "got {}", err);
assert!(
err.contains("chusql-no-such-config-9f21.toml"),
"got {}",
err
);
}
/// 不给 --config 且无配置文件时用内置默认
@@ -187,13 +202,14 @@ fn load_without_explicit_path_uses_builtin_defaults() {
}
}
/// [server] 分区归别的层管;本层拼写错误要报错
/// 忽略其他层分区并拒绝存储配置拼写错误
#[test]
fn server_section_belongs_to_another_layer() {
let _guard = env_guard();
let db_server = "[server]\nlisten_host = \"0.0.0.0\"\nport = 7778\nmax_rows = 10\n";
let db_server = "[page]\nsize = 8192\n[storage]\ndata_dir = \"../data\"\n[server]\nlisten_host = \"0.0.0.0\"\nport = 7778\nmax_rows = 10\n[web]\nport = 7778\n";
let loaded = config::resolve(Some(db_server), None).unwrap();
assert_eq!(loaded.config.data_dir, config::default_data_dir());
assert_eq!(loaded.config.page_size, 8192);
assert_eq!(loaded.config.data_dir, PathBuf::from("../data"));
let typo = "[storage]\ndata_dirs = \"oops\"\n";
assert!(config::resolve(Some(typo), None).is_err());
+145
View File
@@ -0,0 +1,145 @@
use std::ffi::CString;
use std::ptr;
use std::slice;
use chusql_core_storage::ffi::*;
use chusql_core_storage::runtime::Storage;
// 验证 FFI 错误输出、长度边界与响应所有权。
/// 读取当前线程的 FFI 错误
fn last_error() -> String {
let mut len = 0;
// SAFETY: 长度可写,返回缓冲在复制前没有被修改。
unsafe {
let data = chusql_storage_last_error(&mut len);
assert!(!data.is_null());
String::from_utf8(slice::from_raw_parts(data, len).to_vec()).unwrap()
}
}
/// 维护失败清空输出并拒绝超长请求
#[test]
fn maintenance_rejects_invalid_arguments_and_resets_outputs() {
let input = b"{}";
let mut out = input.as_ptr() as *mut u8;
let mut len = 99;
// SAFETY: 输出均可写;无效输入应在任何读取之前被拒绝。
unsafe {
assert_eq!(
chusql_storage_maintenance(ptr::null(), ptr::null(), 0, &mut out, &mut len),
-1
);
assert!(out.is_null());
assert_eq!(len, 0);
len = 99;
assert_eq!(
chusql_storage_maintenance(
ptr::null(),
input.as_ptr(),
input.len(),
ptr::null_mut(),
&mut len
),
-1
);
assert_eq!(len, 0);
out = input.as_ptr() as *mut u8;
assert_eq!(
chusql_storage_maintenance(
ptr::null(),
input.as_ptr(),
input.len(),
&mut out,
ptr::null_mut()
),
-1
);
assert!(out.is_null());
assert_eq!(
chusql_storage_maintenance(ptr::null(), input.as_ptr(), usize::MAX, &mut out, &mut len),
-1
);
}
assert!(out.is_null());
assert_eq!(len, 0);
assert_eq!(last_error(), "invalid maintenance argument");
}
/// 请求验证长度和编码并归还响应
#[test]
fn request_validates_input_and_returns_owned_response() -> Result<(), Box<dyn std::error::Error>> {
let temp = tempfile::tempdir()?;
let config = temp.path().join("settings.toml");
std::fs::write(
&config,
format!(
"[storage]\ndata_dir = '{}'\nlog_files = '{}'\n[log]\nlevel = 'off'\n",
temp.path().join("data").display(),
temp.path().join("logs").display()
),
)?;
let storage = Storage::open(config.to_str())?;
let input = br#"{"method":"ping"}"#;
let mut out = ptr::null_mut();
let mut len = 0;
// SAFETY: 句柄和实际请求有效;超长长度必须在构造切片前被拒绝。
unsafe {
assert_eq!(
chusql_storage_request(&storage, input.as_ptr(), usize::MAX, &mut out, &mut len),
-1
);
assert!(out.is_null());
assert_eq!(len, 0);
assert_eq!(last_error(), "invalid argument");
assert_eq!(
chusql_storage_request(&storage, [0xff].as_ptr(), 1, &mut out, &mut len),
-1
);
assert!(last_error().starts_with("request is not valid UTF-8:"));
assert_eq!(
chusql_storage_request(&storage, input.as_ptr(), input.len(), &mut out, &mut len),
0
);
assert!(!out.is_null());
let response = slice::from_raw_parts(out, len).to_vec();
chusql_storage_free(out, len);
let response: serde_json::Value = serde_json::from_slice(&response)?;
assert_eq!(response["status"], "pong");
}
drop(storage);
let config = CString::new(config.to_str().unwrap())?;
// SAFETY: 路径与输出有效;失败不产生需要释放的缓冲。
unsafe {
assert_eq!(
chusql_storage_maintenance(config.as_ptr(), [0xff].as_ptr(), 1, &mut out, &mut len),
-1
);
}
assert!(out.is_null());
assert_eq!(len, 0);
assert!(!last_error().is_empty());
let maintenance = br#"{"mode":"reset","user":"root","password_hash":"hash","types":[{"name":"int","base_type":"int","parameterized":false}]}"#;
// SAFETY: 维护仅使用本测试临时目录;成功响应复制后由配套函数释放。
unsafe {
assert_eq!(
chusql_storage_maintenance(
config.as_ptr(),
maintenance.as_ptr(),
maintenance.len(),
&mut out,
&mut len
),
0,
"{}",
last_error()
);
assert!(!out.is_null());
let response = slice::from_raw_parts(out, len).to_vec();
chusql_storage_free(out, len);
let response: serde_json::Value = serde_json::from_slice(&response)?;
assert_eq!(response["status"], "maintenance");
assert_eq!(response["mode"], "reset");
}
Ok(())
}
+134 -36
View File
@@ -25,20 +25,61 @@ fn delete_propagates_index_read_errors() {
let original = row(&[("id", json!(1))]);
t.insert_row(&original).unwrap();
t.flush().unwrap();
let file = std::fs::OpenOptions::new().write(true).open(&index).unwrap();
let file = std::fs::OpenOptions::new()
.write(true)
.open(&index)
.unwrap();
file.set_len(DEFAULT_PAGE_SIZE as u64).unwrap();
let err = t.delete_by_keys(&[1]).unwrap_err();
assert_eq!(err.kind(), std::io::ErrorKind::UnexpectedEof);
assert_eq!(t.scan().unwrap(), vec![original]);
}
/// 索引键失败不得留下堆行或清空旧表
#[test]
fn invalid_index_keys_leave_heap_and_indexes_unchanged() {
let dir = tempfile::tempdir().unwrap();
let mut table = HeapTable::open(dir.path().join("t.db"), DEFAULT_PAGE_SIZE, 1).unwrap();
let original = row(&[("id", json!(1)), ("name", json!("old"))]);
table.insert_row(&original).unwrap();
table
.build_index(
"name",
&dir.path().join("t.name.idx"),
DEFAULT_PAGE_SIZE,
4,
1,
)
.unwrap();
let invalid = row(&[("id", json!(2)), ("name", json!("x".repeat(129)))]);
assert!(table.insert_row(&invalid).is_err());
assert_eq!(table.scan().unwrap(), vec![original.clone()]);
assert!(table.replace_all(&[invalid]).is_err());
assert_eq!(table.scan().unwrap(), vec![original.clone()]);
assert_eq!(
table.get_by_string_key("name", "old").unwrap(),
Some(original)
);
assert!(
table
.replace_all(&[row(&[("name", json!("x".repeat(10_000)))])])
.is_err()
);
assert_eq!(table.scan().unwrap().len(), 1);
}
/// 跨页投影与分片保持行序及隐藏列
#[test]
fn projected_shards_preserve_order_and_hidden_columns() {
let dir = tempfile::tempdir().unwrap();
let mut t = HeapTable::open(dir.path().join("t.db"), 256, 1).unwrap();
for i in 0..40 {
t.insert_row(&row(&[("id", json!(i)), ("name", json!("alice")), ("secret", json!(i))])).unwrap();
t.insert_row(&row(&[
("id", json!(i)),
("name", json!("alice")),
("secret", json!(i)),
]))
.unwrap();
}
t.set_hidden_columns(["secret".to_string()].into_iter().collect());
let columns = vec!["id".to_string(), "secret".to_string()];
@@ -47,9 +88,15 @@ fn projected_shards_preserve_order_and_hidden_columns() {
let pages = t.num_pages().unwrap();
assert!(pages > 1);
let mut shards = t.scan_columns_pages(Some(&columns), 0, pages / 2).unwrap();
shards.extend(t.scan_columns_pages(Some(&columns), pages / 2, pages + 1).unwrap());
shards.extend(
t.scan_columns_pages(Some(&columns), pages / 2, pages + 1)
.unwrap(),
);
assert_eq!(shards, expected);
assert_eq!(t.read_at(0, 0).unwrap().unwrap(), row(&[("id", json!(0)), ("name", json!("alice"))]));
assert_eq!(
t.read_at(0, 0).unwrap().unwrap(),
row(&[("id", json!(0)), ("name", json!("alice"))])
);
}
/// 扫描与点读均返回行解码错误
@@ -78,15 +125,20 @@ fn empty_index_file_is_rebuilt_from_rows() {
let data = dir.path().join("t.db");
let index = dir.path().join("t.idx");
{
let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE)
.unwrap();
for i in 1..=5 {
t.insert_row(&row(&[("id", json!(i))])).unwrap();
}
t.flush().unwrap();
}
std::fs::write(&index, b"").unwrap();
let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
assert!(t.get_by_column_key("id", 3).unwrap().is_some(), "空索引文件要从堆数据重建");
let mut t =
HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
assert!(
t.get_by_column_key("id", 3).unwrap().is_some(),
"空索引文件要从堆数据重建"
);
assert!(t.get_by_column_key("id", 9).unwrap().is_none());
}
@@ -97,14 +149,24 @@ fn string_index_looks_up_by_value() {
let data = dir.path().join("s.db");
let index = dir.path().join("s.idx");
let mut t = HeapTable::open(&data, DEFAULT_PAGE_SIZE, DEFAULT_POOL_SIZE).unwrap();
t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))])).unwrap();
t.insert_row(&row(&[("id", json!(2)), ("name", json!("bob"))])).unwrap();
t.insert_row(&row(&[("id", json!(3)), ("name", json!(null))])).unwrap();
t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))]))
.unwrap();
t.insert_row(&row(&[("id", json!(2)), ("name", json!("bob"))]))
.unwrap();
t.insert_row(&row(&[("id", json!(3)), ("name", json!(null))]))
.unwrap();
t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE)
.unwrap();
assert_eq!(t.get_by_string_key("name", "bob").unwrap().unwrap()["id"], json!(2));
assert_eq!(
t.get_by_string_key("name", "bob").unwrap().unwrap()["id"],
json!(2)
);
assert!(t.get_by_string_key("name", "dave").unwrap().is_none());
assert!(t.get_by_string_key("name", "").unwrap().is_none(), "NULL 不入索引");
assert!(
t.get_by_string_key("name", "").unwrap().is_none(),
"NULL 不入索引"
);
}
/// 允许重复值建索引:点查把重复的行都取回来
@@ -114,9 +176,12 @@ fn duplicate_values_are_indexed_and_all_returned() {
let data = dir.path().join("d.db");
let index = dir.path().join("d.idx");
let mut t = HeapTable::open(&data, DEFAULT_PAGE_SIZE, DEFAULT_POOL_SIZE).unwrap();
t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))])).unwrap();
t.insert_row(&row(&[("id", json!(2)), ("name", json!("alice"))])).unwrap();
t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
t.insert_row(&row(&[("id", json!(1)), ("name", json!("alice"))]))
.unwrap();
t.insert_row(&row(&[("id", json!(2)), ("name", json!("alice"))]))
.unwrap();
t.build_index("name", &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE)
.unwrap();
let mut ids: Vec<i64> = t
.get_all_by_string_key("name", "alice")
@@ -218,9 +283,15 @@ fn replace_all_rebuilds_index() {
])
.unwrap();
assert!(t.get_by_key(1).unwrap().is_none(), "old key must be invalidated");
assert!(
t.get_by_key(1).unwrap().is_none(),
"old key must be invalidated"
);
assert!(t.get_by_key(2).unwrap().is_none());
let got = t.get_by_key(7).unwrap().expect("new row should be indexed by id");
let got = t
.get_by_key(7)
.unwrap()
.expect("new row should be indexed by id");
assert_eq!(got["name"], json!("Zoe"));
assert_eq!(t.scan().unwrap().len(), 2);
}
@@ -239,7 +310,10 @@ fn delete_by_keys_removes_rows() {
.unwrap();
for i in 1..=5 {
t.insert_row(&row(&[("id", json!(i)), ("name", json!(format!("u{}", i)))]))
t.insert_row(&row(&[
("id", json!(i)),
("name", json!(format!("u{}", i))),
]))
.unwrap();
}
@@ -254,7 +328,10 @@ fn delete_by_keys_removes_rows() {
.collect();
assert_eq!(ids, vec![1, 3, 5], "remaining rows must keep their order");
assert!(t.get_by_key(2).unwrap().is_none(), "index entry should be deleted too");
assert!(
t.get_by_key(2).unwrap().is_none(),
"index entry should be deleted too"
);
assert!(t.get_by_key(4).unwrap().is_none());
assert!(t.get_by_key(3).unwrap().is_some());
@@ -284,10 +361,7 @@ fn insert_rows_batch() {
assert_eq!(t.scan().unwrap().len(), 20);
assert_eq!(t.get_by_key(20).unwrap().unwrap()["name"], json!("u20"));
let dup = vec![
row(&[("id", json!(100))]),
row(&[("id", json!(100))]),
];
let dup = vec![row(&[("id", json!(100))]), row(&[("id", json!(100))])];
assert!(t.insert_rows(&dup).is_err());
}
@@ -320,16 +394,23 @@ fn secondary_index_is_maintained() {
)
.unwrap();
assert!(t.has_index("code"));
assert_eq!(t.get_by_column_key("code", 7002).unwrap().unwrap()["id"], json!(2));
assert_eq!(
t.get_by_column_key("code", 7002).unwrap().unwrap()["id"],
json!(2)
);
t.insert_row(&row(&[("id", json!(3)), ("code", json!(7003))]))
.unwrap();
assert_eq!(t.get_by_column_key("code", 7003).unwrap().unwrap()["id"], json!(3));
assert_eq!(
t.get_by_column_key("code", 7003).unwrap().unwrap()["id"],
json!(3)
);
t.delete_by_keys(&[2]).unwrap();
assert!(t.get_by_column_key("code", 7002).unwrap().is_none());
t.insert_row(&row(&[("id", json!(4)), ("code", json!(7001))])).unwrap();
t.insert_row(&row(&[("id", json!(4)), ("code", json!(7001))]))
.unwrap();
let mut dup_ids: Vec<i64> = t
.get_all_by_column_key("code", 7001)
.unwrap()
@@ -339,7 +420,12 @@ fn secondary_index_is_maintained() {
dup_ids.sort_unstable();
assert_eq!(dup_ids, vec![1, 4], "duplicate index values keep both rows");
let mut t2 = HeapTable::open(dir.path().join("d.db"), DEFAULT_PAGE_SIZE, DEFAULT_POOL_SIZE).unwrap();
let mut t2 = HeapTable::open(
dir.path().join("d.db"),
DEFAULT_PAGE_SIZE,
DEFAULT_POOL_SIZE,
)
.unwrap();
t2.insert_rows(&[
row(&[("id", json!(1)), ("age", json!(30))]),
row(&[("id", json!(2)), ("age", json!(30))]),
@@ -360,7 +446,6 @@ fn secondary_index_is_maintained() {
);
}
/// 整表整理要收回删行留下的页内空洞
#[test]
fn compact_pages_reclaims_dead_space() {
@@ -370,7 +455,8 @@ fn compact_pages_reclaims_dead_space() {
let pad = "x".repeat(200);
for i in 0..10 {
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
.unwrap();
}
let pages = t.num_pages().unwrap();
@@ -395,7 +481,8 @@ fn deletes_compact_pages_so_space_is_reused() {
let pad = "y".repeat(80);
for i in 0..30 {
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
.unwrap();
}
assert_eq!(t.num_pages().unwrap(), 1, "30 行要先塞进一页");
@@ -404,7 +491,8 @@ fn deletes_compact_pages_so_space_is_reused() {
t.delete_by_keys(&keys).unwrap();
for i in 100..119 {
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
.unwrap();
}
assert_eq!(t.num_pages().unwrap(), 1, "删掉的空间要能被复用");
assert_eq!(t.scan().unwrap().len(), 30);
@@ -416,11 +504,13 @@ fn compact_pages_keeps_index_positions_valid() {
let dir = tempfile::tempdir().unwrap();
let data = dir.path().join("t.db");
let index = dir.path().join("t.idx");
let mut t = HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
let mut t =
HeapTable::open_indexed(&data, &index, DEFAULT_PAGE_SIZE, 4, DEFAULT_POOL_SIZE).unwrap();
let pad = "z".repeat(80);
for i in 0..30 {
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))])).unwrap();
t.insert_row(&row(&[("id", json!(i)), ("pad", json!(pad))]))
.unwrap();
}
let keys: Vec<i64> = (5..25).collect();
t.delete_by_keys(&keys).unwrap();
@@ -428,9 +518,17 @@ fn compact_pages_keeps_index_positions_valid() {
for i in [0, 1, 2, 3, 4, 25, 26, 27, 28, 29] {
let found = t.get_by_column_key("id", i).unwrap();
assert_eq!(found.as_ref().map(|r| r["pad"].clone()), Some(json!(pad)), "整理后 id={} 仍要能点查", i);
assert_eq!(
found.as_ref().map(|r| r["pad"].clone()),
Some(json!(pad)),
"整理后 id={} 仍要能点查",
i
);
}
for i in 5..25 {
assert!(t.get_by_column_key("id", i).unwrap().is_none(), "删掉的行不该再查出来");
assert!(
t.get_by_column_key("id", i).unwrap().is_none(),
"删掉的行不该再查出来"
);
}
}
+144
View File
@@ -142,3 +142,147 @@ fn dirty_page_flushed_on_drop() {
let p = pf2.read_page(0).unwrap();
assert_eq!(p.data[0], 42);
}
/// 已同步镜像恢复撕裂页且页 LSN 持久保留
#[test]
fn full_page_image_repairs_torn_write_before_read() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("torn.db");
let metadata = dir.path().join("torn.db.pages");
let journal = dir.path().join("torn.db.page-wal");
let mut file = PageFile::with_options(&path, 512, 1).unwrap();
file.set_lsn(7);
file.write_page(&Page::new(0, 512)).unwrap();
file.flush().unwrap();
let old_metadata = std::fs::read(&metadata).unwrap();
file.set_lsn(13);
let mut changed = Page::new(0, 512);
changed.data.fill(0x5a);
file.write_page(&changed).unwrap();
file.append_page().unwrap(); // 淘汰页零前镜像已同步
let image = std::fs::read(&journal).unwrap();
assert!(!image.is_empty());
drop(file);
std::fs::write(&metadata, old_metadata).unwrap();
std::fs::write(&journal, &image).unwrap();
std::fs::write(&path, [0x11; 213]).unwrap();
let mut reopened = PageFile::open(&path, 512).unwrap();
assert_eq!(reopened.read_page(0).unwrap().data, changed.data);
assert_eq!(reopened.page_lsn(0), Some(13));
drop(reopened);
assert_eq!(std::fs::metadata(&journal).unwrap().len(), 0);
let mut reopened = PageFile::open(&path, 512).unwrap();
assert_eq!(reopened.read_page(0).unwrap().data, changed.data);
assert_eq!(reopened.page_lsn(0), Some(13));
}
/// 撕裂日志尾不发布,完整损坏帧明确拒绝
#[test]
fn page_image_tail_and_corruption_are_distinguished() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("tail.db");
let metadata = dir.path().join("tail.db.pages");
let journal = dir.path().join("tail.db.page-wal");
let mut file = PageFile::with_options(&path, 512, 1).unwrap();
file.write_page(&Page::new(0, 512)).unwrap();
file.flush().unwrap();
let old_metadata = std::fs::read(&metadata).unwrap();
let old_data = std::fs::read(&path).unwrap();
file.set_lsn(20);
let mut changed = Page::new(0, 512);
changed.data.fill(9);
file.write_page(&changed).unwrap();
file.append_page().unwrap();
let image = std::fs::read(&journal).unwrap();
drop(file);
for end in [1, 39, image.len() - 1] {
std::fs::write(&metadata, &old_metadata).unwrap();
std::fs::write(&path, &old_data).unwrap();
std::fs::write(&journal, &image[..end]).unwrap();
let mut reopened = PageFile::open(&path, 512).unwrap();
assert_eq!(reopened.read_page(0).unwrap().data, vec![0; 512]);
}
let mut corrupt = image;
corrupt[40] ^= 1;
std::fs::write(&metadata, &old_metadata).unwrap();
std::fs::write(&journal, &corrupt).unwrap();
assert!(
PageFile::open(&path, 512)
.unwrap_err()
.to_string()
.contains("checksum")
);
assert_eq!(std::fs::read(&journal).unwrap(), corrupt);
}
/// 截断标记阻止旧页重放后复活
#[test]
fn truncate_clears_page_versions_and_survives_reopen() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("reset.db");
let mut file = PageFile::open(&path, 512).unwrap();
file.set_lsn(5);
for _ in 0..3 {
file.append_page().unwrap();
}
file.flush().unwrap();
file.set_lsn(8);
file.truncate().unwrap();
file.append_page().unwrap();
file.flush().unwrap();
assert_eq!(file.page_lsn(0), Some(8));
assert_eq!(file.page_lsn(2), None);
drop(file);
let mut file = PageFile::open(&path, 512).unwrap();
assert_eq!(file.num_pages().unwrap(), 1);
assert_eq!(file.page_lsn(0), Some(8));
assert_eq!(file.page_lsn(2), None);
}
/// 镜像写入失败后禁止析构或重试绕过恢复
#[test]
fn page_journal_error_fences_further_flushes() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("fenced.db");
let journal = dir.path().join("fenced.db.page-wal");
std::fs::write(&path, [0; 512]).unwrap();
let mut file = PageFile::open(&path, 512).unwrap();
let mut page = Page::new(0, 512);
page.data.fill(7);
file.write_page(&page).unwrap();
std::fs::create_dir(&journal).unwrap();
assert!(file.flush().is_err());
std::fs::remove_dir(&journal).unwrap();
assert!(
file.flush()
.unwrap_err()
.to_string()
.contains("requires recovery")
);
drop(file);
let mut file = PageFile::open(&path, 512).unwrap();
assert_eq!(file.read_page(0).unwrap().data, vec![0; 512]);
}
/// 小缓存淘汰不会反复记录同一批未改页
#[test]
fn eviction_batches_images_without_pool_sized_write_amplification() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("bounded.db");
let journal = dir.path().join("bounded.db.page-wal");
let mut file = PageFile::with_options(&path, 512, 2).unwrap();
file.set_lsn(9);
for id in 0..100 {
let mut page = Page::new(id, 512);
page.data.fill(id as u8);
file.write_page(&page).unwrap();
}
assert!(std::fs::metadata(&journal).unwrap().len() <= 100 * (512 + 40));
file.flush().unwrap();
drop(file);
let mut file = PageFile::open(&path, 512).unwrap();
for id in 0..100 {
assert_eq!(file.read_page(id).unwrap().data, vec![id as u8; 512]);
assert_eq!(file.page_lsn(id), Some(9));
}
}
File diff suppressed because it is too large. Load diff
+108 -6
View File
@@ -1,9 +1,93 @@
use chusql_core_storage::protocol::Row;
use chusql_core_storage::wal::{committed_ops, records_after, Wal, WalOp};
use chusql_core_storage::wal::{Wal, WalOp, committed_ops, records_after};
use serde_json::json;
// WAL 测试:追加、读取、清空、截断尾巴、LSN 与提交标记。
/// 结构版本往返且旧隐藏列载荷可读
#[test]
fn schema_versions_round_trip_and_legacy_hide_decodes() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("wal.log");
let wal = Wal::new(&path);
let ops = [
WalOp::HideColumn {
table: "t".into(),
column: "name".into(),
schema_version: Some(u64::MAX),
},
WalOp::DropColumn {
table: "t".into(),
column: "name".into(),
rows: vec![],
schema_version: Some(3),
},
WalOp::ReplaceSchema {
table: "t".into(),
columns: vec![],
rows: vec![],
schema_version: Some(4),
},
];
wal.append_group(&ops).unwrap();
assert_eq!(
committed_ops(&wal.read_all().unwrap().records)
.into_iter()
.map(|(_, op)| op)
.collect::<Vec<_>>(),
ops
);
drop(wal);
let mut body = 1_u64.to_le_bytes().to_vec();
body.push(8);
body.extend_from_slice(&1_u16.to_le_bytes());
body.extend_from_slice(b"t");
body.extend_from_slice(br#""name""#);
let mut frame = (body.len() as u32).to_le_bytes().to_vec();
frame.extend_from_slice(&body);
std::fs::write(&path, frame).unwrap();
assert_eq!(
Wal::new(&path).read().unwrap(),
Some(WalOp::HideColumn {
table: "t".into(),
column: "name".into(),
schema_version: None,
})
);
}
/// 建表编号完整往返且兼容旧载荷
#[test]
fn create_table_ids_round_trip_and_legacy_payloads_decode() {
let dir = tempfile::tempdir().unwrap();
let path = dir.path().join("wal.log");
let wal = Wal::new(&path);
let op = WalOp::CreateTable {
table: "t".into(),
columns: vec![],
object_id: Some(42),
};
wal.append(&op).unwrap();
assert_eq!(wal.read_all().unwrap().records[0].1, op);
drop(wal);
let mut body = 1_u64.to_le_bytes().to_vec();
body.push(11);
body.extend_from_slice(&1_u16.to_le_bytes());
body.extend_from_slice(b"t");
body.extend_from_slice(br#"{"columns":[]}"#);
let mut frame = (body.len() as u32).to_le_bytes().to_vec();
frame.extend_from_slice(&body);
std::fs::write(&path, frame).unwrap();
let wal = Wal::new(&path);
assert_eq!(
wal.read_all().unwrap().records[0].1,
WalOp::CreateTable {
table: "t".into(),
columns: vec![],
object_id: None
}
);
}
/// 用键值对构造一行
fn row(pairs: &[(&str, serde_json::Value)]) -> Row {
@@ -35,6 +119,7 @@ fn append_and_read_round_trips() {
WalOp::DropColumn {
table: "users".into(),
column: "age".into(),
schema_version: None,
rows: vec![
row(&[("id", json!(1)), ("name", json!("Alice"))]),
row(&[("id", json!(2)), ("name", json!("Bob"))]),
@@ -116,7 +201,10 @@ fn every_record_gets_an_increasing_lsn() {
let scan = wal.read_all().unwrap();
let lsns: Vec<u64> = scan.records.iter().map(|(lsn, _)| *lsn).collect();
assert_eq!(lsns, vec![1, 2, 3]);
assert_eq!(scan.good_len as u64, std::fs::metadata(&path).unwrap().len());
assert_eq!(
scan.good_len as u64,
std::fs::metadata(&path).unwrap().len()
);
let reopened = Wal::new(&path);
reopened
@@ -203,7 +291,10 @@ fn trailing_torn_frame_can_be_truncated() {
assert!(scan.good_len < full.len() - 3);
wal.truncate_to(scan.good_len).unwrap();
assert_eq!(std::fs::metadata(&path).unwrap().len(), scan.good_len as u64);
assert_eq!(
std::fs::metadata(&path).unwrap().len(),
scan.good_len as u64
);
assert_eq!(wal.read_all().unwrap().records.len(), 1);
}
@@ -309,9 +400,21 @@ fn lsn_continues_from_the_checkpoint() {
#[test]
fn records_after_keeps_only_the_tail() {
let records = vec![
(1u64, WalOp::Insert { table: "t".into(), row: row(&[("id", json!(1))]) }),
(
1u64,
WalOp::Insert {
table: "t".into(),
row: row(&[("id", json!(1))]),
},
),
(2, WalOp::Commit),
(3, WalOp::Insert { table: "t".into(), row: row(&[("id", json!(2))]) }),
(
3,
WalOp::Insert {
table: "t".into(),
row: row(&[("id", json!(2))]),
},
),
(4, WalOp::Commit),
];
let kept = records_after(&records, 2);
@@ -320,4 +423,3 @@ fn records_after_keeps_only_the_tail() {
assert_eq!(records_after(&records, 4).len(), 0);
assert_eq!(records_after(&records, 0).len(), 4);
}
+179
View File
@@ -0,0 +1,179 @@
#ifdef _WIN32
#define _WIN32_WINNT 0x0600
#include <windows.h>
#include <sddl.h>
#include <stdio.h>
#else
#include <unistd.h>
#include <fcntl.h>
#include <sys/stat.h>
#include <errno.h>
#include <stdio.h>
#endif
#include <string.h>
/* 创建、读取和清理仅本机提升身份可访问的认证凭据。 */
#ifdef _WIN32
/* 检查当前提升令牌的管理员成员资格。 */
int chusql_sudo_privileged(void) {
SID_IDENTIFIER_AUTHORITY authority = SECURITY_NT_AUTHORITY;
PSID administrators = NULL;
BOOL member = FALSE;
if (!AllocateAndInitializeSid(&authority, 2, SECURITY_BUILTIN_DOMAIN_RID,
DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &administrators)) return 0;
if (!CheckTokenMembership(NULL, administrators, &member)) member = FALSE;
FreeSid(administrators);
return member != FALSE;
}
/* 生成系统保护目录中的端口专属路径。 */
static int credential_path(int port, wchar_t *directory, wchar_t *file) {
wchar_t base[MAX_PATH];
UINT length = GetSystemDirectoryW(base, MAX_PATH);
if (!length || length >= MAX_PATH - 80 || port < 1 || port > 65535) return ERROR_INVALID_PARAMETER;
swprintf(directory, MAX_PATH, L"%ls\\config\\ChuSQL-Sudo-%d", base, port);
swprintf(file, MAX_PATH, L"%ls\\credential", directory);
return 0;
}
/* 排除重解析目录与凭据文件。 */
static int plain_path(const wchar_t *path, int directory) {
DWORD attributes = GetFileAttributesW(path);
return attributes != INVALID_FILE_ATTRIBUTES && !(attributes & FILE_ATTRIBUTE_REPARSE_POINT)
&& (!!(attributes & FILE_ATTRIBUTE_DIRECTORY) == directory);
}
/* 用管理员与系统专属访问列表创建凭据。 */
int chusql_sudo_create(int port, const char *secret) {
wchar_t directory[MAX_PATH], file[MAX_PATH];
PSECURITY_DESCRIPTOR descriptor = NULL;
SECURITY_ATTRIBUTES attributes = {sizeof(SECURITY_ATTRIBUTES), NULL, FALSE};
DWORD written = 0, error;
HANDLE handle;
if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
error = credential_path(port, directory, file);
if (error) return (int)error;
if (!ConvertStringSecurityDescriptorToSecurityDescriptorW(
L"D:P(A;OICI;FA;;;BA)(A;OICI;FA;;;SY)", SDDL_REVISION_1, &descriptor, NULL)) return (int)GetLastError();
attributes.lpSecurityDescriptor = descriptor;
if (!CreateDirectoryW(directory, &attributes)) {
error = GetLastError(); LocalFree(descriptor); return (int)error;
}
handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_READ, &attributes, CREATE_NEW,
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
LocalFree(descriptor);
if (handle == INVALID_HANDLE_VALUE) {
error = GetLastError(); RemoveDirectoryW(directory); return (int)error;
}
error = 0;
if (!WriteFile(handle, secret, 64, &written, NULL) || written != 64 || !FlushFileBuffers(handle))
error = GetLastError() ? GetLastError() : ERROR_WRITE_FAULT;
if (!CloseHandle(handle) && !error) error = GetLastError();
if (error) { DeleteFileW(file); RemoveDirectoryW(directory); }
return (int)error;
}
/* 从系统保护目录读取本机凭据。 */
int chusql_sudo_read(int port, char *secret) {
wchar_t directory[MAX_PATH], file[MAX_PATH];
DWORD received = 0, error;
LARGE_INTEGER size;
HANDLE handle;
if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
error = credential_path(port, directory, file);
if (error) return (int)error;
if (!plain_path(directory, 1) || !plain_path(file, 0)) return ERROR_ACCESS_DENIED;
handle = CreateFileW(file, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
if (handle == INVALID_HANDLE_VALUE) return (int)GetLastError();
error = 0;
if (!GetFileSizeEx(handle, &size) || size.QuadPart != 64
|| !ReadFile(handle, secret, 64, &received, NULL) || received != 64) error = ERROR_INVALID_DATA;
if (!CloseHandle(handle) && !error) error = GetLastError();
return (int)error;
}
/* 删除本次服务启动创建的凭据目录。 */
int chusql_sudo_remove(int port) {
wchar_t directory[MAX_PATH], file[MAX_PATH];
int error = credential_path(port, directory, file);
if (error) return error;
if (!chusql_sudo_privileged()) return ERROR_ACCESS_DENIED;
if (!DeleteFileW(file)) return (int)GetLastError();
return RemoveDirectoryW(directory) ? 0 : (int)GetLastError();
}
#else
/* 检查当前进程的有效 root 身份。 */
int chusql_sudo_privileged(void) { return geteuid() == 0; }
/* 打开 root 专属目录并验证所有权与权限。 */
static int credential_directory(int port) {
char path[96];
struct stat status;
int fd;
if (port < 1 || port > 65535) { errno = EINVAL; return -1; }
snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
fd = open(path, O_RDONLY | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
if (fd < 0) return -1;
if (fstat(fd, &status) || status.st_uid != 0 || (status.st_mode & 0777) != 0700) {
close(fd); errno = EACCES; return -1;
}
return fd;
}
/* 在 root 专属目录中独占创建凭据。 */
int chusql_sudo_create(int port, const char *secret) {
char path[96];
int dir, fd, error = 0;
if (!chusql_sudo_privileged()) return EACCES;
if (port < 1 || port > 65535) return EINVAL;
snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
if (mkdir(path, 0700)) return errno;
dir = credential_directory(port);
if (dir < 0) { error = errno; rmdir(path); return error; }
fd = openat(dir, "credential", O_WRONLY | O_CREAT | O_EXCL | O_NOFOLLOW | O_CLOEXEC, 0600);
if (fd < 0) error = errno;
else {
if (write(fd, secret, 64) != 64 || fsync(fd)) error = errno ? errno : EIO;
if (close(fd) && !error) error = errno;
}
if (error) unlinkat(dir, "credential", 0);
if (close(dir) && !error) error = errno;
if (error) rmdir(path);
return error;
}
/* 验证 root 文件所有权后读取凭据。 */
int chusql_sudo_read(int port, char *secret) {
struct stat status;
int dir, fd, error = 0;
if (!chusql_sudo_privileged()) return EACCES;
dir = credential_directory(port);
if (dir < 0) return errno;
fd = openat(dir, "credential", O_RDONLY | O_NOFOLLOW | O_CLOEXEC);
if (fd < 0) error = errno;
else {
if (fstat(fd, &status) || !S_ISREG(status.st_mode) || status.st_uid != 0
|| (status.st_mode & 0777) != 0600 || status.st_size != 64 || status.st_nlink != 1) error = EACCES;
else if (read(fd, secret, 64) != 64) error = errno ? errno : EIO;
if (close(fd) && !error) error = errno;
}
if (close(dir) && !error) error = errno;
return error;
}
/* 删除本次服务启动创建的凭据目录。 */
int chusql_sudo_remove(int port) {
char path[96];
int dir, error = 0;
if (!chusql_sudo_privileged()) return EACCES;
dir = credential_directory(port);
if (dir < 0) return errno;
if (unlinkat(dir, "credential", 0)) error = errno;
if (close(dir) && !error) error = errno;
snprintf(path, sizeof(path), "/var/run/chusql-sudo-%d", port);
if (!error && rmdir(path)) error = errno;
return error;
}
#endif
+5
View File
@@ -16,11 +16,13 @@ library
ChuSQL.Interface.Actions
ChuSQL.Interface.Auth
ChuSQL.Interface.Config
ChuSQL.Interface.Normalization
ChuSQL.Interface.Link
ChuSQL.Interface.Policy
ChuSQL.Interface.Protocol
ChuSQL.Interface.RateLimit
ChuSQL.Interface.Session
ChuSQL.Interface.Sudo
ChuSQL.Interface.Settings
ChuSQL.Interface.TOML
build-depends: base >= 4.14 && < 5
@@ -36,5 +38,8 @@ library
, scientific
, text
, time
c-sources: cbits/sudo_credential.c
if os(windows)
extra-libraries: advapi32
default-language: Haskell2010
ghc-options: -Wall
@@ -43,4 +43,4 @@ accountColumnSpec name ty nullable autoIncrement primary unique =
-- | 账号表的结构(排序校验用)
systemTableInfo :: TableInfo
systemTableInfo = TableInfo accountTableName accountColumns 0 [] [] []
systemTableInfo = TableInfo accountTableName accountColumns 0 [] [] [] Nothing Nothing
@@ -34,7 +34,11 @@ module ChuSQL.Interface.Actions (
import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
import qualified ChuSQL.Core.Model as M
import ChuSQL.Core.Protocol (valueFromJSON)
import ChuSQL.Core.Runtime
import Control.Monad (zipWithM)
import qualified Data.Aeson as A
import Data.Aeson.Types (parseEither)
import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
import Data.List (intercalate)
import Data.Scientific (floatingOrInteger)
@@ -67,7 +71,7 @@ isIdentifier t =
(c : cs) -> (isAsciiLower c || isAsciiUpper c || c == '_') && all restChar cs
[] -> False
where
-- | 标识符里其余字符的合法集
-- \| 标识符里其余字符的合法集
restChar c = isAsciiLower c || isAsciiUpper c || isDigit c || c == '_'
-- | 检查一个标识符,不合法就报错(带上"是表名还是列名")
@@ -88,24 +92,50 @@ columnTypeOf = fmap plainColumn . parseColumnType . T.unpack . T.strip
-- | 本地类型转线上名字
columnTypeName :: Column -> Text
columnTypeName = T.pack . typeName . columnType
columnTypeName column = T.pack $ case columnType column of
CRuntime tid -> renderTypeExpr (typeExpression tid)
ty -> typeName ty
-- | 字符串字面量转义:单引号翻倍(引擎的词法器就是这么折回去的)
escapeStringLiteral :: String -> String
escapeStringLiteral = concatMap (\c -> if c == '\'' then "''" else [c])
-- | 值转 SQL 字面量
sqlLiteral :: Value -> String
sqlLiteral VNull = "NULL"
sqlLiteral (VInt n) = show n
sqlLiteral (VFloat d) = show d
sqlLiteral (VStr s) = "'" ++ escapeStringLiteral s ++ "'"
sqlLiteral (VBool True) = "TRUE"
sqlLiteral (VBool False) = "FALSE"
sqlLiteral :: Value -> Either String String
sqlLiteral VNull = Right "NULL"
sqlLiteral (VInt n) = Right (show n)
sqlLiteral (VFloat d)
| isNaN d || isInfinite d = Left "SQL floating literal must be finite"
| otherwise = Right (show d)
sqlLiteral (VStr s) = Right ("'" ++ escapeStringLiteral s ++ "'")
sqlLiteral (VBool True) = Right "TRUE"
sqlLiteral (VBool False) = Right "FALSE"
sqlLiteral (VRuntime tid value) = do
validateValue builtinTypes tid value
runtimeLiteral (typeExpression tid) value
-- | 渲染类型化构造器的 SQL 字面量
runtimeLiteral :: TypeExpr -> RuntimeValue -> Either String String
runtimeLiteral _ (RInt n) = Right (show n)
runtimeLiteral _ (RDouble n) = Right (show n)
runtimeLiteral _ (RBool b) = Right (if b then "TRUE" else "FALSE")
runtimeLiteral _ (RString text) = Right ("'" ++ escapeStringLiteral text ++ "'")
runtimeLiteral (TypeApply (TypeConstructorId 5) [child]) (RList values) = do
items <- mapM (runtimeLiteral child) values
Right ("LIST<" ++ renderTypeExpr child ++ ">(" ++ intercalate ", " items ++ ")")
runtimeLiteral (TypeApply (TypeConstructorId 6) [child]) (RMaybe value) = do
item <- maybe (Right "") (runtimeLiteral child) value
Right ("MAYBE<" ++ renderTypeExpr child ++ ">(" ++ item ++ ")")
runtimeLiteral (TypeApply (TypeConstructorId 7) fields) (RTuple values)
| length fields == length values = do
items <- zipWithM runtimeLiteral fields values
Right ("TUPLE<" ++ intercalate ", " (map renderTypeExpr fields) ++ ">(" ++ intercalate ", " items ++ ")")
runtimeLiteral _ _ = Left "runtime value does not match its type expression"
-- | JSON 值按列类型转成引擎的值;类型对不上就报错
coerceValue :: Column -> A.Value -> Either String Value
coerceValue col v = case v of
A.Object _ -> parseEither valueFromJSON v >>= M.coerceValue t
A.Null -> Right VNull
A.Bool b -> M.coerceValue t (VBool b)
A.Number n -> case floatingOrInteger n :: Either Double Integer of
@@ -147,7 +177,7 @@ createTableSql spec = do
defs <- mapM columnDef cols
pure ("CREATE TABLE " ++ T.unpack tbl ++ " (" ++ intercalate ", " defs ++ ")")
where
-- | 列类型不认时报错
-- \| 列类型不认时报错
columnDef (ColumnSpec name ty) = do
col <- checkIdent "column" name
ctype <- maybe (Left ("unknown column type: " ++ T.unpack ty)) Right (columnTypeOf ty)
@@ -186,13 +216,14 @@ insertRowSql table row = do
tbl <- checkIdent "table" table
cols <- requireNonEmpty "values" row
names <- mapM (checkIdent "column" . T.pack . fst) cols
literals <- mapM (sqlLiteral . snd) cols
pure
( "INSERT INTO "
++ T.unpack tbl
++ " ("
++ intercalate ", " (map T.unpack names)
++ ") VALUES ("
++ intercalate ", " (map (sqlLiteral . snd) cols)
++ intercalate ", " literals
++ ")"
)
@@ -208,14 +239,15 @@ insertRowsSql table rows = do
let widths = map length rs
if any (/= length first) widths
then Left "all rows must have the same columns"
else
else do
literals <- mapM (mapM (sqlLiteral . snd)) rs
pure
( "INSERT INTO "
++ T.unpack tbl
++ " ("
++ intercalate ", " (map T.unpack names)
++ ") VALUES "
++ intercalate ", " ["(" ++ intercalate ", " (map (sqlLiteral . snd) r) ++ ")" | r <- rs]
++ intercalate ", " ["(" ++ intercalate ", " values ++ ")" | values <- literals]
)
-- | 构造按 id 改行的 UPDATE 语句
@@ -223,8 +255,14 @@ updateRowSql :: Text -> Int -> [(String, Value)] -> Either String String
updateRowSql table key assigns = do
tbl <- checkIdent "table" table
cols <- requireNonEmpty "values" assigns
sets <- mapM (\(n, v) -> (\c -> T.unpack c ++ " = " ++ sqlLiteral v) <$> checkIdent "column" (T.pack n)) cols
sets <- mapM assignment cols
pure ("UPDATE " ++ T.unpack tbl ++ " SET " ++ intercalate ", " sets ++ " WHERE id = " ++ show key)
where
-- \| 校验列名并编码赋值
assignment (name, value) = do
column <- checkIdent "column" (T.pack name)
literal <- sqlLiteral value
Right (T.unpack column ++ " = " ++ literal)
-- | 按 id 删一行,存储层原地删
deleteRowSql :: Text -> Int -> Either String String
@@ -248,10 +286,11 @@ whereClause filters = case filters of
terms <- mapM term filters
pure (" WHERE " ++ intercalate " AND " terms)
where
-- | 一个等值条件
-- \| 一个等值条件
term (column, value) = do
col <- checkIdent "column" column
pure (T.unpack col ++ " = " ++ sqlLiteral value)
literal <- sqlLiteral value
pure (T.unpack col ++ " = " ++ literal)
-- | 拼 ORDER BY 子句,无排序给空串
orderClause :: Maybe (Text, Bool) -> Either String String
@@ -267,7 +306,7 @@ accountName name
| not (T.all allowed name) = Left ("account name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack name)
| otherwise = Right name
where
-- | 账号名允许的字符集
-- \| 账号名允许的字符集
allowed c = isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("_.-" :: String)
-- | 单引号字符串字面量
@@ -303,18 +342,20 @@ roleName name
| not (T.all allowed name) = Left ("role name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack name)
| otherwise = Right name
where
-- | 角色名允许的字符集
-- \| 角色名允许的字符集
allowed c = isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("_.-" :: String)
-- | 授权对象:`*`,或长度不超过 128 的裸表名/`库.表`
grantObject :: Text -> Either String Text
grantObject object
| "database:" `T.isPrefixOf` T.toLower object = ("DATABASE " <>) <$> checkIdent "database" (T.drop 9 object)
| ".*" `T.isSuffixOf` object = (<> ".*") <$> checkIdent "database" (T.dropEnd 2 object)
| T.strip object == "*" = Right "*"
| T.null object || T.length object > 128 = Left "object name is empty or too long"
| not (T.all allowed object) = Left ("object name may only contain ASCII letters, digits, dot, dash or underscore: " ++ T.unpack object)
| otherwise = Right object
where
-- | 授权对象允许的字符集
-- \| 授权对象允许的字符集
allowed c = isAsciiLower c || isAsciiUpper c || isDigit c || c `elem` ("_.-" :: String)
-- | 权限清单:词要纯字母,认不认由 server 定
@@ -323,7 +364,7 @@ privilegeWords privileges
| null privileges = Left "at least one privilege is required"
| otherwise = mapM word privileges
where
-- | 单个权限词
-- \| 单个权限词
word one
| T.null one || not (T.all (\c -> isAsciiLower c || isAsciiUpper c) one) = Left ("not a privilege keyword: " ++ T.unpack one)
| otherwise = Right one
@@ -347,11 +388,16 @@ grantPrivilegesSql privileges object role withOption = do
target <- grantObject object
who <- roleName role
pure
( "GRANT " ++ T.unpack (T.intercalate ", " words') ++ " ON " ++ T.unpack target
++ " TO " ++ T.unpack who ++ tailText
( "GRANT "
++ T.unpack (T.intercalate ", " words')
++ " ON "
++ T.unpack target
++ " TO "
++ T.unpack who
++ tailText
)
where
-- | 转授权后缀
-- \| 转授权后缀
tailText
| withOption = " WITH GRANT OPTION"
| otherwise = ""
@@ -34,9 +34,9 @@ import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar)
import Crypto.Hash (SHA256 (..))
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import Crypto.Random (getRandomBytes)
import qualified Data.ByteString as BS
import Data.ByteArray (constEq)
import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase)
import qualified Data.ByteString as BS
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
@@ -49,7 +49,6 @@ data WebConfig = WebConfig
, wcMaxPageSize :: Int
, wcMaxRows :: Int
, wcMaxSqlLength :: Int
, wcSeedDemo :: Bool
}
deriving (Show, Eq)
@@ -73,7 +72,6 @@ defaultWebConfig =
, wcMaxPageSize = 500
, wcMaxRows = 1000
, wcMaxSqlLength = 20000
, wcSeedDemo = False
}
-- | 把设置键统一成连字符写法,重名时连字符优先
@@ -81,7 +79,7 @@ canonicalSettingKeys :: Map.Map Text Text -> Map.Map Text Text
canonicalSettingKeys saved =
foldr (\(key, value) acc -> Map.insert (canonicalKey key) value acc) Map.empty (Map.toList saved)
where
-- | 取一个键的规范名
-- \| 取一个键的规范名
canonicalKey key = fromMaybe key (lookup key keyAliases)
-- | 设置键别名:非权威写法到权威写法(多数写连字符)
@@ -148,7 +146,6 @@ webConfigFromSection saved =
, wcMaxPageSize = sectionInt "max-page-size" saved (wcMaxPageSize defaultWebConfig)
, wcMaxRows = sectionInt "max-rows" saved (wcMaxRows defaultWebConfig)
, wcMaxSqlLength = sectionInt "max-sql-length" saved (wcMaxSqlLength defaultWebConfig)
, wcSeedDemo = sectionBool "seed" saved (wcSeedDemo defaultWebConfig)
}
-- | 分区里一个键的非空字符串值
@@ -174,7 +171,7 @@ staticDirCandidates given =
resolveStaticDir :: FilePath -> IO (Maybe FilePath)
resolveStaticDir given = go (staticDirCandidates given)
where
-- | 逐个试
-- \| 逐个试
go [] = pure Nothing
go (d : ds) = do
ok <- doesDirectoryExist d
@@ -186,29 +183,30 @@ data ServerConfig = ServerConfig
, scPort :: Int
, scMaxMessage :: Int
, scMaxRows :: Int
, scSudoUser :: Text
}
deriving (Eq, Show)
-- | 默认本机 7777,行 1 MiB,最多 1000 行
defaultServerConfig :: ServerConfig
defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000
defaultServerConfig = ServerConfig "127.0.0.1" 7777 (1024 * 1024) 1000 ""
-- | 读 [server] 段键,缺的用默认
loadServerConfigAt :: FilePath -> IO ServerConfig
loadServerConfigAt path = do
values <- readSection path "server"
let -- | 取一个键的非空字符串值
let
-- \| 取一个键的非空字符串值
textOf key fallback = case Map.lookup key values of
Just value | not (T.null (T.strip value)) -> T.unpack (T.strip value)
_ -> fallback
-- | 取一个键的整数值
intOf key fallback = case Map.lookup key values >>= readMaybe . T.unpack . T.strip of
Just number -> number
Nothing -> fallback
-- \| 取一个键的整数值
intOf key fallback = fromMaybe fallback (Map.lookup key values >>= readMaybe . T.unpack . T.strip)
pure
defaultServerConfig
{ scHost = textOf "listen_host" (scHost defaultServerConfig)
, scPort = intOf "port" (scPort defaultServerConfig)
, scMaxMessage = intOf "max_message" (scMaxMessage defaultServerConfig)
, scMaxRows = intOf "max_rows" (scMaxRows defaultServerConfig)
, scSudoUser = T.toLower (T.pack (textOf "sudo_auth_user" ""))
}
+46 -8
View File
@@ -5,6 +5,8 @@ module ChuSQL.Interface.Link (
connectClient,
closeClient,
clientLogin,
clientSudoLogin,
clientNormalization,
clientQuery,
clientPing,
clientCatalog,
@@ -16,6 +18,7 @@ module ChuSQL.Interface.Link (
) where
import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo (..))
import ChuSQL.Interface.Normalization (NormalizationRequest)
import ChuSQL.Interface.Protocol (
ClientRequest (..),
RoleView,
@@ -24,11 +27,13 @@ import ChuSQL.Interface.Protocol (
encodeRequest,
protocolVersion,
)
import ChuSQL.Interface.Sudo (SudoCredential, isLocalPeer, sudoProof)
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import Control.Exception (IOException, try)
import qualified Data.Aeson as A
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString.Char8 as BSC
import Data.Text (Text)
import qualified Data.Text as T
import Network.Socket (
@@ -40,6 +45,7 @@ import Network.Socket (
defaultHints,
defaultProtocol,
getAddrInfo,
getPeerName,
socket,
socketToHandle,
)
@@ -52,23 +58,25 @@ import System.IO.Error (isEOFError)
data Client = Client
{ clHandle :: Handle
, clLock :: MVar ()
, clLocal :: Bool
}
-- | 连上 server 并对协议版本,失败给人话错误
connectClient :: Text -> Int -> IO (Either Text Client)
connectClient host port = do
opened <- try (openConnection host port) :: IO (Either IOException Handle)
opened <- try (openConnection host port) :: IO (Either IOException (Handle, Bool))
case opened of
Left err -> pure (Left ("cannot reach the server at " <> T.pack (address host port) <> ": " <> T.pack (describe err)))
Right handle -> do
Right (handle, local) -> do
lock <- newMVar ()
let client = Client handle lock
let client = Client handle lock local
greeted <- request client (ReqHello protocolVersion)
case greeted of
Right (RespHello version)
| version == protocolVersion -> pure (Right client)
| otherwise ->
giveUp handle
giveUp
handle
( "server "
<> T.pack (address host port)
<> " speaks protocol "
@@ -80,7 +88,7 @@ connectClient host port = do
Right _ -> giveUp handle "unexpected response to hello"
Left message -> giveUp handle message
where
-- | 对不上就关连接并回错误
-- \| 对不上就关连接并回错误
giveUp handle message = do
_ <- try (hClose handle) :: IO (Either IOException ())
pure (Left message)
@@ -117,6 +125,26 @@ clientLogin client user password = do
Right (RespLogin _ admin) -> pure (Right admin)
Right other -> pure (failed "login" other)
-- 验证一次性挑战并用本机身份登录。
clientSudoLogin :: Client -> SudoCredential -> Text -> IO (Either Text Bool)
clientSudoLogin client _ _ | not (clLocal client) = pure (Left "sudo authentication requires a local server")
clientSudoLogin client credential user = withMVar (clLock client) $ \_ -> do
outcome <- try authenticate :: IO (Either IOException (Either Text Bool))
pure $ either (Left . T.pack . describe) id outcome
where
-- 在同一连接连续交换挑战与证明。
authenticate = do
challenge <- exchange (clHandle client) ReqSudoChallenge
case challenge of
Right (RespSudoChallenge nonce) | T.length nonce == 64 -> do
answer <- exchange (clHandle client) (ReqSudoLogin user (sudoProof credential nonce user))
pure $ case answer of
Left message -> Left message
Right (RespLogin _ admin) -> Right admin
Right other -> failed "sudo login" other
Right other -> pure (failed "sudo challenge" other)
Left message -> pure (Left message)
-- | 跑一条语句,拿回结果集
clientQuery :: Client -> Text -> IO (Either Text QueryResult)
clientQuery client sql = do
@@ -196,7 +224,7 @@ failed what response = case response of
_ -> Left ("unexpected response to " <> what)
-- | 建连接(套接字转成文本模式的行缓冲句柄)
openConnection :: Text -> Int -> IO Handle
openConnection :: Text -> Int -> IO (Handle, Bool)
openConnection host port = do
let hints = defaultHints{addrSocketType = Stream}
infos <- getAddrInfo (Just hints) (Just (T.unpack host)) (Just (show port))
@@ -205,10 +233,11 @@ openConnection host port = do
(info : _) -> do
sock <- socket (addrFamily info) Stream defaultProtocol
connect sock (addrAddress info)
peer <- getPeerName sock
handle <- socketToHandle sock ReadWriteMode
hSetBuffering handle LineBuffering
hSetNewlineMode handle noNewlineTranslation
pure handle
pure (handle, isLocalPeer peer)
-- | 把主机端口拼成地址字样
address :: Text -> Int -> String
@@ -219,3 +248,12 @@ describe :: IOException -> String
describe err
| isEOFError err = "the server closed the connection"
| otherwise = show err
-- 请求服务端执行只读范式分析。
clientNormalization :: Client -> NormalizationRequest -> IO (Either Text A.Value)
clientNormalization client payload = do
answer <- request client (ReqNormalization payload)
pure $ case answer of
Left message -> Left message
Right (RespNormalization value) -> Right value
Right other -> failed "normalization" other
@@ -0,0 +1,213 @@
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.Interface.Normalization where
import ChuSQL.Core.Protocol (SchemaColumn)
import Control.Monad (unless, when)
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Types as AT
import qualified Data.ByteString.Lazy as BL
import Data.Char (isAlpha, isAlphaNum, isDigit, isHexDigit, isSpace)
import Data.List (nub)
import Data.Scientific (base10Exponent, toBoundedInteger)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word (Word64)
import Text.ParserCombinators.ReadP
-- 范式入口的版本化声明、对象身份与严格 JSON 校验。
data NormalizationDependency = NormalizationDependency [String] [String] deriving (Eq, Show)
data NormalizationDeclaration = NormalizationDeclaration
{ ndKeys :: [[String]]
, ndDependencies :: [NormalizationDependency]
, ndComplete :: Bool
, ndAtomic :: Maybe Bool
}
deriving (Eq, Show)
data ObjectIdentity = ObjectIdentity Integer Integer deriving (Eq, Show)
data NormalizationRequest = NormalizationRequest
{ nrVersion :: Int
, nrDatabase :: Text
, nrTable :: Text
, nrDeclaration :: NormalizationDeclaration
, nrExpectedObject :: Maybe ObjectIdentity
, nrExpectedSchema :: Maybe Text
}
deriving (Eq, Show)
-- 拒绝对象中未定义的字段。
onlyFields :: [Text] -> A.Object -> AT.Parser ()
onlyFields names fields = unless (all ((`elem` names) . K.toText) (KM.keys fields)) (fail "normalization: unknown field")
instance FromJSON NormalizationDependency where
-- 读取依赖两端的确切字段名。
parseJSON = withObject "dependency" $ \o -> do
onlyFields ["lhs", "rhs"] o
lhs <- o .: "lhs"
rhs <- o .: "rhs"
when (null rhs) (fail "normalization: empty dependency rhs")
pure (NormalizationDependency lhs rhs)
instance ToJSON NormalizationDependency where
-- 编码声明依赖。
toJSON (NormalizationDependency lhs rhs) = object ["lhs" .= lhs, "rhs" .= rhs]
instance FromJSON NormalizationDeclaration where
-- 读取显式声明并限制数量。
parseJSON = withObject "declaration" $ \o -> do
onlyFields ["declared_keys", "dependencies", "dependencies_complete", "atomic_attributes"] o
keys <- o .:? "declared_keys" .!= []
deps <- o .:? "dependencies" .!= []
when (length keys > 256 || length deps > 256) (fail "normalization: declaration exceeds 256 entries")
NormalizationDeclaration keys deps <$> o .:? "dependencies_complete" .!= False <*> o .:? "atomic_attributes"
instance ToJSON NormalizationDeclaration where
-- 编码全部声明标志。
toJSON d =
object
[ "declared_keys" .= ndKeys d
, "dependencies" .= ndDependencies d
, "dependencies_complete" .= ndComplete d
, "atomic_attributes" .= ndAtomic d
]
instance FromJSON ObjectIdentity where
-- 校验稳定对象的正整数编号。
parseJSON = withObject "object identity" $ \o -> do
onlyFields ["database_id", "object_id"] o
db <- o .: "database_id" >>= identityNumber
table <- o .: "object_id" >>= identityNumber
when (db <= 0 || table <= 0) (fail "normalization: invalid object identity")
pure (ObjectIdentity db table)
-- 兼容目录数值并保留浏览器中的完整编号。
identityNumber :: A.Value -> AT.Parser Integer
identityNumber (A.String text)
| not (T.null text) && T.length text <= 20 && T.all isDigit text = case reads (T.unpack text) of
[(value, "")] | value <= toInteger (maxBound :: Word64) -> pure value
_ -> fail "normalization: invalid identity number"
identityNumber (A.Number number)
| base10Exponent number >= -20 && base10Exponent number <= 20 =
maybe (fail "normalization: invalid identity number") (pure . toInteger) (toBoundedInteger number :: Maybe Word64)
identityNumber _ = fail "normalization: invalid identity number"
instance ToJSON ObjectIdentity where
-- 编码对象的库及表编号。
toJSON (ObjectIdentity db table) = object ["database_id" .= T.pack (show db), "object_id" .= T.pack (show table)]
instance FromJSON NormalizationRequest where
-- 校验版本、范围和预期身份。
parseJSON = withObject "normalization request" $ \o -> do
onlyFields ["api_version", "database", "table", "declaration", "expected_object", "expected_schema_fingerprint"] o
version <- o .: "api_version"
when (version /= (1 :: Int)) (fail "normalization: unsupported api_version")
db <- o .: "database"
table <- o .: "table"
unless
(plainName db && case T.splitOn "." table of [name] -> plainName name; [scope, name] -> scope == db && plainName name; _ -> False)
(fail "normalization: invalid or cross-database table name")
NormalizationRequest version db table <$> o .: "declaration" <*> o .:? "expected_object" <*> o .:? "expected_schema_fingerprint"
instance ToJSON NormalizationRequest where
-- 编码专用分析请求。
toJSON r =
object
[ "api_version" .= nrVersion r
, "database" .= nrDatabase r
, "table" .= nrTable r
, "declaration" .= nrDeclaration r
, "expected_object" .= nrExpectedObject r
, "expected_schema_fingerprint" .= nrExpectedSchema r
]
-- 校验与 SQL 一致的裸标识符。
plainName :: Text -> Bool
plainName name = not (T.null name) && T.length name <= 64 && (isAlpha (T.head name) || T.head name == '_') && T.all (\c -> isAlphaNum c || c == '_') name
-- 检查大小、编码及重复 JSON 字段。
decodeNormalizationJSON :: BL.ByteString -> Either Text A.Value
decodeNormalizationJSON raw
| BL.length raw > 65536 = Left "normalization: request exceeds 64 KiB"
| otherwise = do
value <- either (Left . T.pack) Right (A.eitherDecode raw)
text <- either (const (Left "normalization: invalid UTF-8")) Right (TE.decodeUtf8' (BL.toStrict raw))
case readP_to_S (skipSpaces *> jsonNode 0 <* skipSpaces <* eof) (T.unpack text) of
[(True, "")] -> Right value
_ -> Left "normalization: duplicate JSON fields or nesting exceeds 64"
-- 遍历 JSON 结构并保留原始字段名。
jsonNode :: Int -> ReadP Bool
jsonNode depth
| depth > 64 = pfail
| otherwise = objectNode <++ arrayNode <++ (True <$ jsonString) <++ (True <$ munch1 (\c -> not (isSpace c) && c `notElem` (",]}" :: String)))
where
-- 验证对象及所有嵌套值。
objectNode = do
_ <- char '{'
skipSpaces
pairs <- sepBy pair (skipSpaces *> char ',' <* skipSpaces)
skipSpaces
_ <- char '}'
pure (length (map fst pairs) == length (nub (map fst pairs)) && all snd pairs)
-- 保留键名并验证对应值。
pair = do
key <- jsonString
skipSpaces
_ <- char ':'
skipSpaces
valid <- jsonNode (depth + 1)
pure (key, valid)
-- 验证数组的所有元素。
arrayNode = do
_ <- char '['
skipSpaces
values <- sepBy (jsonNode (depth + 1)) (skipSpaces *> char ',' <* skipSpaces)
skipSpaces
_ <- char ']'
pure (and values)
-- 解码字符串以识别转义后的相同键。
jsonString :: ReadP Text
jsonString = do
_ <- char '"'
pieces <- many piece
_ <- char '"'
case A.eitherDecodeStrict (TE.encodeUtf8 (T.pack ('"' : concat pieces ++ "\""))) of
Right value -> pure value
Left _ -> pfail
where
-- 保留 JSON 字符串转义。
piece = ((\c -> ['\\', c]) <$> (char '\\' *> get)) <++ munch1 (\c -> c /= '"' && c /= '\\')
-- 拒绝缺字段或未知标签的线上报告。
parseNormalizationReport :: A.Value -> AT.Parser A.Value
parseNormalizationReport value =
withObject
"normalization report"
( \o -> do
version <- o .: "api_version"
conditional <- o .: "conditional"
unless (version == (1 :: Int) && conditional) (fail "normalization: invalid report version or condition")
_ <- (o .: "object" :: AT.Parser ObjectIdentity)
fingerprint <- o .: "schema_fingerprint"
unless (T.length fingerprint == 64 && T.all isHexDigit fingerprint) (fail "normalization: invalid schema fingerprint")
view <- o .: "view"
unless (view `elem` (["live_schema", "transaction_snapshot"] :: [Text])) (fail "normalization: unknown view")
_ <- (o .: "schema" :: AT.Parser [SchemaColumn])
_ <- (o .: "declaration" :: AT.Parser NormalizationDeclaration)
_ <- (o .: "candidate_keys" :: AT.Parser [[String]])
forms <- o .: "findings" >>= mapM parseFinding
unless (forms == (["1nf", "2nf", "3nf", "bcnf"] :: [Text])) (fail "normalization: invalid findings")
_ <- (o .: "suggestions" :: AT.Parser [A.Value])
_ <- (o .: "condition" :: AT.Parser Text)
pure value
)
value
where
-- 核对每项结论与证据的稳定形状。
parseFinding = withObject "normalization finding" $ \o -> do
form <- o .: "normal_form"
verdict <- o .: "verdict"
unless (verdict `elem` (["satisfied", "violated", "insufficient"] :: [Text])) (fail "normalization: unknown verdict")
_ <- (o .: "witnesses" :: AT.Parser [NormalizationDependency])
_ <- (o .: "condition" :: AT.Parser Text)
pure form
@@ -33,10 +33,12 @@ passwordKeys = ["password-min-length", "password-classes"]
-- | 策略值:缺项或空值回落到内置默认
policyFromValues :: PasswordPolicy -> Map.Map Text Text -> PasswordPolicy
policyFromValues before values = PasswordPolicy
(number "password-min-length" (ppMinLength before)) (number "password-classes" (ppClasses before))
policyFromValues before values =
PasswordPolicy
(number "password-min-length" (ppMinLength before))
(number "password-classes" (ppClasses before))
where
-- | 取一个键的数值,缺项或空值回落到给定默认
-- \| 取一个键的数值,缺项或空值回落到给定默认
number key fallback = case Map.lookup key values of
Nothing -> fallback
Just value -> fromMaybe fallback (readMaybe (T.unpack (if T.null value then defaultOf key else value)))
@@ -14,10 +14,12 @@ module ChuSQL.Interface.Protocol (
) where
import ChuSQL.Core.Protocol (Account (..), QueryResult (..), TableInfo (..), queryResultJson)
import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.:?), (.!=), (.=))
import ChuSQL.Interface.Normalization
import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Types (parseEither)
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (fromMaybe)
@@ -91,6 +93,9 @@ serverName = "chusql-server"
data ClientRequest
= ReqHello Int
| ReqLogin Text Text
| ReqSudoChallenge
| ReqSudoLogin Text Text
| ReqNormalization NormalizationRequest
| ReqQuery Text
| ReqPing
| ReqQuit
@@ -109,6 +114,7 @@ data WireRequest = WireRequest
, wrProtocol :: Maybe Int
, wrUser :: Maybe Text
, wrPassword :: Maybe Text
, wrProof :: Maybe Text
, wrSql :: Maybe Text
, wrRequest :: Maybe Value
}
@@ -121,6 +127,7 @@ instance A.FromJSON WireRequest where
<*> o A..:? "protocol"
<*> o A..:? "user"
<*> o A..:? "password"
<*> o A..:? "proof"
<*> o A..:? "sql"
<*> o A..:? "request"
@@ -133,6 +140,13 @@ decodeRequest raw = case A.eitherDecodeStrict raw of
"login" -> case (wrUser wire, wrPassword wire) of
(Just user, Just password) -> Right (ReqLogin user password)
_ -> Left "login needs both user and password"
"sudo_challenge" -> Right ReqSudoChallenge
"sudo_login" -> case (wrUser wire, wrProof wire) of
(Just user, Just proof) -> Right (ReqSudoLogin user proof)
_ -> Left "sudo_login needs both user and proof"
"normalization_analyze" -> do
value <- decodeNormalizationJSON (BL.fromStrict raw)
either (Left . T.pack) Right $ parseEither (withObject "normalization envelope" $ \o -> onlyFields ["method", "request"] o >> ReqNormalization <$> o .: "request") value
"query" -> maybe (Left "query needs sql") (Right . ReqQuery) (wrSql wire)
"storage" -> maybe (Left "storage needs request") (Right . ReqStorage) (wrRequest wire)
"catalog" -> Right ReqCatalog
@@ -154,6 +168,9 @@ requestJson :: ClientRequest -> Value
requestJson request = case request of
ReqHello version -> object ["method" .= ("hello" :: Text), "protocol" .= version]
ReqLogin user password -> object ["method" .= ("login" :: Text), "user" .= user, "password" .= password]
ReqSudoChallenge -> object ["method" .= ("sudo_challenge" :: Text)]
ReqSudoLogin user proof -> object ["method" .= ("sudo_login" :: Text), "user" .= user, "proof" .= proof]
ReqNormalization payload -> object ["method" .= ("normalization_analyze" :: Text), "request" .= payload]
ReqQuery sql -> object ["method" .= ("query" :: Text), "sql" .= sql]
ReqPing -> object ["method" .= ("ping" :: Text)]
ReqQuit -> object ["method" .= ("quit" :: Text)]
@@ -169,10 +186,12 @@ requestJson request = case request of
data ServerResponse
= RespHello Int
| RespLogin Text Bool
| RespSudoChallenge Text
| RespResult QueryResult
| RespPong
| RespBye
| RespError Text Text
| RespNormalization Value
| RespStorage Value
| RespCatalog [TableInfo]
| RespDatabases [Text]
@@ -190,9 +209,11 @@ responseJson :: ServerResponse -> Value
responseJson response = case response of
RespHello version -> object ["status" .= ("hello" :: Text), "protocol" .= version, "server" .= serverName]
RespLogin user admin -> object ["status" .= ("ok" :: Text), "user" .= user, "admin" .= admin]
RespSudoChallenge challenge -> object ["status" .= ("sudo_challenge" :: Text), "challenge" .= challenge]
RespPong -> object ["status" .= ("pong" :: Text)]
RespBye -> object ["status" .= ("bye" :: Text)]
RespError code message -> object ["status" .= ("error" :: Text), "code" .= code, "message" .= message]
RespNormalization value -> object ["status" .= ("normalization" :: Text), "analysis" .= value]
RespStorage value -> object ["status" .= ("storage" :: Text), "response" .= value]
RespCatalog infos -> object ["status" .= ("catalog" :: Text), "schemas" .= infos]
RespDatabases names -> object ["status" .= ("databases" :: Text), "databases" .= names]
@@ -212,10 +233,11 @@ decodeResponse raw = case A.eitherDecode raw of
_ -> Left "response is missing status"
Right _ -> Left "response is not a JSON object"
where
-- | 按 status 字段分派
-- \| 按 status 字段分派
decodeStatus status fields = case status of
"hello" -> Right (RespHello (intOf "protocol" fields))
"ok" -> Right (RespLogin (textOf "user" fields) (boolOf "admin" fields))
"sudo_challenge" -> fromField "challenge" RespSudoChallenge fields
"pong" -> Right RespPong
"bye" -> Right RespBye
"error" -> Right (RespError (textOf "code" fields) (textOf "message" fields))
@@ -225,6 +247,9 @@ decodeResponse raw = case A.eitherDecode raw of
"result" -> case A.fromJSON (A.Object fields) of
A.Success result -> Right (RespResult result)
A.Error message -> Left (T.pack message)
"normalization" -> case KM.lookup "analysis" fields of
Nothing -> Left "normalization response is missing analysis"
Just value -> either (Left . T.pack) (Right . RespNormalization) (parseEither parseNormalizationReport value)
"catalog" -> fromField "schemas" RespCatalog fields
"databases" -> fromField "databases" RespDatabases fields
"roles" -> fromField "roles" RespRoles fields
@@ -232,23 +257,23 @@ decodeResponse raw = case A.eitherDecode raw of
"policy" -> Right (RespPolicy (intOf "minLength" fields) (intOf "classes" fields))
other -> Left ("unexpected status: " <> other)
-- | 取一个字段解成目标类型
fromField :: A.FromJSON a => Text -> (a -> ServerResponse) -> A.Object -> Either Text ServerResponse
-- \| 取一个字段解成目标类型
fromField :: (A.FromJSON a) => Text -> (a -> ServerResponse) -> A.Object -> Either Text ServerResponse
fromField key wrap fields = case A.fromJSON (fromMaybe A.Null (KM.lookup (AK.fromText key) fields)) of
A.Success value -> Right (wrap value)
A.Error message -> Left (T.pack message)
-- | 取一个整数字段
-- \| 取一个整数字段
intOf key fields = case KM.lookup key fields of
Just (A.Number number) -> truncate number
_ -> 0
-- | 取一个文本字段
-- \| 取一个文本字段
textOf key fields = case KM.lookup key fields of
Just (A.String text) -> text
_ -> ""
-- | 取一个布尔字段
-- \| 取一个布尔字段
boolOf key fields = case KM.lookup key fields of
Just (A.Bool flag) -> flag
_ -> False
@@ -7,8 +7,10 @@ module ChuSQL.Interface.Session (
sessionDatabase,
isPlainIdentifier,
authenticateSession,
authenticateSudoSession,
switchDatabase,
runStatement,
analyzeNormalization,
catalog,
databases,
roleViews,
@@ -22,11 +24,17 @@ import ChuSQL.Interface.Link (
clientCatalog,
clientDatabases,
clientLogin,
clientNormalization,
clientQuery,
clientRoles,
clientSudoLogin,
)
import ChuSQL.Interface.Normalization
import ChuSQL.Interface.Protocol (RoleView)
import ChuSQL.Interface.Sudo (SudoCredential)
import qualified Data.Aeson as A
import Data.Char (isAlpha, isAlphaNum)
import Data.Foldable (for_)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Text (Text)
import qualified Data.Text as T
@@ -68,6 +76,14 @@ authenticateSession session user password = do
Left message -> pure (Left message)
Right admin -> writeIORef (ssAdmin session) admin >> pure (Right ())
-- 用受保护本机凭据登录并记录身份。
authenticateSudoSession :: Session -> SudoCredential -> Text -> IO (Either Text ())
authenticateSudoSession session credential user = do
answer <- clientSudoLogin (ssClient session) credential user
case answer of
Left message -> pure (Left message)
Right admin -> writeIORef (ssAdmin session) admin >> pure (Right ())
-- | 换库:名字先按解析器规矩校验,由 server 执行 USE
switchDatabase :: Session -> Text -> IO (Either Text ())
switchDatabase session rawName
@@ -78,7 +94,7 @@ switchDatabase session rawName
Left message -> pure (Left message)
Right _ -> pure (Right ())
where
-- | 规范化后的库名
-- \| 规范化后的库名
name = T.toLower (T.strip rawName)
-- | 跑一条语句;结果集里带回的当前库口径跟着一起更新
@@ -88,9 +104,9 @@ runStatement session sql = do
case answer of
Left message -> pure (Left message)
Right result -> do
case qrDatabase result of
Just name -> writeIORef (ssCurrent session) name
Nothing -> pure ()
for_
(qrDatabase result)
(writeIORef (ssCurrent session))
pure (Right result)
-- | 数据字典(\\dt 与 \\d 用)
@@ -108,3 +124,11 @@ roleViews session = clientRoles (ssClient session)
-- | 账号清单(\\du 与管理页用)
accounts :: Session -> IO (Either Text [Account])
accounts session = clientAccounts (ssClient session)
-- 使用当前连接及工作库请求范式分析。
analyzeNormalization :: Session -> NormalizationRequest -> IO (Either Text A.Value)
analyzeNormalization session payload = do
current <- sessionDatabase session
if current /= nrDatabase payload
then pure (Left "bad_request: normalization database differs from the selected database")
else clientNormalization (ssClient session) payload
@@ -61,14 +61,13 @@ settingCatalogue =
, owned "storage-btree-order" "Storage B+tree order" "storage" "int" "4" "btree" "order"
, owned "storage-buffer-pool" "Storage buffer pool pages" "storage" "int" "1024" "buffer" "pool_size"
, owned "storage-log" "Storage log level" "storage" "text" "info" "log" "level"
, item "seed" "Seed demo data on start" "storage" "bool" "1" True True
, owned "tcp-listen-host" "TCP listen address" "network" "text" "127.0.0.1" "server" "listen_host"
, owned "tcp-port" "TCP port" "network" "int" "7777" "server" "port"
, owned "tcp-max-message" "TCP max request line (bytes)" "network" "int" "1048576" "server" "max_message"
, owned "tcp-max-rows" "TCP rows per result" "network" "int" "1000" "server" "max_rows"
]
where
-- | web 自己的键:分区写死 [web]
-- \| web 自己的键:分区写死 [web]
item k l g kind def rootOnly restart =
SettingItem
{ siKey = k
@@ -95,7 +94,7 @@ settingCatalogue =
, siTomlKey = tomlKey
}
-- | 换掉落盘用的键名:界面键与 TOML 键不同名时用
-- \| 换掉落盘用的键名:界面键与 TOML 键不同名时用
withTomlKey key spec = spec{siTomlKey = key}
-- | web 自己的分区名
@@ -131,7 +130,8 @@ isRestartRequired key = maybe False siRestart (findItem key)
-- | 改完立刻生效的配置键
liveKeys :: [Text]
liveKeys =
[ "password-min-length", "password-classes"
[ "password-min-length"
, "password-classes"
, "body-limit"
, "session-idle"
, "session-max"
@@ -147,7 +147,7 @@ liveKeys =
readSettingsFile :: FilePath -> IO (Map.Map Text Text)
readSettingsFile path = fmap Map.unions (mapM readSectionOf catalogueSections)
where
-- | 读一个分区,摊成界面键
-- \| 读一个分区,摊成界面键
readSectionOf section = do
raw <- readSection path section
let values = if section == webSection then canonicalSettingKeys raw else raw
@@ -164,7 +164,7 @@ readSettingsFile path = fmap Map.unions (mapM readSectionOf catalogueSections)
writeSettingsFile :: FilePath -> Map.Map Text Text -> IO (Either String ())
writeSettingsFile path values = writeSections catalogueSections
where
-- | 各分区依次写回
-- \| 各分区依次写回
writeSections [] = pure (Right ())
writeSections (section : rest) = do
let entries =
@@ -186,7 +186,7 @@ writeSettingsFile path values = writeSections catalogueSections
applySettings :: Map.Map Text Text -> Map.Map Text Text -> Either String (Map.Map Text Text)
applySettings current = go (Right current) . Map.toList
where
-- | 逐项校验并合并
-- \| 逐项校验并合并
go (Left e) _ = Left e
go (Right acc) [] = Right acc
go (Right acc) ((key, value) : rest) = case findItem key of
@@ -231,13 +231,12 @@ effectiveSettings cfg =
, ("max-page-size", tshow (wcMaxPageSize cfg))
, ("max-rows", tshow (wcMaxRows cfg))
, ("max-sql-length", tshow (wcMaxSqlLength cfg))
, ("seed", boolText (wcSeedDemo cfg))
, ("data-dir", maybe "" T.pack (wcDataDir cfg))
, ("log-files", T.pack (wcLogFiles cfg))
]
where
-- | 数值转文本
-- \| 数值转文本
tshow = T.pack . show
-- | 布尔转 "1"/"0"
-- \| 布尔转 "1"/"0"
boolText True = "1"
boolText False = "0"
@@ -0,0 +1,131 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.Interface.Sudo (
SudoCredential,
createSudoCredential,
removeSudoCredential,
readSudoCredential,
sudoProof,
verifySudoProof,
sudoChallenge,
sudoPrivileged,
newSudoCredential,
isLocalPeer,
validSudoChallenge,
) where
import Crypto.Hash (SHA256)
import Crypto.MAC.HMAC (HMAC, hmac)
import Crypto.Random (getRandomBytes)
import qualified Data.ByteArray as BA
import Data.ByteArray.Encoding (Base (Base16), convertToBase)
import qualified Data.ByteString as BS
import Data.Char (isHexDigit)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Clock (UTCTime, diffUTCTime)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt (..))
import Foreign.Marshal.Alloc (allocaBytes)
import Network.Socket (SockAddr (..), hostAddress6ToTuple, hostAddressToTuple)
-- 用系统保护凭据与一次性挑战验证本机提升身份。
newtype SudoCredential = SudoCredential BS.ByteString
-- 隐藏本机凭据的诊断内容。
instance Show SudoCredential where
show _ = "SudoCredential <redacted>"
-- 检查当前进程的操作系统提升身份。
foreign import ccall unsafe "chusql_sudo_privileged" nativePrivileged :: IO CInt
-- 创建操作系统保护的本机凭据。
foreign import ccall safe "chusql_sudo_create" nativeCreate :: CInt -> CString -> IO CInt
-- 读取操作系统保护的本机凭据。
foreign import ccall safe "chusql_sudo_read" nativeRead :: CInt -> CString -> IO CInt
-- 清理本次服务启动的凭据。
foreign import ccall safe "chusql_sudo_remove" nativeRemove :: CInt -> IO CInt
-- 判断当前进程是否以提升身份运行。
sudoPrivileged :: IO Bool
sudoPrivileged = (/= 0) <$> nativePrivileged
-- 生成随机挑战和服务实例凭据。
sudoChallenge :: IO Text
sudoChallenge = TE.decodeUtf8 . convertToBase Base16 <$> (getRandomBytes 32 :: IO BS.ByteString)
-- 创建本次服务实例的受保护凭据。
createSudoCredential :: Int -> IO SudoCredential
createSudoCredential port = do
credential@(SudoCredential secret) <- newSudoCredential
status <- BS.useAsCString secret (nativeCreate (fromIntegral port))
if status == 0
then pure credential
else ioError (userError (T.unpack (nativeError "create" status)))
-- 生成独立服务实例的随机凭据。
newSudoCredential :: IO SudoCredential
newSudoCredential = SudoCredential . TE.encodeUtf8 <$> sudoChallenge
-- 判断内核报告的连接地址是否为回环。
isLocalPeer :: SockAddr -> Bool
isLocalPeer (SockAddrInet _ host) = let (first, _, _, _) = hostAddressToTuple host in first == 127
isLocalPeer (SockAddrInet6 _ _ host _) = case hostAddress6ToTuple host of
(0, 0, 0, 0, 0, 0, 0, 1) -> True
(0, 0, 0, 0, 0, 65535, high, _) -> high >= 32512 && high <= 32767
_ -> False
isLocalPeer _ = False
-- 校验挑战有效期及其账号绑定证明。
validSudoChallenge :: SudoCredential -> UTCTime -> Maybe (Text, UTCTime) -> Text -> Text -> Bool
validSudoChallenge credential now challenge user proof = case challenge of
Just (nonce, issued) ->
diffUTCTime now issued >= 0
&& diffUTCTime now issued <= 60
&& verifySudoProof credential nonce user proof
Nothing -> False
-- 删除本次服务实例的受保护凭据。
removeSudoCredential :: Int -> IO ()
removeSudoCredential port = do
status <- nativeRemove (fromIntegral port)
if status == 0 then pure () else ioError (userError (T.unpack (nativeError "remove" status)))
-- 验证操作系统身份并读取本机凭据。
readSudoCredential :: Int -> IO (Either Text SudoCredential)
readSudoCredential port = allocaBytes 64 $ \buffer -> do
status <- nativeRead (fromIntegral port) buffer
if status /= 0
then pure (Left (nativeError "read" status))
else do
secret <- BS.packCStringLen (buffer, 64)
pure $
if BS.all (isHexDigit . toEnum . fromIntegral) secret
then Right (SudoCredential secret)
else Left "invalid sudo credential"
-- 计算绑定挑战与目标账号的认证证明。
sudoProof :: SudoCredential -> Text -> Text -> Text
sudoProof (SudoCredential secret) challenge user = TE.decodeUtf8 (convertToBase Base16 digest)
where
digest = hmac secret (TE.encodeUtf8 ("chusql-sudo-v1:" <> challenge <> ":" <> T.toLower (T.strip user))) :: HMAC SHA256
-- 按固定长度常量时间比对认证证明。
verifySudoProof :: SudoCredential -> Text -> Text -> Text -> Bool
verifySudoProof credential challenge user proof =
T.length proof == 64
&& BA.constEq (TE.encodeUtf8 (sudoProof credential challenge user)) (TE.encodeUtf8 proof)
-- 将原生错误转换为明确诊断。
nativeError :: Text -> CInt -> Text
nativeError operation status =
"sudo credential "
<> operation
<> " failed (OS error "
<> T.pack (show status)
<> "); requires root or an elevated administrator; stale credential directories must be removed after stopping the server"
+28 -23
View File
@@ -1,16 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
module ChuSQL.Interface.TOML
( readSection
, writeSection
, defaultConfigFile
, resolveConfigPath
) where
module ChuSQL.Interface.TOML (
readSection,
writeSection,
defaultConfigFile,
resolveConfigPath,
) where
import Control.Exception (IOException, try)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
@@ -38,12 +38,16 @@ writeSection path section values = do
Left err -> pure (Left err)
Right () -> do
exists <- doesFileExist path
raw <- if exists then TE.decodeUtf8 <$> BS.readFile path else pure ""
raw <-
if exists
then
TE.decodeUtf8 <$> BS.readFile path
else
pure ""
let updated = T.unlines (rewrite section values (T.lines raw))
written <- tryWrite (TE.encodeUtf8 updated)
pure written
tryWrite (TE.encodeUtf8 updated)
where
-- | 目录不存在就先建
-- \| 目录不存在就先建
prepareDirectory = do
let dir = takeDirectory path
if null dir
@@ -51,7 +55,7 @@ writeSection path section values = do
else do
done <- try (createDirectoryIfMissing True dir) :: IO (Either IOException ())
pure (either (Left . show) (const (Right ())) done)
-- | 写文件,异常转成错误串
-- \| 写文件,异常转成错误串
tryWrite bytes = do
done <- try (BS.writeFile path bytes) :: IO (Either IOException ())
pure (either (Left . show) (const (Right ())) done)
@@ -60,7 +64,7 @@ writeSection path section values = do
sectionEntries :: Text -> [Text] -> [(Text, Text)]
sectionEntries wanted = go ""
where
-- | 走到目标分区后收键值对
-- \| 走到目标分区后收键值对
go _ [] = []
go current (line : rest)
| Just name <- sectionName line = go name rest
@@ -91,7 +95,7 @@ assignment line = case T.breakOn "=" (stripComment line) of
stripComment :: Text -> Text
stripComment = T.pack . go False . T.unpack
where
-- | 引号外遇到 # 就到此为止
-- \| 引号外遇到 # 就到此为止
go _ [] = []
go inString ('#' : rest)
| not inString = []
@@ -110,11 +114,11 @@ unquote value
rewrite :: Text -> Map Text Text -> [Text] -> [Text]
rewrite section values = addMissing . replaceInSection . dropEmpties
where
-- | 删掉空值的键
dropEmpties = filter (\line -> maybe True (not . T.null . snd) (assignment line))
-- | 在目标分区里就地换行
-- \| 删掉空值的键
dropEmpties = filter (maybe True (not . T.null . snd) . assignment)
-- \| 在目标分区里就地换行
replaceInSection = go ""
-- | 走到目标分区后逐行替换
-- \| 走到目标分区后逐行替换
go _ [] = []
go current (line : rest)
| Just name <- sectionName line = line : go name rest
@@ -122,7 +126,7 @@ rewrite section values = addMissing . replaceInSection . dropEmpties
| otherwise = case assignment line of
Just (key, _) | Just value <- Map.lookup key values -> assignmentLine key value : go current rest
_ -> line : go current rest
-- | 分区里缺的键补在末尾
-- \| 分区里缺的键补在末尾
addMissing lines' =
let present = Set.fromList (keysOf section lines')
missing = [(key, value) | (key, value) <- Map.toList values, not (Set.member key present), not (T.null value)]
@@ -138,14 +142,14 @@ quote value
| T.all allowed value && not (T.null value) = value
| otherwise = "\"" <> T.replace "\"" "\\\"" value <> "\""
where
-- | 可以裸写的字符集
-- \| 可以裸写的字符集
allowed ch = ch `elem` ("0123456789.-" :: String)
-- | 取某个分区里出现过的键
keysOf :: Text -> [Text] -> [Text]
keysOf wanted = go ""
where
-- | 走到目标分区后收键名
-- \| 走到目标分区后收键名
go _ [] = []
go current (line : rest)
| Just name <- sectionName line = go name rest
@@ -158,8 +162,9 @@ keysOf wanted = go ""
appendSection :: Text -> [(Text, Text)] -> [Text] -> [Text]
appendSection section entries lines' =
lines'
++ (if null lines' || not (T.null (last lines')) then [""] else [])
++ ("[" <> section <> "]") : [assignmentLine key value | (key, value) <- entries]
++ (["" | null lines' || not (T.null (last lines'))])
++ ("[" <> section <> "]")
: [assignmentLine key value | (key, value) <- entries]
-- | 全局配置文件的固定路径,跟随系统惯例
defaultConfigFile :: IO FilePath
Loaded 100 of 166 files, more files were not shown because too many files have changed in this diff. Show more